mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-12 07:50:26 -07:00
Code Issues Projects Releases Packages Wiki Activity

Optimize ecl-inl.h for small cons and use of ecl_unlikely. New macros ECL_CONSP, ECL_LISTP, ECL_ATOM, ECL_SYMBOLP

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-27 09:47:05 +01:00
parent 6e4d572bfb
commit 86c211a6a1
35 changed files with 396 additions and 442 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/c/alloc_2.d
View file

@ -1306,7 +1306,7 @@ stacks_scanner()
cl_object process = ECL_CONS_CAR(l);
struct cl_env_struct *env = process->process.env;
ecl_mark_env(env);
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
}
#else
ecl_mark_env(&cl_env);
@ -1385,8 +1385,8 @@ si_weak_pointer_value(cl_object o)
{
cl_object value;
if (ecl_unlikely(type_of(o) != t_weak_pointer))
FEwrong_type_only_arg(@'ext::weak-pointer-value', o,
@'ext::weak-pointer');
FEwrong_type_only_arg(@[ext::weak-pointer-value], o,
@[ext::weak-pointer]);
value = (cl_object)GC_call_with_alloc_lock((GC_fn_type)ecl_weak_pointer_value, o);
@(return (value? value : Cnil));
}

38
src/c/array.d
View file

@ -131,7 +131,7 @@ ecl_to_index(cl_object n)
case t_bignum:
FEtype_error_index(Cnil, n);
default:
FEwrong_type_only_arg(@'coerce', n, @'integer');
FEwrong_type_only_arg(@[coerce], n, @[integer]);
}
}
@ -176,7 +176,7 @@ si_row_major_aset(cl_object x, cl_object indx, cl_object val)
0, (cl_fixnum)x->vector.dim-1);
break;
default:
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
@(return ecl_aref_unsafe(x, j));
} @)
@ -238,7 +238,7 @@ cl_object
ecl_aref(cl_object x, cl_index index)
{
if (ecl_unlikely(!ECL_ARRAYP(x))) {
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
@ -250,7 +250,7 @@ cl_object
ecl_aref1(cl_object x, cl_index index)
{
if (ecl_unlikely(!ECL_VECTORP(x))) {
FEwrong_type_nth_arg(@'aref', 1, x, @'array');
FEwrong_type_nth_arg(@[aref], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
@ -290,7 +290,7 @@ ecl_aref1(cl_object x, cl_index index)
0, (cl_fixnum)x->vector.dim - 1);
break;
default:
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
@(return ecl_aset_unsafe(x, j, v))
} @)
@ -370,7 +370,7 @@ cl_object
ecl_aset(cl_object x, cl_index index, cl_object value)
{
if (ecl_unlikely(!ECL_ARRAYP(x))) {
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
@ -382,7 +382,7 @@ cl_object
ecl_aset1(cl_object x, cl_index index, cl_object value)
{
if (ecl_unlikely(!ECL_VECTORP(x))) {
FEwrong_type_nth_arg(@'si::aset', 1, x, @'array');
FEwrong_type_nth_arg(@[si::aset], 1, x, @[array]);
}
if (ecl_unlikely(index >= x->array.dim)) {
out_of_bounds_error(index, x);
@ -793,7 +793,7 @@ cl_elttype
ecl_array_elttype(cl_object x)
{
if (ecl_unlikely(!ECL_ARRAYP(x)))
FEwrong_type_argument(@'array', x);
FEwrong_type_argument(@[array], x);
return x->array.elttype;
}
@ -801,7 +801,7 @@ cl_object
cl_array_rank(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-rank', a, @'array');
FEwrong_type_only_arg(@[array-rank], a, @[array]);
@(return ((type_of(a) == t_array) ? MAKE_FIXNUM(a->array.rank)
: MAKE_FIXNUM(1)))
}
@ -831,7 +831,7 @@ ecl_array_dimension(cl_object a, cl_index index)
FEwrong_dimensions(a, index+1);
return a->vector.dim;
default:
FEwrong_type_only_arg(@'array-dimension', a, @'array');
FEwrong_type_only_arg(@[array-dimension], a, @[array]);
}
}
@ -839,7 +839,7 @@ cl_object
cl_array_total_size(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-total-size', a, @'array');
FEwrong_type_only_arg(@[array-total-size], a, @[array]);
@(return MAKE_FIXNUM(a->array.dim))
}
@ -847,7 +847,7 @@ cl_object
cl_adjustable_array_p(cl_object a)
{
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'adjustable-array-p', a, @'array');
FEwrong_type_only_arg(@[adjustable-array-p], a, @[array]);
@(return (ECL_ADJUSTABLE_ARRAY_P(a) ? Ct : Cnil))
}
@ -862,7 +862,7 @@ cl_array_displacement(cl_object a)
cl_index offset;
if (ecl_unlikely(!ECL_ARRAYP(a)))
FEwrong_type_only_arg(@'array-displacement', a, @'array');
FEwrong_type_only_arg(@[array-displacement], a, @[array]);
to_array = a->array.displaced;
if (Null(to_array)) {
offset = 0;
@ -938,7 +938,7 @@ cl_svref(cl_object x, cl_object index)
CAR(x->vector.displaced) != Cnil ||
(cl_elttype)x->vector.elttype != aet_object))
{
FEwrong_type_nth_arg(@'svref',1,x,@'simple-vector');
FEwrong_type_nth_arg(@[svref],1,x,@[simple-vector]);
}
i = ecl_fixnum_in_range(@'svref',"index",index,0,(cl_fixnum)x->vector.dim-1);
@(return x->vector.self.t[i])
@ -955,7 +955,7 @@ si_svset(cl_object x, cl_object index, cl_object v)
CAR(x->vector.displaced) != Cnil ||
(cl_elttype)x->vector.elttype != aet_object))
{
FEwrong_type_nth_arg(@'si::svset',1,x,@'simple-vector');
FEwrong_type_nth_arg(@[si::svset],1,x,@[simple-vector]);
}
i = ecl_fixnum_in_range(@'svref',"index",index,0,(cl_fixnum)x->vector.dim-1);
@(return (x->vector.self.t[i] = v))
@ -978,7 +978,7 @@ cl_array_has_fill_pointer_p(cl_object a)
r = ECL_ARRAY_HAS_FILL_POINTER_P(a)? Ct : Cnil;
break;
default:
FEwrong_type_nth_arg(@'array-has-fill-pointer-p',1,a,@'array');
FEwrong_type_nth_arg(@[array-has-fill-pointer-p],1,a,@[array]);
}
@(return r)
}
@ -988,10 +988,10 @@ cl_fill_pointer(cl_object a)
{
const cl_env_ptr the_env = ecl_process_env();
if (ecl_unlikely(!ECL_VECTORP(a)))
FEwrong_type_only_arg(@'fill-pointer', a, @'vector');
FEwrong_type_only_arg(@[fill-pointer], a, @[vector]);
if (ecl_unlikely(!ECL_ARRAY_HAS_FILL_POINTER_P(a))) {
const char *type = "(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))";
FEwrong_type_nth_arg(@'fill-pointer', 1, a, ecl_read_from_cstring(type));
FEwrong_type_nth_arg(@[fill-pointer], 1, a, ecl_read_from_cstring(type));
}
@(return MAKE_FIXNUM(a->vector.fillp))
}
@ -1005,7 +1005,7 @@ si_fill_pointer_set(cl_object a, cl_object fp)
const cl_env_ptr the_env = ecl_process_env();
if (ecl_unlikely(!ECL_VECTORP(a) || !ECL_ARRAY_HAS_FILL_POINTER_P(a))) {
const char *type = "(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))";
FEwrong_type_nth_arg(@'si::fill-pointer-set', 1, a,
FEwrong_type_nth_arg(@[si::fill-pointer-set], 1, a,
ecl_read_from_cstring(type));
}
a->vector.fillp = ecl_fixnum_in_range(@'adjust-array',"fill pointer",fp,

14
src/c/character.d
View file

@ -23,7 +23,7 @@ ecl_character
ecl_char_code(cl_object c)
{
if (ecl_unlikely(!CHARACTERP(c)))
FEwrong_type_only_arg(@'char-code', c, @'character');
FEwrong_type_only_arg(@[char-code], c, @[character]);
return CHAR_CODE(c);
}
@ -37,7 +37,7 @@ ecl_base_char_code(cl_object c)
return (int)code;
}
}
FEwrong_type_only_arg(@'char-code', c, @'base-char');
FEwrong_type_only_arg(@[char-code], c, @[base-char]);
#else
return ecl_char_code(c);
#endif
@ -178,7 +178,7 @@ ecl_char_eq(cl_object x, cl_object y)
@
/* INV: ecl_char_eq() checks types of its arguments */
if (narg == 0)
FEwrong_num_arguments(@'char/=');
FEwrong_num_arguments(@[char/=]);
c = cl_va_arg(cs);
for (i = 2; i<=narg; i++) {
cl_va_list ds;
@ -261,7 +261,7 @@ ecl_char_equal(cl_object x, cl_object y)
@
/* INV: ecl_char_equal() checks the type of its arguments */
if (narg == 0)
FEwrong_num_arguments(@'char-not-equal');
FEwrong_num_arguments(@[char-not-equal]);
c = cl_va_arg(cs);
for (i = 2; i<=narg; i++) {
cl_va_list ds;
@ -348,7 +348,7 @@ cl_character(cl_object x)
break;
}
default: ERROR:
FEwrong_type_nth_arg(@'character', 1, x, ecl_read_from_cstring("(OR CHARACTER SYMBOL (ARRAY CHARACTER (1)) (ARRAY BASE-CHAR (1)))"));
FEwrong_type_nth_arg(@[character], 1, x, ecl_read_from_cstring("(OR CHARACTER SYMBOL (ARRAY CHARACTER (1)) (ARRAY BASE-CHAR (1)))"));
}
@(return x)
}
@ -376,7 +376,7 @@ cl_code_char(cl_object c)
c = Cnil;
break;
default:
FEwrong_type_only_arg(@'code-char', c, @'integer');
FEwrong_type_only_arg(@[code-char], c, @[integer]);
}
@(return c)
}
@ -415,7 +415,7 @@ cl_char_downcase(cl_object c)
case t_bignum:
break;
default:
FEwrong_type_nth_arg(@'digit-char',1,weight,@'integer');
FEwrong_type_nth_arg(@[digit-char],1,weight,@[integer]);
}
@(return output)
} @)

2
src/c/cmpaux.d
View file

@ -144,7 +144,7 @@ ecl_to_float(cl_object x)
return ecl_long_float(x);
#endif
default:
FEwrong_type_nth_arg(@'coerce', 1, x, @'real');
FEwrong_type_nth_arg(@[coerce], 1, x, @[real]);
}
}

40
src/c/dpp.c
View file

