diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index d12565158..8b4cc0071 100755 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -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)); } diff --git a/src/c/array.d b/src/c/array.d index e1a4a9936..169eba546 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -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, diff --git a/src/c/character.d b/src/c/character.d index 4508bbbdc..616c5f772 100644 --- a/src/c/character.d +++ b/src/c/character.d @@ -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) } @) diff --git a/src/c/cmpaux.d b/src/c/cmpaux.d index c98b49a2f..c4164bcc4 100644 --- a/src/c/cmpaux.d +++ b/src/c/cmpaux.d @@ -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]); } } diff --git a/src/c/dpp.c b/src/c/dpp.c index 9c9a08aac..17f838f6e 100755 --- a/src/c/dpp.c +++ b/src/c/dpp.c @@ -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; diff --git a/src/c/error.d b/src/c/error.d index 5046de4d4..e2e16c7b4 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -26,6 +26,14 @@ #endif #include +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); } diff --git a/src/c/ffi.d b/src/c/ffi.d index 9983ae64d..ba6d3d42c 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -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) diff --git a/src/c/file.d b/src/c/file.d index e7d7fb4e6..edb5299d7 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -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; diff --git a/src/c/gfun.d b/src/c/gfun.d index 07ba63aa8..f223c34ea 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -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(); } diff --git a/src/c/hash.d b/src/c/hash.d index 5aaa4d7ff..6e0f75460 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -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) diff --git a/src/c/instance.d b/src/c/instance.d index 895246e27..a035ec619 100644 --- a/src/c/instance.d +++ b/src/c/instance.d @@ -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, diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 02246daec..4009c8f2e 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -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; diff --git a/src/c/list.d b/src/c/list.d index 464f989f6..a1beba18d 100644 --- a/src/c/list.d +++ b/src/c/list.d @@ -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; } diff --git a/src/c/mapfun.d b/src/c/mapfun.d index c464a71f9..87cfa5fa4 100644 --- a/src/c/mapfun.d +++ b/src/c/mapfun.d @@ -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); diff --git a/src/c/num_arith.d b/src/c/num_arith.d index 44cd92331..9713dfc1f 100644 --- a/src/c/num_arith.d +++ b/src/c/num_arith.d @@ -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]); } } diff --git a/src/c/num_co.d b/src/c/num_co.d index 33fcd5c8d..3260fe0b4 100644 --- a/src/c/num_co.d +++ b/src/c/num_co.d @@ -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) } diff --git a/src/c/num_comp.d b/src/c/num_comp.d index 7c6632ce3..93704e6bf 100644 --- a/src/c/num_comp.d +++ b/src/c/num_comp.d @@ -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]); } } diff --git a/src/c/num_log.d b/src/c/num_log.d index 962b02d48..39e03ab75 100644 --- a/src/c/num_log.d +++ b/src/c/num_log.d @@ -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; } diff --git a/src/c/num_pred.d b/src/c/num_pred.d index d79247b56..9a72b08cf 100644 --- a/src/c/num_pred.d +++ b/src/c/num_pred.d @@ -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 diff --git a/src/c/num_rand.d b/src/c/num_rand.d index ae2fbc6c5..d79513a01 100644 --- a/src/c/num_rand.d +++ b/src/c/num_rand.d @@ -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); } diff --git a/src/c/num_sfun.d b/src/c/num_sfun.d index 8349aa22e..1932cfdda 100644 --- a/src/c/num_sfun.d +++ b/src/c/num_sfun.d @@ -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) diff --git a/src/c/number.d b/src/c/number.d index 52719cb34..9b170fe89 100644 --- a/src/c/number.d +++ b/src/c/number.d @@ -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 diff --git a/src/c/package.d b/src/c/package.d index d1b954811..95df41582 100644 --- a/src/c/package.d +++ b/src/c/package.d @@ -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); diff --git a/src/c/pathname.d b/src/c/pathname.d index 725729945..1db7b07cf 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -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)); diff --git a/src/c/print.d b/src/c/print.d index df76d9351..2c5b18706 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -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); diff --git a/src/c/read.d b/src/c/read.d index 05388b96e..acead87e2 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -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; diff --git a/src/c/reference.d b/src/c/reference.d index 9e9f354f1..843b8a910 100644 --- a/src/c/reference.d +++ b/src/c/reference.d @@ -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; } } diff --git a/src/c/string.d b/src/c/string.d index 5eb2e9e87..9ab4b5856 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -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]); } } diff --git a/src/c/structure.d b/src/c/structure.d index d482031a1..53001f76d 100644 --- a/src/c/structure.d +++ b/src/c/structure.d @@ -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); } diff --git a/src/c/symbol.d b/src/c/symbol.d index 6518db1ae..edbdaef37 100644 --- a/src/c/symbol.d +++ b/src/c/symbol.d @@ -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); diff --git a/src/c/tcp.d b/src/c/tcp.d index 8fd3e9a9d..0ec4ea3b5 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -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); diff --git a/src/c/threads.d b/src/c/threads.d index 03b0a881c..dc46892ba 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -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 { diff --git a/src/c/typespec.d b/src/c/typespec.d index 0f9247c61..a9c000fb3 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -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 diff --git a/src/h/ecl-inl.h b/src/h/ecl-inl.h index 82bb2538f..0922a2dbb 100644 --- a/src/h/ecl-inl.h +++ b/src/h/ecl-inl.h @@ -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 diff --git a/src/h/object.h b/src/h/object.h index d0c70c38a..556a9b7fa 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -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))