@ -251,13 +251,26 @@ search_keyword(const char *name)
}
char *
search_symbol(char *name, int *symbol_code)
search_symbol(char *name, int *symbol_code, int code)
{
int i;
for (i = 0; cl_symbols[i].name != NULL; i++) {
if (!strcasecmp(name, cl_symbols[i].name)) {
name = poolp;
if (i == 0) {
if (code) {
pushstr("MAKE_FIXNUM(/*");
pushstr(cl_symbols[i].name);
pushstr("*/");
if (i >= 1000)
pushc((i / 1000) % 10 + '0');
if (i >= 100)
pushc((i / 100) % 10 + '0');
if (i >= 10)
pushc((i / 10) % 10 + '0');
pushc(i % 10 + '0');
pushstr(")");
pushc(0);
} else if (i == 0) {
pushstr("Cnil");
pushc(0);
} else {
@ -283,19 +296,20 @@ search_symbol(char *name, int *symbol_code)
}
char *
read_symbol()
read_symbol(int code)
{
char c, *name = poolp;
char end = code? ']' : '\'';
c = readc();
while (c != '\'') {
while (c != end) {
if (c == '_') c = '-';
pushc(c);
c = readc();
}
pushc(0);
name = search_symbol(poolp = name, 0);
name = search_symbol(poolp = name, 0, code);
if (name == NULL) {
name = poolp;
printf("\nUnknown symbol: %s\n", name);
@ -387,7 +401,10 @@ read_token(void)
} else if (c == '@') {
c = readc();
if (c == '\'') {
(void)read_symbol();
(void)read_symbol(0);
poolp--;
} else if (c == '[') {
(void)read_symbol(1);
poolp--;
} else if (c == '@') {
pushc(c);
@ -448,7 +465,7 @@ void
get_function(void)
{
function = read_function();
function_symbol = search_symbol(function, &function_code);
function_symbol = search_symbol(function, &function_code, 0);
if (function_symbol == NULL) {
function_symbol = poolp;
pushstr("Cnil");
@ -833,7 +850,14 @@ LOOP:
} else if (c == '\'') {
char *p;
poolp = pool;
p = read_symbol();
p = read_symbol(0);
pushc('\0');
fprintf(out,"%s",p);
goto LOOP;
} else if (c == '[') {
char *p;
poolp = pool;
p = read_symbol(1);
pushc('\0');
fprintf(out,"%s",p);
goto LOOP;

17
src/c/error.d
View file

@ -26,6 +26,14 @@
#endif
#include <ecl/internal.h>
static cl_object
cl_symbol_or_object(cl_object x)
{
if (FIXNUMP(x))
return (cl_object)(cl_symbols + fix(x));
return x;
}
void
ecl_internal_error(const char *s)
{
@ -219,6 +227,7 @@ FEclosed_stream(cl_object strm)
void
FEwrong_type_argument(cl_object type, cl_object value)
{
type = cl_symbol_or_object(type);
cl_error(5, @'type-error', @':datum', value, @':expected-type', type);
}
@ -231,6 +240,8 @@ FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);
}
@ -252,6 +263,8 @@ FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_objec
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);
}
@ -284,9 +297,7 @@ FEundefined_function(cl_object fname)
void
FEwrong_num_arguments(cl_object fun)
{
if (FIXNUMP(fun)) {
fun = (cl_object)(cl_symbols + fix(fun));
}
fun = cl_symbol_or_object(fun);
FEprogram_error("Wrong number of arguments passed to function ~S.",
1, fun);
}

52
src/c/ffi.d
View file

@ -187,8 +187,8 @@ void *
ecl_foreign_data_pointer_safe(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-pointer', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-pointer], f,
@[si::foreign-data]);
}
return f->foreign.data;
}
@ -238,8 +238,8 @@ cl_object
si_free_foreign_data(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::free-foreign-data', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::free-foreign-data], f,
@[si::foreign-data]);
}
if (f->foreign.size) {
/* See si_allocate_foreign_data() */
@ -254,8 +254,8 @@ si_make_foreign_data_from_array(cl_object array)
{
cl_object tag = Cnil;
if (ecl_unlikely(type_of(array) != t_array && type_of(array) != t_vector)) {
FEwrong_type_only_arg(@'si::make-foreign-data-from-array', array,
@'array');
FEwrong_type_only_arg(@[si::make-foreign-data-from-array], array,
@[array]);
}
switch (array->array.elttype) {
case aet_sf: tag = @':float'; break;
@ -273,8 +273,8 @@ cl_object
si_foreign_data_address(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-address', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-address], f,
@[si::foreign-data]);
}
@(return ecl_make_unsigned_integer((cl_index)f->foreign.data))
}
@ -283,8 +283,8 @@ cl_object
si_foreign_data_tag(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-tag', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-tag], f,
@[si::foreign-data]);
}
@(return f->foreign.tag);
}
@ -298,8 +298,8 @@ si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize,
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_only_arg(@'si::foreign-data-pointer', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::foreign-data-pointer], f,
@[si::foreign-data]);
}
if (ecl_unlikely(ndx >= f->foreign.size || (f->foreign.size - ndx) < size)) {
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
@ -319,8 +319,8 @@ si_foreign_data_ref(cl_object f, cl_object andx, cl_object asize, cl_object tag)
cl_object output;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-ref', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-ref], 1, f,
@[si::foreign-data]);
}
if (ecl_unlikely(ndx >= f->foreign.size || (f->foreign.size - ndx) < size)) {
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
@ -337,12 +337,12 @@ si_foreign_data_set(cl_object f, cl_object andx, cl_object value)
cl_index size, limit;
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set], 1, f,
@[si::foreign-data]);
}
if (ecl_unlikely(type_of(value) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set', 3, value,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set], 3, value,
@[si::foreign-data]);
}
size = value->foreign.size;
limit = f->foreign.size;
@ -556,8 +556,8 @@ si_foreign_data_ref_elt(cl_object f, cl_object andx, cl_object type)
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
}
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-ref-elt', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-ref-elt], 1, f,
@[si::foreign-data]);
}
@(return ecl_foreign_data_ref_elt((void*)(f->foreign.data + ndx), tag))
}
@ -572,8 +572,8 @@ si_foreign_data_set_elt(cl_object f, cl_object andx, cl_object type, cl_object v
FEerror("Out of bounds reference into foreign data type ~A.", 1, f);
}
if (ecl_unlikely(type_of(f) != t_foreign)) {
FEwrong_type_nth_arg(@'si::foreign-data-set-elt', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-set-elt], 1, f,
@[si::foreign-data]);
}
ecl_foreign_data_set_elt((void*)(f->foreign.data + ndx), tag, value);
@(return value)
@ -590,8 +590,8 @@ cl_object
si_null_pointer_p(cl_object f)
{
if (ecl_unlikely(type_of(f) != t_foreign))
FEwrong_type_only_arg(@'si::null-pointer-p', f,
@'si::foreign-data');
FEwrong_type_only_arg(@[si::null-pointer-p], f,
@[si::foreign-data]);
@(return ((f->foreign.data == NULL)? Ct : Cnil))
}
@ -599,8 +599,8 @@ cl_object
si_foreign_data_recast(cl_object f, cl_object size, cl_object tag)
{
if (ecl_unlikely(type_of(f) != t_foreign))
FEwrong_type_nth_arg(@'si::foreign-data-recast', 1, f,
@'si::foreign-data');
FEwrong_type_nth_arg(@[si::foreign-data-recast], 1, f,
@[si::foreign-data]);
f->foreign.size = fixnnint(size);
f->foreign.tag = tag;
@(return f)

32
src/c/file.d
View file

@ -1853,8 +1853,8 @@ cl_two_way_stream_input_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_two_way))
FEwrong_type_only_arg(@'two-way-stream-input-stream',
strm, @'two-way-stream');
FEwrong_type_only_arg(@[two-way-stream-input-stream],
strm, @[two-way-stream]);
@(return TWO_WAY_STREAM_INPUT(strm))
}
@ -1863,8 +1863,8 @@ cl_two_way_stream_output_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_two_way))
FEwrong_type_only_arg(@'two-way-stream-output-stream',
strm, @'two-way-stream');
FEwrong_type_only_arg(@[two-way-stream-output-stream],
strm, @[two-way-stream]);
@(return TWO_WAY_STREAM_OUTPUT(strm))
}
@ -2044,8 +2044,8 @@ cl_broadcast_stream_streams(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_broadcast))
FEwrong_type_only_arg(@'broadcast-stream-streams',
strm, @'broadcast-stream');
FEwrong_type_only_arg(@[broadcast-stream-streams],
strm, @[broadcast-stream]);
return cl_copy_list(BROADCAST_STREAM_LIST(strm));
}
@ -2226,8 +2226,8 @@ cl_echo_stream_input_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_echo))
FEwrong_type_only_arg(@'echo-stream-input-stream',
strm, @'echo-stream');
FEwrong_type_only_arg(@[echo-stream-input-stream],
strm, @[echo-stream]);
@(return ECHO_STREAM_INPUT(strm))
}
@ -2236,8 +2236,8 @@ cl_echo_stream_output_stream(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_echo))
FEwrong_type_only_arg(@'echo-stream-output-stream',
strm, @'echo-stream');
FEwrong_type_only_arg(@[echo-stream-output-stream],
strm, @[echo-stream]);
@(return ECHO_STREAM_OUTPUT(strm))
}
@ -2380,8 +2380,8 @@ cl_concatenated_stream_streams(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_concatenated))
FEwrong_type_only_arg(@'concatenated-stream-streams',
strm, @'concatenated-stream');
FEwrong_type_only_arg(@[concatenated-stream-streams],
strm, @[concatenated-stream]);
return cl_copy_list(CONCATENATED_STREAM_LIST(strm));
}
@ -2580,8 +2580,8 @@ cl_synonym_stream_symbol(cl_object strm)
{
if (ecl_unlikely(type_of(strm) != t_stream ||
strm->stream.mode != smm_synonym))
FEwrong_type_only_arg(@'synonym-stream-symbol',
strm, @'synonym-stream');
FEwrong_type_only_arg(@[synonym-stream-symbol],
strm, @[synonym-stream]);
@(return SYNONYM_STREAM_SYMBOL(strm))
}
@ -4210,7 +4210,7 @@ cl_file_string_length(cl_object stream, cl_object string)
l = compute_char_size(stream, CHAR_CODE(string));
break;
default:
FEwrong_type_nth_arg(@'file-string-length', 2, string, @'string');
FEwrong_type_nth_arg(@[file-string-length], 2, string, @[string]);
}
@(return MAKE_FIXNUM(l))
}
@ -4391,7 +4391,7 @@ cl_stream_external_format(cl_object strm)
else
#endif
if (ecl_unlikely(t != t_stream))
FEwrong_type_only_arg(@'stream-external-format', strm, @'stream');
FEwrong_type_only_arg(@[stream-external-format], strm, @[stream]);
if (strm->stream.mode == smm_synonym) {
strm = SYNONYM_STREAM_STREAM(strm);
goto AGAIN;

10
src/c/gfun.d
View file

@ -72,8 +72,8 @@ cl_object
clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'clos::set-funcallable-instance-function',
1, x, @'ext::instance');
FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function],
1, x, @[ext::instance]);
if (x->instance.isgf == ECL_USER_DISPATCH) {
reshape_instance(x, -1);
x->instance.isgf = ECL_NOT_FUNCALLABLE;
@ -176,7 +176,7 @@ si_clear_gfun_hash(cl_object what)
cl_object process = ECL_CONS_CAR(list);
struct cl_env_struct *env = process->process.env;
env->method_hash_clear_list = CONS(what, env->method_hash_clear_list);
} end_loop_for_on;
} end_loop_for_on_unsafe(list);
THREAD_OP_UNLOCK();
#else
do_clear_method_hash(&cl_env, what);
@ -312,7 +312,7 @@ get_spec_vector(cl_env_ptr env, cl_object frame, cl_object gf)
args[spec_position];
if (spec_no > vector->vector.dim)
return OBJNULL;
} end_loop_for_on;
} end_loop_for_on_unsafe(spec_how_list);
vector->vector.fillp = spec_no;
return vector;
}
@ -365,7 +365,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
clear_list = env->method_hash_clear_list;
loop_for_on_unsafe(clear_list) {
do_clear_method_hash(&cl_env, ECL_CONS_CAR(clear_list));
} end_loop_for_on;
} end_loop_for_on_unsafe(clear_list);
env->method_hash_clear_list = Cnil;
THREAD_OP_UNLOCK();
}

30
src/c/hash.d
View file

@ -31,7 +31,7 @@ static void
assert_type_hash_table(cl_object function, cl_narg narg, cl_object p)
{
if (ecl_unlikely(type_of(p) != t_hashtable))
FEwrong_type_nth_arg(function, narg, p, @'hash-table');
FEwrong_type_nth_arg(function, narg, p, @[hash-table]);
}
static void
@ -416,7 +416,7 @@ ecl_gethash(cl_object key, cl_object hashtable)
{
cl_object output;
assert_type_hash_table(@'gethash', 2, hashtable);
assert_type_hash_table(@[gethash], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
output = hashtable->hash.get(key, hashtable)->value;
HASH_TABLE_UNLOCK(hashtable);
@ -428,7 +428,7 @@ ecl_gethash_safe(cl_object key, cl_object hashtable, cl_object def)
{
struct ecl_hashtable_entry *e;
assert_type_hash_table(@'gethash', 2, hashtable);
assert_type_hash_table(@[gethash], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key != OBJNULL)
@ -446,7 +446,7 @@ _ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
cl_object
ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
{
assert_type_hash_table(@'si::hash-set', 2, hashtable);
assert_type_hash_table(@[si::hash-set], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
hashtable = hashtable->hash.set(key, hashtable, value);
HASH_TABLE_UNLOCK(hashtable);
@ -460,7 +460,7 @@ ecl_extend_hashtable(cl_object hashtable)
cl_index old_size, new_size, i;
cl_object new_size_obj;
assert_type_hash_table(@'si::hash-set', 2, hashtable);
assert_type_hash_table(@[si::hash-set], 2, hashtable);
old_size = hashtable->hash.size;
/* We do the computation with lisp datatypes, just in case the sizes contain
* weird numbers */
@ -639,7 +639,7 @@ cl_hash_table_p(cl_object ht)
@(defun gethash (key ht &optional (no_value Cnil))
struct ecl_hashtable_entry e;
@
assert_type_hash_table(@'gethash', 2, ht);
assert_type_hash_table(@[gethash], 2, ht);
HASH_TABLE_LOCK(ht);
e = *(ht->hash.get(key, ht));
HASH_TABLE_UNLOCK(ht);
@ -663,7 +663,7 @@ ecl_remhash(cl_object key, cl_object hashtable)
struct ecl_hashtable_entry *e;
bool output;
assert_type_hash_table(@'remhash', 2, hashtable);
assert_type_hash_table(@[remhash], 2, hashtable);
HASH_TABLE_LOCK(hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key == OBJNULL) {
@ -688,7 +688,7 @@ cl_remhash(cl_object key, cl_object ht)
cl_object
cl_clrhash(cl_object ht)
{
assert_type_hash_table(@'clrhash', 1, ht);
assert_type_hash_table(@[clrhash], 1, ht);
if (ht->hash.entries) {
HASH_TABLE_LOCK(ht);
do_clrhash(ht);
@ -701,7 +701,7 @@ cl_object
cl_hash_table_test(cl_object ht)
{
cl_object output;
assert_type_hash_table(@'hash-table-test', 1, ht);
assert_type_hash_table(@[hash-table-test], 1, ht);
switch(ht->hash.test) {
case htt_eq: output = @'eq'; break;
case htt_eql: output = @'eql'; break;
@ -716,14 +716,14 @@ cl_hash_table_test(cl_object ht)
cl_object
cl_hash_table_size(cl_object ht)
{
assert_type_hash_table(@'hash-table-size', 1, ht);
assert_type_hash_table(@[hash-table-size], 1, ht);
@(return MAKE_FIXNUM(ht->hash.size))
}
cl_object
cl_hash_table_count(cl_object ht)
{
assert_type_hash_table(@'hash-table-count', 1, ht);
assert_type_hash_table(@[hash-table-count], 1, ht);
@(return (MAKE_FIXNUM(ht->hash.entries)))
}
@ -755,7 +755,7 @@ si_hash_table_iterate(cl_narg narg)
cl_object
si_hash_table_iterator(cl_object ht)
{
assert_type_hash_table(@'si::hash-table-iterator', 1, ht);
assert_type_hash_table(@[si::hash-table-iterator], 1, ht);
@(return ecl_make_cclosure_va((cl_objectfn)si_hash_table_iterate,
cl_list(2, MAKE_FIXNUM(-1), ht),
@'si::hash-table-iterator'))
@ -764,14 +764,14 @@ si_hash_table_iterator(cl_object ht)
cl_object
cl_hash_table_rehash_size(cl_object ht)
{
assert_type_hash_table(@'hash-table-rehash-size', 1, ht);
assert_type_hash_table(@[hash-table-rehash-size], 1, ht);
@(return ht->hash.rehash_size)
}
cl_object
cl_hash_table_rehash_threshold(cl_object ht)
{
assert_type_hash_table(@'hash-table-rehash-threshold', 1, ht);
assert_type_hash_table(@[hash-table-rehash-threshold], 1, ht);
@(return ht->hash.threshold)
}
@ -818,7 +818,7 @@ cl_maphash(cl_object fun, cl_object ht)
{
cl_index i;
assert_type_hash_table(@'maphash', 2, ht);
assert_type_hash_table(@[maphash], 2, ht);
for (i = 0; i < ht->hash.size; i++) {
struct ecl_hashtable_entry e = ht->hash.data[i];
if(e.key != OBJNULL)

20
src/c/instance.d
View file

@ -58,7 +58,7 @@ cl_object
si_instance_class(cl_object x)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_only_arg(@'class-of', x, @'ext::instance');
FEwrong_type_only_arg(@[class-of], x, @[ext::instance]);
@(return CLASS_OF(x))
}
@ -66,9 +66,9 @@ cl_object
si_instance_class_set(cl_object x, cl_object y)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-class-set', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-class-set], 1, x, @[ext::instance]);
if (ecl_unlikely(!ECL_INSTANCEP(y)))
FEwrong_type_nth_arg(@'si::instance-class-set', 2, y, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-class-set], 2, y, @[ext::instance]);
CLASS_OF(x) = y;
@(return x)
}
@ -77,7 +77,7 @@ cl_object
ecl_instance_ref(cl_object x, cl_fixnum i)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-ref', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-ref], 1, x, @[ext::instance]);
if (ecl_unlikely(i < 0 || i >= (cl_fixnum)x->instance.length))
FEtype_error_index(x, MAKE_FIXNUM(i));
return(x->instance.slots[i]);
@ -89,7 +89,7 @@ si_instance_ref(cl_object x, cl_object index)
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-ref', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-ref], 1, x, @[ext::instance]);
if (ecl_unlikely(!FIXNUMP(index) ||
(i = fix(index)) < 0 || i >= (cl_fixnum)x->instance.length))
FEtype_error_index(x, index);
@ -102,7 +102,7 @@ si_instance_ref_safe(cl_object x, cl_object index)
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-ref', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-ref], 1, x, @[ext::instance]);
if (ecl_unlikely(!FIXNUMP(index) ||
(i = fix(index)) < 0 || i >= x->instance.length))
FEtype_error_index(x, index);
@ -116,7 +116,7 @@ cl_object
ecl_instance_set(cl_object x, cl_fixnum i, cl_object v)
{
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-set', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-set], 1, x, @[ext::instance]);
if (ecl_unlikely(i >= x->instance.length || i < 0))
FEtype_error_index(x, MAKE_FIXNUM(i));
x->instance.slots[i] = v;
@ -129,7 +129,7 @@ si_instance_set(cl_object x, cl_object index, cl_object value)
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::instance-set', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::instance-set], 1, x, @[ext::instance]);
if (ecl_unlikely(!FIXNUMP(index) ||
(i = fix(index)) >= (cl_fixnum)x->instance.length || i < 0))
FEtype_error_index(x, index);
@ -163,7 +163,7 @@ si_sl_makunbound(cl_object x, cl_object index)
cl_fixnum i;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::sl-makunbound', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::sl-makunbound], 1, x, @[ext::instance]);
if (ecl_unlikely(!FIXNUMP(index) ||
(i = fix(index)) >= x->instance.length || i < 0))
FEtype_error_index(x, index);
@ -177,7 +177,7 @@ si_copy_instance(cl_object x)
cl_object y;
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@'si::copy-instance', 1, x, @'ext::instance');
FEwrong_type_nth_arg(@[si::copy-instance], 1, x, @[ext::instance]);
y = ecl_allocate_instance(x->instance.clas, x->instance.length);
y->instance.sig = x->instance.sig;
memcpy(y->instance.slots, x->instance.slots,

6
src/c/interpreter.d
View file

@ -334,14 +334,14 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
CASE(OP_CAR); {
if (ecl_unlikely(!LISTP(reg0)))
FEwrong_type_only_arg(@'car', reg0, @'cons');
FEwrong_type_only_arg(@[car], reg0, @[cons]);
reg0 = CAR(reg0);
THREAD_NEXT;
}
CASE(OP_CDR); {
if (ecl_unlikely(!LISTP(reg0)))
FEwrong_type_only_arg(@'cdr', reg0, @'cons');
FEwrong_type_only_arg(@[cdr], reg0, @[cons]);
reg0 = CDR(reg0);
THREAD_NEXT;
}
@ -819,7 +819,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
CASE(OP_ENDP);
if (ecl_unlikely(!LISTP(reg0)))
FEwrong_type_only_arg(@'endp', reg0, @'list');
FEwrong_type_only_arg(@[endp], reg0, @[list]);
CASE(OP_NOT); {
reg0 = (reg0 == Cnil)? Ct : Cnil;
THREAD_NEXT;

33
src/c/list.d
View file

@ -137,7 +137,7 @@ cl_object
cl_car(cl_object x)
{
if (ecl_unlikely(!LISTP(x)))
FEwrong_type_only_arg(@'car', x, @'list');
FEwrong_type_only_arg(@[car], x, @[list]);
return1(Null(x)? x : ECL_CONS_CAR(x));
}
@ -145,7 +145,7 @@ cl_object
cl_cdr(cl_object x)
{
if (ecl_unlikely(!LISTP(x)))
FEwrong_type_only_arg(@'car', x, @'list');
FEwrong_type_only_arg(@[car], x, @[list]);
return1(Null(x)? x : ECL_CONS_CDR(x));
}
@ -167,7 +167,7 @@ cl_cdr(cl_object x)
cl_object head;
@
if (narg == 0)
FEwrong_num_arguments(@'list*');
FEwrong_num_arguments(@[list*]);
head = cl_va_arg(args);
if (--narg) {
cl_object tail = head = ecl_list1(head);
@ -244,7 +244,7 @@ ecl_append(cl_object x, cl_object y)
cl_object cl_##name(cl_object foo) { \
register cl_object arg = foo; \
code; return1(arg); \
E: FEwrong_type_only_arg(@'car',arg,@'list');}
E: FEwrong_type_only_arg(@[car],arg,@[list]);}
defcxr(caar, x, car(car(x)))
defcxr(cadr, x, car(cdr(x)))
@ -330,7 +330,7 @@ cl_endp(cl_object x)
if (Null(x)) {
output = Ct;
} else if (ecl_unlikely(!LISTP(x))) {
FEwrong_type_only_arg(@'endp', x, @'list');
FEwrong_type_only_arg(@[endp], x, @[list]);
}
@(return output);
}
@ -341,7 +341,7 @@ ecl_endp(cl_object x)
if (Null(x)) {
return TRUE;
} else if (ecl_unlikely(!LISTP(x))) {
FEwrong_type_only_arg(@'endp', x, @'list');
FEwrong_type_only_arg(@[endp], x, @[list]);
}
return FALSE;
}
@ -459,7 +459,7 @@ cl_copy_list(cl_object x)
{
cl_object copy;
if (ecl_unlikely(!LISTP(x))) {
FEwrong_type_only_arg(@'copy-list', x, @'list');
FEwrong_type_only_arg(@[copy-list], x, @[list]);
}
copy = Cnil;
if (!Null(x)) {
@ -488,7 +488,7 @@ cl_copy_alist(cl_object x)
{
cl_object copy;
if (ecl_unlikely(!LISTP(x))) {
FEwrong_type_only_arg(@'copy-alist', x, @'list');
FEwrong_type_only_arg(@[copy-alist], x, @[list]);
}
copy = Cnil;
if (!Null(x)) {
@ -625,7 +625,7 @@ ecl_nbutlast(cl_object l, cl_index n)
{
cl_object r;
if (ecl_unlikely(!LISTP(l)))
FEwrong_type_only_arg(@'nbutlast', l, @'list');
FEwrong_type_only_arg(@[nbutlast], l, @[list]);
for (n++, r = l; n && CONSP(r); n--, r = ECL_CONS_CDR(r))
;
if (n == 0) {
@ -654,7 +654,7 @@ cl_ldiff(cl_object x, cl_object y)
{
cl_object head = Cnil;
if (ecl_unlikely(!LISTP(x))) {
FEwrong_type_only_arg(@'ldiff', x, @'list');
FEwrong_type_only_arg(@[ldiff], x, @[list]);
}
/* Here we use that, if X or Y are CONS, then (EQL X Y)
* only when X == Y */
@ -683,7 +683,7 @@ cl_object
cl_rplaca(cl_object x, cl_object v)
{
if (ecl_unlikely(!CONSP(x)))
FEwrong_type_nth_arg(@'rplaca', 1, x, @'cons');
FEwrong_type_nth_arg(@[rplaca], 1, x, @[cons]);
ECL_RPLACA(x, v);
@(return x)
}
@ -692,7 +692,7 @@ cl_object
cl_rplacd(cl_object x, cl_object v)
{
if (ecl_unlikely(!CONSP(x)))
FEwrong_type_nth_arg(@'rplacd', 1, x, @'cons');
FEwrong_type_nth_arg(@[rplacd], 1, x, @[cons]);
ECL_RPLACD(x, v);
@(return x)
}
@ -920,9 +920,8 @@ cl_object
cl_tailp(cl_object y, cl_object x)
{
loop_for_on(x) {
if (ecl_eql(x, y))
@(return Ct)
} end_loop_for_on;
if (ecl_eql(x, y)) @(return Ct);
} end_loop_for_on(x);
return cl_eql(x, y);
}
@ -930,7 +929,7 @@ cl_tailp(cl_object y, cl_object x)
cl_object output;
@
if (narg < 2)
FEwrong_num_arguments(@'adjoin');
FEwrong_num_arguments(@[adjoin]);
output = @si::member1(item, list, test, test_not, key);
if (Null(output))
output = CONS(item, list);
@ -1026,7 +1025,7 @@ ecl_remove_eq(cl_object x, cl_object l)
tail = cons;
}
}
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
return head;
}

12
src/c/mapfun.d
View file

@ -40,7 +40,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'mapcar', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[mapcar], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);
@ -64,7 +64,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'maplist', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[maplist], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);
@ -88,7 +88,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'mapc', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[mapc], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);
@ -111,7 +111,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'mapl', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[mapl], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);
@ -134,7 +134,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'mapcan', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[mapcan], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);
@ -159,7 +159,7 @@
for (i = 0; i < narg; i++) {
cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i);
if (ecl_unlikely(!LISTP(cdr)))
FEwrong_type_nth_arg(@'mapcon', i+2, cdr, @'list');
FEwrong_type_nth_arg(@[mapcon], i+2, cdr, @[list]);
if (Null(cdr)) {
ecl_stack_frame_close(cars_frame);
ecl_stack_frame_close(cdrs_frame);

82
src/c/num_arith.d
View file

@ -61,7 +61,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
case t_bignum:
switch (type_of(y)) {
@ -87,7 +87,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
case t_ratio:
switch (type_of(y)) {
@ -114,7 +114,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat: {
@ -138,7 +138,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
}
#endif
@ -165,7 +165,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
}
case t_doublefloat: {
@ -193,7 +193,7 @@ ecl_times(cl_object x, cl_object y)
ecl_times(x, y->complex.imag));
}
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
}
#ifdef ECL_LONG_FLOAT
@ -218,7 +218,7 @@ ecl_times(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'*', 2, y, @'number');
FEwrong_type_nth_arg(@[*], 2, y, @[number]);
}
}
#endif
@ -238,7 +238,7 @@ ecl_times(cl_object x, cl_object y)
return ecl_make_complex(ecl_minus(z11, z12), ecl_plus(z21, z22));
}
default:
FEwrong_type_nth_arg(@'*', 1, x, @'number');
FEwrong_type_nth_arg(@[*], 1, x, @[number]);
}
}
@ -286,7 +286,7 @@ ecl_plus(cl_object x, cl_object y)
return ecl_make_complex(ecl_plus(x, y->complex.real),
y->complex.imag);
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
case t_bignum:
switch (type_of(y)) {
@ -313,7 +313,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
case t_ratio:
switch (type_of(y)) {
@ -343,7 +343,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -366,7 +366,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
#endif
case t_singlefloat:
@ -391,7 +391,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
case t_doublefloat:
switch (type_of(y)) {
@ -415,7 +415,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
#ifdef ECL_LONG_FLOAT
case t_longfloat:
@ -438,7 +438,7 @@ ecl_plus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'+', 2, y, @'number');
FEwrong_type_nth_arg(@[+], 2, y, @[number]);
}
#endif
case t_complex:
@ -451,7 +451,7 @@ ecl_plus(cl_object x, cl_object y)
z1 = ecl_plus(x->complex.imag, y->complex.imag);
return ecl_make_complex(z, z1);
default:
FEwrong_type_nth_arg(@'+', 1, x, @'number');
FEwrong_type_nth_arg(@[+], 1, x, @[number]);
}
}
@ -499,7 +499,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
case t_bignum:
switch (type_of(y)) {
@ -526,7 +526,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
case t_ratio:
switch (type_of(y)) {
@ -556,7 +556,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -579,7 +579,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
#endif
case t_singlefloat:
@ -604,7 +604,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
case t_doublefloat:
switch (type_of(y)) {
@ -628,7 +628,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
#ifdef ECL_LONG_FLOAT
case t_longfloat:
@ -651,7 +651,7 @@ ecl_minus(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'-', 2, y, @'number');
FEwrong_type_nth_arg(@[-], 2, y, @[number]);
}
#endif
COMPLEX:
@ -667,7 +667,7 @@ ecl_minus(cl_object x, cl_object y)
}
return ecl_make_complex(z, z1);
default:
FEwrong_type_nth_arg(@'-', 1, x, @'number');
FEwrong_type_nth_arg(@[-], 1, x, @[number]);
}
}
@ -688,7 +688,7 @@ cl_conjugate(cl_object c)
#endif
break;
default:
FEwrong_type_only_arg(@'conjugate', c, @'number');
FEwrong_type_only_arg(@[conjugate], c, @[number]);
}
@(return c)
}
@ -730,7 +730,7 @@ ecl_negate(cl_object x)
z1 = ecl_negate(x->complex.imag);
return ecl_make_complex(z, z1);
default:
FEwrong_type_only_arg(@'-', x, @'number');
FEwrong_type_only_arg(@[-], x, @[number]);
}
}
@ -739,7 +739,7 @@ ecl_negate(cl_object x)
@
/* INV: type check is in ecl_divide() */
if (narg == 0)
FEwrong_num_arguments(@'/');
FEwrong_num_arguments(@[/]);
if (narg == 1)
@(return ecl_divide(MAKE_FIXNUM(1), num))
while (--narg)
@ -783,7 +783,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
case t_ratio:
switch (type_of(y)) {
@ -812,7 +812,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -835,7 +835,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
#endif
case t_singlefloat:
@ -860,7 +860,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
case t_doublefloat:
switch (type_of(y)) {
@ -884,7 +884,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
#ifdef ECL_LONG_FLOAT
case t_longfloat:
@ -907,7 +907,7 @@ ecl_divide(cl_object x, cl_object y)
case t_complex:
goto COMPLEX;
default:
FEwrong_type_nth_arg(@'/', 2, y, @'number');
FEwrong_type_nth_arg(@[/], 2, y, @[number]);
}
#endif
case t_complex:
@ -932,7 +932,7 @@ ecl_divide(cl_object x, cl_object y)
z = ecl_make_complex(ecl_divide(z1, z), ecl_divide(z2, z));
return(z);
default:
FEwrong_type_nth_arg(@'/', 1, x, @'number');
FEwrong_type_nth_arg(@[/], 1, x, @[number]);
}
}
@ -951,7 +951,7 @@ ecl_integer_divide(cl_object x, cl_object y)
} else if (ty == t_bignum) {
return _ecl_fix_divided_by_big(fix(x), y);
} else {
FEwrong_type_nth_arg(@'round', 2, y, @'integer');
FEwrong_type_nth_arg(@[round], 2, y, @[integer]);
}
}
if (tx == t_bignum) {
@ -960,10 +960,10 @@ ecl_integer_divide(cl_object x, cl_object y)
} else if (ty == t_fixnum) {
return _ecl_big_divided_by_fix(x, fix(y));
} else {
FEwrong_type_nth_arg(@'round', 2, y, @'integer');
FEwrong_type_nth_arg(@[round], 2, y, @[integer]);
}
}
FEwrong_type_nth_arg(@'round', 1, x, @'integer');
FEwrong_type_nth_arg(@[round], 1, x, @[integer]);
}
@(defun gcd (&rest nums)
@ -996,7 +996,7 @@ ecl_gcd(cl_object x, cl_object y)
case t_bignum:
break;
default:
FEwrong_type_nth_arg(@'gcd', 1, x, @'integer');
FEwrong_type_nth_arg(@[gcd], 1, x, @[integer]);
}
switch (type_of(y)) {
case t_fixnum:
@ -1005,7 +1005,7 @@ ecl_gcd(cl_object x, cl_object y)
case t_bignum:
break;
default:
FEwrong_type_nth_arg(@'gcd', 2, y, @'integer');
FEwrong_type_nth_arg(@[gcd], 2, y, @[integer]);
}
return _ecl_big_gcd(x, y);
}
@ -1061,7 +1061,7 @@ ecl_one_plus(cl_object x)
return ecl_make_complex(z, x->complex.imag);
default:
FEwrong_type_only_arg(@'1+', x, @'number');
FEwrong_type_only_arg(@[1+], x, @[number]);
}
}
@ -1116,7 +1116,7 @@ ecl_one_minus(cl_object x)
return ecl_make_complex(z, x->complex.imag);
default:
FEwrong_type_only_arg(@'1-', x, @'number');
FEwrong_type_only_arg(@[1-], x, @[number]);
}
}

46
src/c/num_co.d
View file

@ -90,11 +90,11 @@ number_remainder(cl_object x, cl_object y, cl_object q)
x = ecl_make_longfloat(ecl_to_long_double(x)); break;
#endif
default:
FEwrong_type_nth_arg(@'float',2,y,@'float');
FEwrong_type_nth_arg(@[float],2,y,@[float]);
}
break;
default:
FEwrong_type_nth_arg(@'float',1,x,@'real');
FEwrong_type_nth_arg(@[float],1,x,@[real]);
}
@(return x)
@)
@ -110,7 +110,7 @@ cl_numerator(cl_object x)
case t_bignum:
break;
default:
FEwrong_type_nth_arg(@'numerator',1,x,@'rational');
FEwrong_type_nth_arg(@[numerator],1,x,@[rational]);
}
@(return x)
}
@ -127,7 +127,7 @@ cl_denominator(cl_object x)
x = MAKE_FIXNUM(1);
break;
default:
FEwrong_type_nth_arg(@'numerator',1,x,@'rational');
FEwrong_type_nth_arg(@[numerator],1,x,@[rational]);
}
@(return x)
}
@ -180,7 +180,7 @@ ecl_floor1(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'floor',1,x,@'real');
FEwrong_type_nth_arg(@[floor],1,x,@[real]);
}
@(return v0 v1)
}
@ -193,7 +193,7 @@ ecl_floor2(cl_object x, cl_object y)
cl_type ty;
ty = type_of(y);
if (ecl_unlikely(!ECL_NUMBER_TYPE_P(ty))) {
FEwrong_type_nth_arg(@'floor',2,y,@'real');
FEwrong_type_nth_arg(@[floor],2,y,@[real]);
}
switch(type_of(x)) {
case t_fixnum:
@ -373,7 +373,7 @@ ecl_floor2(cl_object x, cl_object y)
}
#endif
default:
FEwrong_type_nth_arg(@'floor', 1, x, @'real');
FEwrong_type_nth_arg(@[floor], 1, x, @[real]);
}
@(return v0 v1)
}
@ -434,7 +434,7 @@ ecl_ceiling1(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'ceiling',1,x,@'real');
FEwrong_type_nth_arg(@[ceiling],1,x,@[real]);
}
@(return v0 v1)
}
@ -447,7 +447,7 @@ ecl_ceiling2(cl_object x, cl_object y)
cl_type ty;
ty = type_of(y);
if (ecl_unlikely(!ECL_NUMBER_TYPE_P(ty))) {
FEwrong_type_nth_arg(@'ceiling',2, y, @'real');
FEwrong_type_nth_arg(@[ceiling],2, y, @[real]);
}
switch(type_of(x)) {
case t_fixnum:
@ -624,7 +624,7 @@ ecl_ceiling2(cl_object x, cl_object y)
}
#endif
default:
FEwrong_type_nth_arg(@'ceiling', 1, x, @'real');
FEwrong_type_nth_arg(@[ceiling], 1, x, @[real]);
}
@(return v0 v1)
}
@ -686,7 +686,7 @@ ecl_truncate1(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'truncate',1,x,@'real');
FEwrong_type_nth_arg(@[truncate],1,x,@[real]);
}
@(return v0 v1)
}
@ -794,7 +794,7 @@ ecl_round1(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'round',1,x,@'real');
FEwrong_type_nth_arg(@[round],1,x,@[real]);
}
@(return v0 v1)
}
@ -919,7 +919,7 @@ cl_decode_float(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'decode-float',1,x,@'float');
FEwrong_type_nth_arg(@[decode-float],1,x,@[float]);
}
@(return x MAKE_FIXNUM(e) ecl_make_singlefloat(s))
}
@ -933,7 +933,7 @@ cl_scale_float(cl_object x, cl_object y)
if (FIXNUMP(y)) {
k = fix(y);
} else {
FEwrong_type_nth_arg(@'scale-float',2,y,@'fixnum');
FEwrong_type_nth_arg(@[scale-float],2,y,@[fixnum]);
}
switch (type_of(x)) {
#ifdef ECL_SHORT_FLOAT
@ -953,7 +953,7 @@ cl_scale_float(cl_object x, cl_object y)
break;
#endif
default:
FEwrong_type_nth_arg(@'scale-float',1,x,@'float');
FEwrong_type_nth_arg(@[scale-float],1,x,@[float]);
}
@(return x)
}
@ -963,7 +963,7 @@ cl_float_radix(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
if (ecl_unlikely(cl_floatp(x) != Ct)) {
FEwrong_type_nth_arg(@'float-radix',1,x,@'float');
FEwrong_type_nth_arg(@[float-radix],1,x,@[float]);
}
@(return MAKE_FIXNUM(FLT_RADIX))
}
@ -988,7 +988,7 @@ cl_float_radix(cl_object x)
negativep = signbit(ecl_long_float(x)); break;
#endif
default:
FEwrong_type_nth_arg(@'float-sign',1,x,@'float');
FEwrong_type_nth_arg(@[float-sign],1,x,@[float]);
}
switch (type_of(y)) {
#ifdef ECL_SHORT_FLOAT
@ -1016,7 +1016,7 @@ cl_float_radix(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'float-sign',2,y,@'float');
FEwrong_type_nth_arg(@[float-sign],2,y,@[float]);
}
@(return y);
@)
@ -1041,7 +1041,7 @@ cl_float_digits(cl_object x)
break;
#endif
default:
FEwrong_type_nth_arg(@'float-digits',1,x,@'float');
FEwrong_type_nth_arg(@[float-digits],1,x,@[float]);
}
@(return x)
}
@ -1117,7 +1117,7 @@ cl_float_precision(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'float-precision',1,x,@'float');
FEwrong_type_nth_arg(@[float-precision],1,x,@[float]);
}
@(return MAKE_FIXNUM(precision))
}
@ -1199,7 +1199,7 @@ cl_integer_decode_float(cl_object x)
}
#endif
default:
FEwrong_type_nth_arg(@'integer-decode-float',1,x,@'float');
FEwrong_type_nth_arg(@[integer-decode-float],1,x,@[float]);
}
@(return x MAKE_FIXNUM(e) MAKE_FIXNUM(s))
}
@ -1230,7 +1230,7 @@ cl_realpart(cl_object x)
x = x->complex.real;
break;
default:
FEwrong_type_nth_arg(@'realpart',1,x,@'number');
FEwrong_type_nth_arg(@[realpart],1,x,@[number]);
}
@(return x)
}
@ -1276,7 +1276,7 @@ cl_imagpart(cl_object x)
x = x->complex.imag;
break;
default:
FEwrong_type_nth_arg(@'imagpart',1,x,@'number');
FEwrong_type_nth_arg(@[imagpart],1,x,@[number]);
}
@(return x)
}

26
src/c/num_comp.d
View file

@ -118,7 +118,7 @@ ecl_number_equalp(cl_object x, cl_object y)
case t_complex:
goto Y_COMPLEX;
default:
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
}
case t_bignum:
switch (type_of(y)) {
@ -141,7 +141,7 @@ ecl_number_equalp(cl_object x, cl_object y)
case t_complex:
goto Y_COMPLEX;
default:
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
}
case t_ratio:
switch (type_of(y)) {
@ -164,7 +164,7 @@ ecl_number_equalp(cl_object x, cl_object y)
case t_complex:
goto Y_COMPLEX;
default:
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -199,7 +199,7 @@ ecl_number_equalp(cl_object x, cl_object y)
case t_complex:
goto Y_COMPLEX;
default:
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
}
#ifdef ECL_LONG_FLOAT
case t_longfloat: {
@ -224,7 +224,7 @@ ecl_number_equalp(cl_object x, cl_object y)
case t_complex:
goto Y_COMPLEX;
default:
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
}
}
#endif
@ -242,9 +242,9 @@ ecl_number_equalp(cl_object x, cl_object y)
else
return 0;
}
FEwrong_type_nth_arg(@'=', 2, y, @'number');
FEwrong_type_nth_arg(@[=], 2, y, @[number]);
default:
FEwrong_type_nth_arg(@'=', 1, x, @'number');
FEwrong_type_nth_arg(@[=], 1, x, @[number]);
}
}
@ -297,7 +297,7 @@ ecl_number_compare(cl_object x, cl_object y)
return long_double_fix_compare(ix, ecl_long_float(y));
#endif
default:
FEwrong_type_nth_arg(@'<', 2, y, @'real');
FEwrong_type_nth_arg(@[<], 2, y, @[real]);
}
case t_bignum:
switch (ty) {
@ -320,7 +320,7 @@ ecl_number_compare(cl_object x, cl_object y)
y = cl_rational(y);
goto BEGIN;
default:
FEwrong_type_nth_arg(@'<', 2, y, @'real');
FEwrong_type_nth_arg(@[<], 2, y, @[real]);
}
case t_ratio:
switch (ty) {
@ -345,7 +345,7 @@ ecl_number_compare(cl_object x, cl_object y)
y = cl_rational(y);
goto BEGIN;
default:
FEwrong_type_nth_arg(@'<', 2, y, @'real');
FEwrong_type_nth_arg(@[<], 2, y, @[real]);
}
#ifdef ECL_SHORT_FLOAT
case t_shortfloat:
@ -378,7 +378,7 @@ ecl_number_compare(cl_object x, cl_object y)
goto LONGFLOAT;
#endif
default:
FEwrong_type_nth_arg(@'<', 2, y, @'real');
FEwrong_type_nth_arg(@[<], 2, y, @[real]);
}
DOUBLEFLOAT:
if (dx == dy)
@ -412,7 +412,7 @@ ecl_number_compare(cl_object x, cl_object y)
ldy = ecl_long_float(y);
break;
default:
FEwrong_type_nth_arg(@'<', 2, y, @'real');
FEwrong_type_nth_arg(@[<], 2, y, @[real]);
}
LONGFLOAT:
if (ldx == ldy)
@ -424,7 +424,7 @@ ecl_number_compare(cl_object x, cl_object y)
break;
#endif
default:
FEwrong_type_nth_arg(@'<', 1, x, @'real');
FEwrong_type_nth_arg(@[<], 1, x, @[real]);
}
}

10
src/c/num_log.d
View file

@ -359,7 +359,7 @@ ecl_boole(int op, cl_object x, cl_object y)
return _ecl_big_register_normalize(x_copy);
}
default:
FEwrong_type_nth_arg(@'boole', 2, y, @'integer');
FEwrong_type_nth_arg(@[boole], 2, y, @[integer]);
}
break;
case t_bignum: {
@ -377,12 +377,12 @@ ecl_boole(int op, cl_object x, cl_object y)
bignum_operations[op](x_copy, y);
break;
default:
FEwrong_type_nth_arg(@'boole', 2, y, @'integer');
FEwrong_type_nth_arg(@[boole], 2, y, @[integer]);
}
return _ecl_big_register_normalize(x_copy);
}
default:
FEwrong_type_nth_arg(@'boole', 1, x, @'integer');
FEwrong_type_nth_arg(@[boole], 1, x, @[integer]);
}
return x;
}
@ -427,7 +427,7 @@ count_bits(cl_object x)
#endif /* WITH_GMP */
break;
default:
FEwrong_type_only_arg(@'logcount', x, @'integer');
FEwrong_type_only_arg(@[logcount], x, @[integer]);
}
return count;
}
@ -682,7 +682,7 @@ ecl_integer_length(cl_object x)
#endif /* WITH_GMP */
break;
default:
FEwrong_type_only_arg(@'integer-length', x, @'integer');
FEwrong_type_only_arg(@[integer-length], x, @[integer]);
}
return count;
}

10
src/c/num_pred.d
View file

@ -47,7 +47,7 @@ ecl_zerop(cl_object x)
ecl_zerop(x->complex.imag));
default:
FEwrong_type_only_arg(@'zerop', x, @'number');
FEwrong_type_only_arg(@[zerop], x, @[number]);
}
}
@ -79,7 +79,7 @@ ecl_plusp(cl_object x)
return ecl_long_float(x) > 0.0;
#endif
default:
FEwrong_type_only_arg(@'plusp', x, @'real');
FEwrong_type_only_arg(@[plusp], x, @[real]);
}
}
@ -113,7 +113,7 @@ ecl_minusp(cl_object x)
return ecl_long_float(x) < 0;
#endif
default:
FEwrong_type_only_arg(@'minusp', x, @'real');
FEwrong_type_only_arg(@[minusp], x, @[real]);
}
}
@ -124,7 +124,7 @@ ecl_oddp(cl_object x)
return fix(x) & 1;
if (type_of(x) == t_bignum)
return _ecl_big_odd_p(x);
FEwrong_type_only_arg(@'oddp', x, @'integer');
FEwrong_type_only_arg(@[oddp], x, @[integer]);
}
int
@ -134,7 +134,7 @@ ecl_evenp(cl_object x)
return ~fix(x) & 1;
if (type_of(x) == t_bignum)
return _ecl_big_even_p(x);
FEwrong_type_only_arg(@'evenp', x, @'integer');
FEwrong_type_only_arg(@[evenp], x, @[integer]);
}
cl_object

6
src/c/num_rand.d
View file

@ -207,7 +207,7 @@ rando(cl_object x, cl_object rs)
#endif
default: ERROR: {
const char *type = "(OR (INTEGER (0) *) (FLOAT (0) *))";
FEwrong_type_nth_arg(@'random',1,x, ecl_read_from_cstring(type));
FEwrong_type_nth_arg(@[random],1,x, ecl_read_from_cstring(type));
}
}
return z;
@ -224,8 +224,8 @@ ecl_make_random_state(cl_object rs)
rs = ecl_symbol_value(@'*random-state*');
}
if (ecl_unlikely(type_of(rs) != t_random)) {
FEwrong_type_only_arg(@'make-random-state', rs,
@'random-state');
FEwrong_type_only_arg(@[make-random-state], rs,
@[random-state]);
}
z->random.value = cl_copy_seq(rs->random.value);
}

24
src/c/num_sfun.d
View file

@ -146,7 +146,7 @@ cl_exp(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'exp', x, @'number');
FEwrong_type_only_arg(@[exp], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -159,11 +159,11 @@ cl_expt(cl_object x, cl_object y)
cl_object z;
ty = type_of(y);
if (ecl_unlikely(!ECL_NUMBER_TYPE_P(ty))) {
FEwrong_type_nth_arg(@'expt', 2, y, @'number');
FEwrong_type_nth_arg(@[expt], 2, y, @[number]);
}
tx = type_of(x);
if (ecl_unlikely(!ECL_NUMBER_TYPE_P(tx))) {
FEwrong_type_nth_arg(@'expt', 2, x, @'number');
FEwrong_type_nth_arg(@[expt], 2, x, @[number]);
}
if (ecl_zerop(y)) {
/* INV: The most specific numeric types come first. */
@ -312,7 +312,7 @@ ecl_log1(cl_object x)
output = ecl_log1_complex(x, MAKE_FIXNUM(0));
break;
default:
FEwrong_type_nth_arg(@'log', 1, x, @'number');
FEwrong_type_nth_arg(@[log], 1, x, @[number]);
}
ECL_MATHERR_TEST;
return output;
@ -382,7 +382,7 @@ ecl_log1p(cl_object x)
MAKE_FIXNUM(0));
break;
default:
FEwrong_type_only_arg(@'log', x, @'number');
FEwrong_type_only_arg(@[log], x, @[number]);
}
ECL_MATHERR_TEST;
return output;
@ -402,7 +402,7 @@ cl_sqrt(cl_object x)
ECL_MATHERR_CLEAR;
tx = type_of(x);
if (ecl_unlikely(!ECL_NUMBER_TYPE_P(tx))) {
FEwrong_type_only_arg(@'sqrt', x, @'number');
FEwrong_type_only_arg(@[sqrt], x, @[number]);
}
if (tx == t_complex) {
z = ecl_make_ratio(MAKE_FIXNUM(1), MAKE_FIXNUM(2));
@ -598,7 +598,7 @@ cl_sin(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'sin', x, @'number');
FEwrong_type_only_arg(@[sin], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -639,7 +639,7 @@ cl_cos(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'cos', x, @'number');
FEwrong_type_only_arg(@[cos], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -686,7 +686,7 @@ cl_tan(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'tan', x, @'number');
FEwrong_type_only_arg(@[tan], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -729,7 +729,7 @@ cl_sinh(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'sinh', x, @'number');
FEwrong_type_only_arg(@[sinh], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -772,7 +772,7 @@ cl_cosh(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'cosh', x, @'number');
FEwrong_type_only_arg(@[cosh], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)
@ -807,7 +807,7 @@ cl_tanh(cl_object x)
break;
}
default:
FEwrong_type_only_arg(@'tanh', x, @'number');
FEwrong_type_only_arg(@[tanh], x, @[number]);
}
ECL_MATHERR_TEST;
@(return output)

6
src/c/number.d
View file

@ -81,7 +81,7 @@ fixint(cl_object x)
return (cl_fixnum)x->big.big_num;
#endif /* WITH_GMP */
}
FEwrong_type_argument(@'fixnum', x);
FEwrong_type_argument(@[fixnum], x);
}
cl_index
@ -847,7 +847,7 @@ ecl_to_double(cl_object x)
return (double)ecl_long_float(x);
#endif
default:
FEwrong_type_nth_arg(@'coerce', 1, x, @'real');
FEwrong_type_nth_arg(@[coerce], 1, x, @[real]);
}
}
@ -881,7 +881,7 @@ ecl_to_long_double(cl_object x)
case t_longfloat:
return ecl_long_float(x);
default:
FEwrong_type_nth_arg(@'coerce', 1, x, @'real');
FEwrong_type_nth_arg(@[coerce], 1, x, @[real]);
}
}
#endif

38
src/c/package.d
View file

@ -75,7 +75,7 @@ member_string_eq(cl_object x, cl_object l)
loop_for_on_unsafe(l) {
if (ecl_string_eq(x, ECL_CONS_CAR(l)))
return TRUE;
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
return FALSE;
}
@ -177,12 +177,12 @@ ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
goto ERROR;
}
x->pack.nicknames = CONS(nick, x->pack.nicknames);
} end_loop_for_in;
} end_loop_for_in(nicknames);
loop_for_in(use_list) {
y = si_coerce_to_package(ECL_CONS_CAR(use_list));
x->pack.uses = CONS(y, x->pack.uses);
y->pack.usedby = CONS(x, y->pack.usedby);
} end_loop_for_in;
} end_loop_for_in(use_list);
/* 3) Finally, add it to the list of packages */
cl_core.packages = CONS(x, cl_core.packages);
@ -252,7 +252,7 @@ ecl_find_package_nolock(cl_object name)
return p;
if (member_string_eq(name, p->pack.nicknames))
return p;
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
#ifdef ECL_RELATIVE_PACKAGE_NAMES
/* Note that this function may actually be called _before_ symbols are set up
* and bound! */
@ -306,7 +306,7 @@ ecl_intern(cl_object name, cl_object p, int *intern_flag)
cl_object s, ul;
if (ecl_unlikely(!ECL_STRINGP(name)))
FEwrong_type_nth_arg(@'intern', 1, name, @'string');
FEwrong_type_nth_arg(@[intern], 1, name, @[string]);
p = si_coerce_to_package(p);
TRY_AGAIN_LABEL:
s = find_symbol_inner(name, p, intern_flag);
@ -365,7 +365,7 @@ find_symbol_inner(cl_object name, cl_object p, int *intern_flag)
*intern_flag = INHERITED;
goto OUTPUT;
}
} end_loop_for_on;
} end_loop_for_on_unsafe(ul);
NOTHING:
*intern_flag = 0;
s = Cnil;
@ -377,7 +377,7 @@ cl_object
ecl_find_symbol(cl_object n, cl_object p, int *intern_flag)
{
if (ecl_unlikely(!ECL_STRINGP(n)))
FEwrong_type_nth_arg(@'find-symbol', 1, n, @'string');
FEwrong_type_nth_arg(@[find-symbol], 1, n, @[string]);
p = si_coerce_to_package(p);
return find_symbol_inner(n, p, intern_flag);
}
@ -425,7 +425,7 @@ ecl_unintern(cl_object s, cl_object p)
"a name conflict.", p, 4, s, p, x, y);
}
}
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
p->pack.shadowings = ecl_remove_eq(s, p->pack.shadowings);
NOT_SHADOW:
ecl_remhash(name, hash);
@ -475,7 +475,7 @@ cl_export2(cl_object s, cl_object p)
"because it will cause a name conflict~%"
"in ~S.", p, 3, s, p, CAR(l));
}
} end_loop_for_on;
} end_loop_for_on_unsafe(l);
if (hash != OBJNULL)
ecl_remhash(name, hash);
p->pack.external = _ecl_sethash(name, p->pack.external, s);
@ -512,11 +512,11 @@ cl_delete_package(cl_object p)
list = p->pack.uses;
loop_for_on_unsafe(list) {
ecl_unuse_package(ECL_CONS_CAR(list), p);
} end_loop_for_on;
} end_loop_for_on_unsafe(list);
list = p->pack.usedby;
loop_for_on_unsafe(list) {
ecl_unuse_package(p, ECL_CONS_CAR(list));
} end_loop_for_on;
} end_loop_for_on_unsafe(list);
PACKAGE_OP_LOCK();
for (hash = p->pack.internal, i = 0; i < hash->hash.size; i++)
if (hash->hash.data[i].key != OBJNULL) {
@ -835,7 +835,7 @@ cl_list_all_packages()
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'export',1,symbols,
FEwrong_type_nth_arg(@[export],1,symbols,
cl_list(3,@'or',@'symbol',@'list'));
}
@(return Ct)
@ -854,7 +854,7 @@ cl_list_all_packages()
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'unexport',1,symbols,
FEwrong_type_nth_arg(@[unexport],1,symbols,
cl_list(3,@'or',@'symbol',@'list'));
}
@(return Ct)
@ -873,7 +873,7 @@ cl_list_all_packages()
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'import',1,symbols,
FEwrong_type_nth_arg(@[import],1,symbols,
cl_list(3,@'or',@'symbol',@'list'));
}
@(return Ct)
@ -892,7 +892,7 @@ cl_list_all_packages()
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'shadowing-import',1,symbols,
FEwrong_type_nth_arg(@[shadowing-import],1,symbols,
cl_list(3,@'or',@'symbol',@'list'));
}
@(return Ct)
@ -918,7 +918,7 @@ cl_list_all_packages()
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'shadow',1,symbols,
FEwrong_type_nth_arg(@[shadow],1,symbols,
cl_list(3,@'or',@'symbol',@'list'));
}
@(return Ct)
@ -941,7 +941,7 @@ BEGIN:
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'use-package', 1, pack,
FEwrong_type_nth_arg(@[use-package], 1, pack,
ecl_read_from_cstring("(OR SYMBOL CHARACTER STRING LIST PACKAGE)"));
}
@(return Ct)
@ -964,7 +964,7 @@ BEGIN:
} end_loop_for_in;
break;
default:
FEwrong_type_nth_arg(@'unuse-package', 1, pack,
FEwrong_type_nth_arg(@[unuse-package], 1, pack,
ecl_read_from_cstring("(OR SYMBOL CHARACTER STRING LIST PACKAGE)"));
}
@(return Ct)
@ -976,7 +976,7 @@ si_package_hash_tables(cl_object p)
const cl_env_ptr the_env = ecl_process_env();
cl_object he, hi, u;
if (ecl_unlikely(type_of(p) != t_package))
FEwrong_type_only_arg(@'si::package-hash-tables', p, @'package');
FEwrong_type_only_arg(@[si::package-hash-tables], p, @[package]);
PACKAGE_OP_LOCK();
he = si_copy_hash_table(p->pack.external);
hi = si_copy_hash_table(p->pack.internal);

8
src/c/pathname.d
View file

@ -678,7 +678,7 @@ L:
}
default: {
const char *type = "(OR FILE-STREAM STRING PATHNAME)";
FEwrong_type_only_arg(@'pathname', x, ecl_read_from_cstring(type));
FEwrong_type_only_arg(@[pathname], x, ecl_read_from_cstring(type));
}
}
@(return x)
@ -743,7 +743,7 @@ cl_logical_pathname(cl_object x)
{
@(return Ct)
}
} end_loop_for_on;
} end_loop_for_on_unsafe(list);
}
if (checked == 0) {
FEerror("~A is not a valid pathname component", 1, component);
@ -1388,7 +1388,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
@
/* Check that host is a valid host name */
if (ecl_unlikely(!ECL_STRINGP(host)))
FEwrong_type_nth_arg(@'si::pathname-translations', 1, host, @'string');
FEwrong_type_nth_arg(@[si::pathname-translations], 1, host, @[string]);
len = ecl_length(host);
parse_word(host, is_null, WORD_LOGICAL, 0, len, &parsed_len);
if (parsed_len < len) {
@ -1401,7 +1401,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
}
/* Set the new translation list */
if (ecl_unlikely(!LISTP(set))) {
FEwrong_type_nth_arg(@'si::pathname-translations', 2, set, @'list');
FEwrong_type_nth_arg(@[si::pathname-translations], 2, set, @[list]);
}
if (pair == Cnil) {
pair = CONS(host, CONS(Cnil, Cnil));

6
src/c/print.d
View file

@ -1905,7 +1905,7 @@ potential_number_p(cl_object strng, int base)
@(defun write-string (strng &o strm &k (start MAKE_FIXNUM(0)) end)
@
if (ecl_unlikely(!ECL_STRINGP(strng)))
FEwrong_type_nth_arg(@'write-string', 1, strng, @'string');
FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
strm = stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (type_of(strm) != t_stream)
@ -1919,7 +1919,7 @@ potential_number_p(cl_object strng, int base)
@(defun write-line (strng &o strm &k (start MAKE_FIXNUM(0)) end)
@
if (ecl_unlikely(!ECL_STRINGP(strng)))
FEwrong_type_nth_arg(@'write-line', 1, strng, @'string');
FEwrong_type_nth_arg(@[write-line], 1, strng, @[string]);
strm = stream_or_default_output(strm);
#ifdef ECL_CLOS_STREAMS
if (type_of(strm) != t_stream)
@ -2062,7 +2062,7 @@ ecl_write_string(cl_object strng, cl_object strm)
ecl_write_char(strng->base_string.self[i], strm);
break;
default:
FEwrong_type_nth_arg(@'write-string', 1, strng, @'string');
FEwrong_type_nth_arg(@[write-string], 1, strng, @[string]);
}
ecl_force_output(strm);

28
src/c/read.d
View file

@ -1428,7 +1428,7 @@ static void
assert_type_readtable(cl_object function, cl_narg narg, cl_object p)
{
if (ecl_unlikely(type_of(p) != t_readtable))
FEwrong_type_nth_arg(function, narg, p, @'readtable');
FEwrong_type_nth_arg(function, narg, p, @[readtable]);
}
@ -1441,7 +1441,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
size_t total_bytes = entry_bytes * RTABSIZE;
cl_object output;
assert_type_readtable(@'copy-readtable', 1, from);
assert_type_readtable(@[copy-readtable], 1, from);
/* For the sake of garbage collector and thread safety we
* create an incomplete object and only copy to the destination
* at the end in a more or less "atomic" (meaning "fast") way.
@ -1468,7 +1468,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
}
#endif
if (!Null(to)) {
assert_type_readtable(@'copy-readtable', 2, to);
assert_type_readtable(@[copy-readtable], 2, to);
to->readtable = output->readtable;
output = to;
}
@ -1806,7 +1806,7 @@ EOFCHK: if (c == EOF && TOKEN_STRING_FILLP(token) == 0) {
cl_object rtbl = ecl_current_readtable();
@ {
if (ecl_unlikely(!ECL_STRINGP(strng)))
FEwrong_type_nth_arg(@'parse-integer', 1, strng, @'string');
FEwrong_type_nth_arg(@[parse-integer], 1, strng, @[string]);
get_string_start_end(strng, start, end, &s, &e);
if (ecl_unlikely(!FIXNUMP(radix) ||
fix(radix) < 2 || fix(radix) > 36))
@ -1878,7 +1878,7 @@ CANNOT_PARSE: FEparse_error("Cannot parse an integer in the string ~S.",
cl_object
cl_readtable_case(cl_object r)
{
assert_type_readtable(@'readtable-case', 1, r);
assert_type_readtable(@[readtable-case], 1, r);
switch (r->readtable.read_case) {
case ecl_case_upcase: r = @':upcase'; break;
case ecl_case_downcase: r = @':downcase'; break;
@ -1900,7 +1900,7 @@ error_locked_readtable(cl_object r)
cl_object
si_readtable_case_set(cl_object r, cl_object mode)
{
assert_type_readtable(@'readtable-case', 1, r);
assert_type_readtable(@[readtable-case], 1, r);
if (r->readtable.locked) {
error_locked_readtable(r);
}
@ -1914,7 +1914,7 @@ si_readtable_case_set(cl_object r, cl_object mode)
r->readtable.read_case = ecl_case_invert;
} else {
const char *type = "(member :upcase :downcase :preserve :invert)";
FEwrong_type_nth_arg(@'si::readtable-case-set', 2,
FEwrong_type_nth_arg(@[si::readtable-case-set], 2,
mode, ecl_read_from_cstring(type));
}
@(return mode)
@ -2002,8 +2002,8 @@ ecl_invalid_character_p(int c)
}
if (Null(fromrdtbl))
fromrdtbl = cl_core.standard_readtable;
assert_type_readtable(@'readtable-case', 1, tordtbl);
assert_type_readtable(@'readtable-case', 2, fromrdtbl);
assert_type_readtable(@[readtable-case], 1, tordtbl);
assert_type_readtable(@[readtable-case], 2, fromrdtbl);
fc = ecl_char_code(fromchr);
tc = ecl_char_code(tochr);
@ -2044,7 +2044,7 @@ ecl_invalid_character_p(int c)
cl_object table;
int c;
@
assert_type_readtable(@'make-dispatch-macro-character', 3, readtable);
assert_type_readtable(@[make-dispatch-macro-character], 3, readtable);
c = ecl_char_code(chr);
cat = Null(non_terminating_p)? cat_terminating : cat_non_terminating;
table = cl__make_hash_table(@'eql', MAKE_FIXNUM(128),
@ -2060,7 +2060,7 @@ ecl_invalid_character_p(int c)
cl_object table;
cl_fixnum subcode;
@
assert_type_readtable(@'set-dispatch-macro-character', 4, readtable);
assert_type_readtable(@[set-dispatch-macro-character], 4, readtable);
ecl_readtable_get(readtable, ecl_char_code(dspchr), &table);
if (readtable->readtable.locked) {
error_locked_readtable(readtable);
@ -2095,7 +2095,7 @@ ecl_invalid_character_p(int c)
if (Null(readtable)) {
readtable = cl_core.standard_readtable;
}
assert_type_readtable(@'get-dispatch-macro-character', 3, readtable);
assert_type_readtable(@[get-dispatch-macro-character], 3, readtable);
c = ecl_char_code(dspchr);
ecl_readtable_get(readtable, c, &table);
if (type_of(table) != t_hashtable) {
@ -2119,7 +2119,7 @@ si_standard_readtable()
@(defun ext::readtable-lock (r &optional yesno)
cl_object output;
@
assert_type_readtable(@'ext::readtable-lock', 1, r);
assert_type_readtable(@[ext::readtable-lock], 1, r);
output = (r->readtable.locked)? Ct : Cnil;
if (narg > 1) {
r->readtable.locked = !Null(yesno);
@ -2490,7 +2490,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object))
"compiled file~& ~A~&but has not been created",
2, CAR(x), block->cblock.name);
}
} end_loop_for_on;
} end_loop_for_on(x);
old_eptbc = cl_core.packages_to_be_created;
if (VVtemp) {
block->cblock.temp_data = NULL;

4
src/c/reference.d
View file

@ -132,7 +132,7 @@ cl_symbol_value(cl_object sym)
value = sym;
} else {
if (ecl_unlikely(!SYMBOLP(sym))) {
FEwrong_type_only_arg(@'symbol-value', sym, @'symbol');
FEwrong_type_only_arg(@[symbol-value], sym, @[symbol]);
}
value = ECL_SYM_VAL(the_env, sym);
if (ecl_unlikely(value == OBJNULL)) {
@ -149,7 +149,7 @@ ecl_boundp(cl_env_ptr env, cl_object sym)
return 1;
} else {
if (ecl_unlikely(!SYMBOLP(sym)))
FEwrong_type_only_arg(@'boundp', sym, @'symbol');
FEwrong_type_only_arg(@[boundp], sym, @[symbol]);
return ECL_SYM_VAL(env, sym) != OBJNULL;
}
}

24
src/c/string.d
View file

@ -163,7 +163,7 @@ ecl_fits_in_base_string(cl_object s)
case t_base_string:
return 1;
default:
FEwrong_type_nth_arg(@'si::copy-to-simple-base-string',1,s,@'string');
FEwrong_type_nth_arg(@[si::copy-to-simple-base-string],1,s,@[string]);
}
}
@ -204,7 +204,7 @@ si_copy_to_simple_base_string(cl_object x)
goto AGAIN;
}
default:
FEwrong_type_nth_arg(@'si::copy-to-simple-base-string',1,x,@'string');
FEwrong_type_nth_arg(@[si::copy-to-simple-base-string],1,x,@[string]);
}
@(return y)
}
@ -247,7 +247,7 @@ cl_string(cl_object x)
break;
}
default:
FEwrong_type_nth_arg(@'string',1,x,@'string');
FEwrong_type_nth_arg(@[string],1,x,@[string]);
}
@(return x)
}
@ -292,7 +292,7 @@ si_coerce_to_extended_string(cl_object x)
goto AGAIN;
}
default:
FEwrong_type_nth_arg(@'si::coerce-to-extended-string',1,x,@'string');
FEwrong_type_nth_arg(@[si::coerce-to-extended-string],1,x,@[string]);
}
@(return y)
}
@ -321,7 +321,7 @@ ecl_char(cl_object object, cl_index index)
FEillegal_index(object, MAKE_FIXNUM(index));
return object->base_string.self[index];
default:
FEwrong_type_nth_arg(@'char',1,object,@'string');
FEwrong_type_nth_arg(@[char],1,object,@[string]);
}
}
@ -350,7 +350,7 @@ ecl_char_set(cl_object object, cl_index index, ecl_character value)
FEillegal_index(object, MAKE_FIXNUM(index));
return object->base_string.self[index] = value;
default:
FEwrong_type_nth_arg(@'si::char-set',1,object,@'string');
FEwrong_type_nth_arg(@[si::char-set],1,object,@[string]);
}
}
@ -523,7 +523,7 @@ ecl_string_eq(cl_object x, cl_object y)
return 1;
}
default:
FEwrong_type_nth_arg(@'string=',2,y,@'string');
FEwrong_type_nth_arg(@[string=],2,y,@[string]);
}
break;
case t_base_string:
@ -533,11 +533,11 @@ ecl_string_eq(cl_object x, cl_object y)
case t_base_string:
return memcmp(x->base_string.self, y->base_string.self, i) == 0;
default:
FEwrong_type_nth_arg(@'string=',2,y,@'string');
FEwrong_type_nth_arg(@[string=],2,y,@[string]);
}
break;
default:
FEwrong_type_nth_arg(@'string=',2,x,@'string');
FEwrong_type_nth_arg(@[string=],2,x,@[string]);
}
#else
return memcmp(x->base_string.self, y->base_string.self, i) == 0;
@ -710,7 +710,7 @@ ecl_member_char(ecl_character c, cl_object char_bag)
case t_bitvector:
return(FALSE);
default:
FEwrong_type_nth_arg(@'member',2,char_bag,@'sequence');
FEwrong_type_nth_arg(@[member],2,char_bag,@[sequence]);
}
}
@ -866,7 +866,7 @@ nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, cl_va_list ARGS)
cl_parse_key(ARGS, 2, KEYS, KEY_VARS, NULL, FALSE);
if (ecl_unlikely(!ECL_STRINGP(strng)))
FEwrong_type_nth_arg(fun, 1, strng, @'string');
FEwrong_type_nth_arg(fun, 1, strng, @[string]);
if (startp == Cnil) start = MAKE_FIXNUM(0);
get_string_start_end(strng, start, end, &s, &e);
b = TRUE;
@ -958,6 +958,6 @@ ecl_string_push_extend(cl_object s, ecl_character c)
ecl_char_set(s, s->base_string.fillp++, c);
return c;
default:
FEwrong_type_nth_arg(@'vector-push-extend',1,s,@'string');
FEwrong_type_nth_arg(@[vector-push-extend],1,s,@[string]);
}
}

16
src/c/structure.d
View file

@ -36,7 +36,7 @@ structure_subtypep(cl_object x, cl_object y)
loop_for_on_unsafe(superiors) {
if (structure_subtypep(ECL_CONS_CAR(superiors), y))
return TRUE;
} end_loop_for_on;
} end_loop_for_on_unsafe(superiors);
return FALSE;
}
}
@ -92,7 +92,7 @@ ecl_copy_structure(cl_object x)
cl_object y;
if (ecl_unlikely(Null(si_structurep(x))))
FEwrong_type_only_arg(@'copy-structure', x, @'structure');
FEwrong_type_only_arg(@[copy-structure], x, @[structure]);
y = ecl_alloc_object(T_STRUCTURE);
STYPE(y) = STYPE(x);
SLENGTH(y) = j = SLENGTH(x);
@ -124,7 +124,7 @@ cl_copy_structure(cl_object s)
s = cl_copy_seq(s);
break;
default:
FEwrong_type_only_arg(@'copy-structure', s, @'structure');
FEwrong_type_only_arg(@[copy-structure], s, @[structure]);
}
@(return s)
}
@ -135,7 +135,7 @@ cl_object
si_structure_name(cl_object s)
{
if (ecl_unlikely(Null(si_structurep(s))))
FEwrong_type_only_arg(@'si::structure-name', s, @'structure');
FEwrong_type_only_arg(@[si::structure-name], s, @[structure]);
@(return SNAME(s))
}
@ -144,7 +144,7 @@ si_structure_ref(cl_object x, cl_object type, cl_object index)
{
if (ecl_unlikely(type_of(x) != T_STRUCTURE ||
!structure_subtypep(STYPE(x), type)))
FEwrong_type_nth_arg(@'si::structure-ref', 1, x, type);
FEwrong_type_nth_arg(@[si::structure-ref], 1, x, type);
@(return SLOT(x, fix(index)))
}
@ -154,7 +154,7 @@ ecl_structure_ref(cl_object x, cl_object type, int n)
if (ecl_unlikely(type_of(x) != T_STRUCTURE ||
!structure_subtypep(STYPE(x), type)))
FEwrong_type_nth_arg(@'si::structure-ref', 1, x, type);
FEwrong_type_nth_arg(@[si::structure-ref], 1, x, type);
return(SLOT(x, n));
}
@ -163,7 +163,7 @@ si_structure_set(cl_object x, cl_object type, cl_object index, cl_object val)
{
if (ecl_unlikely(type_of(x) != T_STRUCTURE ||
!structure_subtypep(STYPE(x), type)))
FEwrong_type_nth_arg(@'si::structure-set', 1, x, type);
FEwrong_type_nth_arg(@[si::structure-set], 1, x, type);
SLOT(x, fix(index)) = val;
@(return val)
}
@ -174,7 +174,7 @@ ecl_structure_set(cl_object x, cl_object type, int n, cl_object v)
if (ecl_unlikely(type_of(x) != T_STRUCTURE ||
!structure_subtypep(STYPE(x), type)))
FEwrong_type_nth_arg(@'si::structure-set', 1, x, type);
FEwrong_type_nth_arg(@[si::structure-set], 1, x, type);
SLOT(x, n) = v;
return(v);
}

16
src/c/symbol.d
View file

@ -28,7 +28,7 @@ ecl_symbol_package(cl_object s)
return Cnil_symbol->symbol.hpack;
if (type_of(s) == t_symbol)
return s->symbol.hpack;
FEwrong_type_nth_arg(@'symbol-package', 1, s, @'symbol');
FEwrong_type_nth_arg(@[symbol-package], 1, s, @[symbol]);
}
int
@ -38,7 +38,7 @@ ecl_symbol_type(cl_object s)
return Cnil_symbol->symbol.stype;
if (type_of(s) == t_symbol)
return s->symbol.stype;
FEwrong_type_nth_arg(@'symbol-name', 1, s, @'symbol');
FEwrong_type_nth_arg(@[symbol-name], 1, s, @[symbol]);
}
void
@ -52,7 +52,7 @@ ecl_symbol_type_set(cl_object s, int type)
s->symbol.stype = type;
return;
}
FEwrong_type_nth_arg(@'symbol-name', 1, s, @'symbol');
FEwrong_type_nth_arg(@[symbol-name], 1, s, @[symbol]);
}
cl_object
@ -64,7 +64,7 @@ ecl_symbol_name(cl_object s)
if (type_of(s) == t_symbol) {
return s->symbol.name;
}
FEwrong_type_nth_arg(@'symbol-name', 1, s, @'symbol');
FEwrong_type_nth_arg(@[symbol-name], 1, s, @[symbol]);
}
static cl_object *
@ -76,7 +76,7 @@ ecl_symbol_plist(cl_object s)
if (type_of(s) == t_symbol) {
return &s->symbol.plist;
}
FEwrong_type_nth_arg(@'symbol-plist', 1, s, @'symbol');
FEwrong_type_nth_arg(@[symbol-plist], 1, s, @[symbol]);
}
/**********************************************************************/
@ -102,7 +102,7 @@ cl_make_symbol(cl_object str)
str = si_copy_to_simple_base_string(str);
break;
default:
FEwrong_type_nth_arg(@'make-symbol',1,str,@'string');
FEwrong_type_nth_arg(@[make-symbol],1,str,@[string]);
}
x = ecl_alloc_object(t_symbol);
x->symbol.name = str;
@ -337,7 +337,7 @@ cl_symbol_name(cl_object x)
prefix = cl_core.gensym_prefix;
increment = 0;
} else {
FEwrong_type_nth_arg(@'gensym',2,prefix,
FEwrong_type_nth_arg(@[gensym],2,prefix,
cl_list(3, @'or', @'string', @'integer'));
}
output = ecl_make_string_output_stream(64, 1);
@ -359,7 +359,7 @@ cl_symbol_name(cl_object x)
int intern_flag;
@
if (ecl_unlikely(!ECL_STRINGP(prefix)))
FEwrong_type_nth_arg(@'gentemp', 1, prefix, @'string');
FEwrong_type_nth_arg(@[gentemp], 1, prefix, @[string]);
pack = si_coerce_to_package(pack);
ONCE_MORE:
output = ecl_make_string_output_stream(64, 1);

4
src/c/tcp.d
View file

@ -324,8 +324,8 @@ si_open_unix_socket_stream(cl_object path)
struct sockaddr_un addr;
if (ecl_unlikely(type_of(path) != t_base_string))
FEwrong_type_nth_arg(@'si::open-unix-socket-stream', 1, path,
@'string');
FEwrong_type_nth_arg(@[si::open-unix-socket-stream], 1, path,
@[string]);
if (path->base_string.fillp > UNIX_MAX_PATH-1)
FEerror("~S is a too long file name.", 1, path);

38
src/c/threads.d
View file

@ -104,7 +104,7 @@ static void
assert_type_process(cl_object o)
{
if (type_of(o) != t_process)
FEwrong_type_argument(@'mp::process', o);
FEwrong_type_argument(@[mp::process], o);
}
static void
@ -294,7 +294,7 @@ mp_process_preset(cl_narg narg, cl_object process, cl_object function, ...)
cl_va_list args;
cl_va_start(args, function, narg, 2);
if (narg < 2)
FEwrong_num_arguments(@'mp::process-preset');
FEwrong_num_arguments(@[mp::process-preset]);
assert_type_process(process);
process->process.function = function;
process->process.args = cl_grab_rest_args(args);
@ -513,7 +513,7 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...)
cl_va_list args;
cl_va_start(args, function, narg, 2);
if (narg < 2)
FEwrong_num_arguments(@'mp::process-run-function');
FEwrong_num_arguments(@[mp::process-run-function]);
if (CONSP(name)) {
process = cl_apply(2, @'mp::make-process', name);
} else {
@ -611,11 +611,11 @@ mp_condition_variable_wait(cl_object cv, cl_object lock)
int count, rc;
cl_object own_process = mp_current_process();
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@'mp::condition-variable-wait', 1, cv,
@'mp::condition-variable');
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 1, cv,
@[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@'mp::condition-variable-wait', 2, lock,
@'mp::lock');
FEwrong_type_nth_arg(@[mp::condition-variable-wait], 2, lock,
@[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
@ -654,11 +654,11 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds)
struct timeval tp;
if (ecl_unlikely(type_of(cv) != t_condition_variable))
FEwrong_type_nth_arg(@'mp::condition-variable-timedwait',
1, cv, @'mp::condition-variable');
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
1, cv, @[mp::condition-variable]);
if (ecl_unlikely(type_of(lock) != t_lock))
FEwrong_type_nth_arg(@'mp::condition-variable-timedwait',
2, lock, @'mp::lock');
FEwrong_type_nth_arg(@[mp::condition-variable-timedwait],
2, lock, @[mp::lock]);
if (ecl_unlikely(lock->lock.holder != own_process)) {
FEerror("Attempt to wait on a condition variable using lock~%~S"
"~%which is not owned by process~%~S", 2, lock, own_process);
@ -711,8 +711,8 @@ mp_condition_variable_signal(cl_object cv)
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@'mp::condition-variable-signal',
cv, @'mp::condition-variable');
FEwrong_type_only_arg(@[mp::condition-variable-signal],
cv, @[mp::condition-variable]);
}
pthread_cond_signal(&cv->condition_variable.cv);
#endif
@ -726,8 +726,8 @@ mp_condition_variable_broadcast(cl_object cv)
FEerror("Condition variables are not supported under Windows.", 0);
#else
if (ecl_unlikely(type_of(cv) != t_condition_variable)) {
FEwrong_type_only_arg(@'mp::condition-variable-broadcast',
cv, @'mp::condition-variable');
FEwrong_type_only_arg(@[mp::condition-variable-broadcast],
cv, @[mp::condition-variable]);
}
pthread_cond_broadcast(&cv->condition_variable.cv);
#endif
@ -794,7 +794,7 @@ mp_semaphore_trywait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@'mp::semaphore-trywait', sem, @'mp::semaphore');
FEwrong_type_only_arg(@[mp::semaphore-trywait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
@ -837,7 +837,7 @@ mp_semaphore_wait(cl_object sem)
{
cl_object output;
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@'mp::semaphore-wait', sem, @'mp::semaphore');
FEwrong_type_only_arg(@[mp::semaphore-wait], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
@ -869,7 +869,7 @@ cl_object
mp_semaphore_signal(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@'mp::semaphore-signal', sem, @'mp::semaphore');
FEwrong_type_only_arg(@[mp::semaphore-signal], sem, @[mp::semaphore]);
}
AGAIN:
#ifdef ECL_WINDOWS_THREADS
@ -901,7 +901,7 @@ cl_object
mp_semaphore_close(cl_object sem)
{
if (ecl_unlikely(typeof(sem) != t_semaphore)) {
FEwrong_type_only_arg(@'mp::semaphore-close', sem, @'mp::semaphore');
FEwrong_type_only_arg(@[mp::semaphore-close], sem, @[mp::semaphore]);
}
#ifdef ECL_WINDOWS_THREADS
{

12
src/c/typespec.d
View file

@ -19,12 +19,12 @@
void
FEtype_error_cons(cl_object x) {
FEwrong_type_argument(@'cons', x);
FEwrong_type_argument(@[cons], x);
}
void
FEtype_error_list(cl_object x) {
FEwrong_type_argument(@'list', x);
FEwrong_type_argument(@[list], x);
}
void
@ -61,18 +61,18 @@ FEtype_error_index(cl_object seq, cl_object ndx)
void
FEtype_error_array(cl_object v)
{
FEwrong_type_argument(@'array', v);
FEwrong_type_argument(@[array], v);
}
void
FEtype_error_stream(cl_object strm)
{
FEwrong_type_argument(@'stream', strm);
FEwrong_type_argument(@[stream], strm);
}
void
FEtype_error_sequence(cl_object x) {
FEwrong_type_argument(@'sequence', x);
FEwrong_type_argument(@[sequence], x);
}
cl_object
@ -185,7 +185,7 @@ assert_type_integer(cl_object p)
{
cl_type t = type_of(p);
if (t != t_fixnum && t != t_bignum)
FEwrong_type_nth_arg(@'coerce', 1, p, @'integer');
FEwrong_type_nth_arg(@[coerce], 1, p, @[integer]);
}
void

112
src/h/ecl-inl.h
View file

@ -15,9 +15,9 @@
* Loops over a proper list
*/
#define loop_for_in(list) { \
const cl_object l0 = list; \
const cl_object __ecl_l0 = list; \
for (; list != Cnil; list = ECL_CONS_CDR(list)) { \
if (!CONSP(list)) FEtype_error_proper_list(l0);
if (ecl_unlikely(!ECL_LISTP(list))) FEtype_error_proper_list(__ecl_l0);
#define end_loop_for_in }}
@ -39,18 +39,20 @@
/*
* Loops over a list. Ignores errors.
*/
#define loop_for_on_unsafe(list) { \
for (; CONSP(list); list = ECL_CONS_CDR(list)) {
#define loop_for_on_unsafe(list) \
for (; ECL_CONSP(list); list = ECL_CONS_CDR(list)) {
#define end_loop_for_on_unsafe(list) }
/*
* Loops over a dotted list
*/
#define loop_for_on(list) \
if (!CONSP(list)) { \
if (list != Cnil) FEtype_error_list(list); \
} else { \
for (; CONSP(list); list = ECL_CONS_CDR(list)) {
#define end_loop_for_on }}
if (Null(list)) { \
(void)0; \
} else if (ecl_unlikely(!ECL_LISTP(list))) { \
FEtype_error_list(list); \
} else do {
#define end_loop_for_on(list) } while (list = ECL_CONS_CDR(list), ECL_CONSP(list))
#define ecl_def_ct_base_string(name,chars,len,static,const) \
static const struct ecl_base_string name ## data = { \
@ -77,95 +79,3 @@
Cnil, (cl_index)(len), (cl_index)(len), \
(ecl_base_char*)(raw), 0 }; \
static const cl_object name = (cl_object)(& name ## data)
/* The following is unused */
#if 0 && defined(GBC_BOEHM) && defined(__GNUC__)
#define alloc_object fast_alloc_object
#define make_cons fast_make_cons
extern void *GC_malloc(size_t);
extern void *GC_malloc_atomic(size_t);
static inline cl_object
fast_alloc_object(enum type t)
{
cl_object x;
switch (t) {
case t_cons:
x = GC_malloc(sizeof(struct cons)); break;
case t_fixnum:
return MAKE_FIXNUM(0);
case t_character:
return code_char(' ');
case t_bignum:
x = GC_malloc(sizeof(struct bignum)); break;
case t_ratio:
x = GC_malloc(sizeof(struct ratio)); break;
case t_singlefloat:
/* struct ecl_singlefloat? */
x = GC_malloc_atomic(sizeof(struct singlefloat_struct)); break;
case t_doublefloat:
/* struct ecl_doublefloat? */
x = GC_malloc_atomic(sizeof(struct doublefloat_struct)); break;
case t_complex:
x = GC_malloc(sizeof(struct complex)); break;
case t_symbol:
x = GC_malloc(sizeof(struct symbol)); break;
case t_package:
x = GC_malloc(sizeof(struct package)); break;
case t_hashtable:
x = GC_malloc(sizeof(struct hashtable)); break;
case t_array:
x = GC_malloc(sizeof(struct array)); break;
case t_vector:
x = GC_malloc(sizeof(struct vector)); break;
case t_base_string:
x = GC_malloc(sizeof(struct base_string)); break;
case t_bitvector:
x = GC_malloc(sizeof(struct bitvector)); break;
case t_stream:
x = GC_malloc(sizeof(struct stream)); break;
case t_random:
x = GC_malloc_atomic(sizeof(struct random)); break;
case t_readtable:
x = GC_malloc(sizeof(struct readtable)); break;
case t_pathname:
x = GC_malloc(sizeof(struct pathname)); break;
case t_cfun:
x = GC_malloc(sizeof(struct cfun)); break;
case t_cclosure:
x = GC_malloc(sizeof(struct cclosure)); break;
#ifdef CLOS
case t_instance:
x = GC_malloc(sizeof(struct instance)); break;
case t_gfun:
x = GC_malloc(sizeof(struct gfun)); break;
#else
case t_structure:
x = GC_malloc(sizeof(struct structure)); break;
#endif
#ifdef THREADS
case t_cont:
x = GC_malloc(sizeof(struct cont)); break;
case t_thread:
x = GC_malloc(sizeof(struct thread)); break;
#endif
default:
error("allocation botch!");
}
x->c.t = t;
return x;
}
static inline
cl_object fast_make_cons(cl_object a, cl_object b)
{
cl_object x = GC_malloc(sizeof(struct cons));
x->c.t = t_cons;
x->c.c_car = a;
x->c.c_cdr = b;
return x;
}
#endif

10
src/h/object.h
View file

@ -302,6 +302,11 @@ struct ecl_package {
*/
#ifdef ECL_SMALL_CONS
#define ECL_LISTP(x) (IMMEDIATE(x) == t_list)
#define ECL_CONSP(x) (LISTP(x) && !Null(x))
#define ECL_ATOM(x) (Null(x) || !LISTP(x))
#define ECL_SYMBOLP(x) (Null(x) || ((IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol)))
#define LISTP(x) (IMMEDIATE(x) == t_list)
#define CONSP(x) (LISTP(x) && !Null(x))
#define ATOM(x) (Null(x) || !LISTP(x))
@ -319,6 +324,11 @@ struct ecl_cons {
cl_object cdr; /* cdr */
};
#else
#define ECL_LISTP(x) (IMMEDIATE(x)? Null(x) : ((x)->d.t == t_list))
#define ECL_CONSP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_list))
#define ECL_ATOM(x) (IMMEDIATE(x) || ((x)->d.t != t_list))
#define ECL_SYMBOLP(x) (Null(x) || ((IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol)))
#define LISTP(x) (IMMEDIATE(x)? Null(x) : ((x)->d.t == t_list))
#define CONSP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_list))
#define ATOM(x) (IMMEDIATE(x) || ((x)->d.t != t_list))