diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index b62b63556..408f50c05 100755 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -1385,7 +1385,8 @@ si_weak_pointer_value(cl_object o) { cl_object value; if (type_of(o) != t_weak_pointer) - FEwrong_type_argument(@'ext::weak-pointer', o); + 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/ffi.d b/src/c/ffi.d index 014b2ecde..81a6fee3f 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -187,7 +187,8 @@ void * ecl_foreign_data_pointer_safe(cl_object f) { if (type_of(f) != t_foreign) - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::foreign-data-pointer', f, + @'si::foreign-data'); return f->foreign.data; } @@ -235,7 +236,8 @@ cl_object si_free_foreign_data(cl_object f) { if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::free-foreign-data', f, + @'si::foreign-data'); } if (f->foreign.size) { /* See si_allocate_foreign_data() */ @@ -250,7 +252,8 @@ si_make_foreign_data_from_array(cl_object array) { cl_object tag = Cnil; if (type_of(array) != t_array && type_of(array) != t_vector) { - FEwrong_type_argument(@'array', array); + FEwrong_type_only_arg(@'si::make-foreign-data-from-array', array, + @'array'); } switch (array->array.elttype) { case aet_sf: tag = @':float'; break; @@ -268,7 +271,8 @@ cl_object si_foreign_data_address(cl_object f) { if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::foreign-data-address', f, + @'si::foreign-data'); } @(return ecl_make_unsigned_integer((cl_index)f->foreign.data)) } @@ -277,7 +281,8 @@ cl_object si_foreign_data_tag(cl_object f) { if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::foreign-data-tag', f, + @'si::foreign-data'); } @(return f->foreign.tag); } @@ -291,7 +296,8 @@ si_foreign_data_pointer(cl_object f, cl_object andx, cl_object asize, cl_object output; if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::foreign-data-pointer', f, + @'si::foreign-data'); } if (ndx >= f->foreign.size || (f->foreign.size - ndx) < size) { FEerror("Out of bounds reference into foreign data type ~A.", 1, f); @@ -311,7 +317,8 @@ si_foreign_data_ref(cl_object f, cl_object andx, cl_object asize, cl_object tag) cl_object output; if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_nth_arg(@'si::foreign-data-ref', 1, f, + @'si::foreign-data'); } if (ndx >= f->foreign.size || (f->foreign.size - ndx) < size) { FEerror("Out of bounds reference into foreign data type ~A.", 1, f); @@ -328,10 +335,12 @@ si_foreign_data_set(cl_object f, cl_object andx, cl_object value) cl_index size, limit; if (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_nth_arg(@'si::foreign-data-set', 1, f, + @'si::foreign-data'); } if (type_of(value) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', value); + FEwrong_type_nth_arg(@'si::foreign-data-set', 3, value, + @'si::foreign-data'); } size = value->foreign.size; limit = f->foreign.size; @@ -545,7 +554,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 (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + 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)) } @@ -560,7 +570,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 (type_of(f) != t_foreign) { - FEwrong_type_argument(@'si::foreign-data', f); + 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) @@ -577,7 +588,8 @@ cl_object si_null_pointer_p(cl_object f) { if (type_of(f) != t_foreign) - FEwrong_type_argument(@'si::foreign-data', f); + FEwrong_type_only_arg(@'si::null-pointer-p', f, + @'si::foreign-data'); @(return ((f->foreign.data == NULL)? Ct : Cnil)) } @@ -585,7 +597,8 @@ cl_object si_foreign_data_recast(cl_object f, cl_object size, cl_object tag) { if (type_of(f) != t_foreign) - FEwrong_type_argument(@'si::foreign-data', f); + 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 4e6961930..b0b85ad51 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -1852,7 +1852,8 @@ cl_object cl_two_way_stream_input_stream(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) - FEwrong_type_argument(@'two-way-stream', strm); + FEwrong_type_only_arg(@'two-way-stream-input-stream', + strm, @'two-way-stream'); @(return TWO_WAY_STREAM_INPUT(strm)) } @@ -1860,7 +1861,8 @@ cl_object cl_two_way_stream_output_stream(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_two_way) - FEwrong_type_argument(@'two-way-stream', strm); + FEwrong_type_only_arg(@'two-way-stream-output-stream', + strm, @'two-way-stream'); @(return TWO_WAY_STREAM_OUTPUT(strm)) } @@ -2039,7 +2041,8 @@ cl_object cl_broadcast_stream_streams(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_broadcast) - FEwrong_type_argument(@'broadcast-stream', strm); + FEwrong_type_only_arg(@'broadcast-stream-streams', + strm, @'broadcast-stream'); return cl_copy_list(BROADCAST_STREAM_LIST(strm)); } @@ -2219,7 +2222,8 @@ cl_object cl_echo_stream_input_stream(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) - FEwrong_type_argument(@'echo-stream', strm); + FEwrong_type_only_arg(@'echo-stream-input-stream', + strm, @'echo-stream'); @(return ECHO_STREAM_INPUT(strm)) } @@ -2227,7 +2231,8 @@ cl_object cl_echo_stream_output_stream(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_echo) - FEwrong_type_argument(@'echo-stream', strm); + FEwrong_type_only_arg(@'echo-stream-output-stream', + strm, @'echo-stream'); @(return ECHO_STREAM_OUTPUT(strm)) } @@ -2369,7 +2374,8 @@ cl_object cl_concatenated_stream_streams(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_concatenated) - FEwrong_type_argument(@'concatenated-stream', strm); + FEwrong_type_only_arg(@'concatenated-stream-streams', + strm, @'concatenated-stream'); return cl_copy_list(CONCATENATED_STREAM_LIST(strm)); } @@ -2567,7 +2573,8 @@ cl_object cl_synonym_stream_symbol(cl_object strm) { if (type_of(strm) != t_stream || strm->stream.mode != smm_synonym) - FEwrong_type_argument(@'synonym-stream', strm); + FEwrong_type_only_arg(@'synonym-stream-symbol', + strm, @'synonym-stream'); @(return SYNONYM_STREAM_SYMBOL(strm)) } @@ -4196,7 +4203,7 @@ cl_file_string_length(cl_object stream, cl_object string) l = compute_char_size(stream, CHAR_CODE(string)); break; default: - FEwrong_type_argument(@'string', string); + FEwrong_type_nth_arg(@'file-string-length', 2, string, @'string'); } @(return MAKE_FIXNUM(l)) } @@ -4354,7 +4361,7 @@ cl_open_stream_p(cl_object strm) } #endif if (type_of(strm) != t_stream) - FEwrong_type_argument(@'stream', strm); + FEwrong_type_only_arg(@'open-stream-p', strm, @'stream'); @(return (strm->stream.closed ? Cnil : Ct)) } @@ -4377,7 +4384,7 @@ cl_stream_external_format(cl_object strm) else #endif if (t != t_stream) - FEwrong_type_argument(@'stream', strm); + 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/num_rand.d b/src/c/num_rand.d index b2e7b8e2d..8782c9272 100644 --- a/src/c/num_rand.d +++ b/src/c/num_rand.d @@ -224,7 +224,8 @@ ecl_make_random_state(cl_object rs) rs = ecl_symbol_value(@'*random-state*'); } if (type_of(rs) != t_random) { - FEwrong_type_argument(@'random-state', rs); + FEwrong_type_only_arg(@'make-random-state', rs, + @'random-state'); } z->random.value = cl_copy_seq(rs->random.value); } diff --git a/src/c/pathname.d b/src/c/pathname.d index 1b727be14..c648a7dd2 100644 --- a/src/c/pathname.d +++ b/src/c/pathname.d @@ -676,10 +676,10 @@ L: default: ;/* Fall through to error message */ } - default: - FEwrong_type_argument(cl_list(4, @'or', @'file-stream', - @'string', @'pathname'), - x); + default: { + const char *type = "(OR FILE-STREAM STRING PATHNAME)"; + FEwrong_type_only_arg(@'pathname', x, ecl_read_from_cstring(type)); + } } @(return x) } diff --git a/src/c/print.d b/src/c/print.d index c396e7f3c..ed9f1f8cd 100644 --- a/src/c/print.d +++ b/src/c/print.d @@ -1451,8 +1451,9 @@ si_write_ugly_object(cl_object x, cl_object stream) #ifndef CLOS case t_structure: { cl_object print_function; - if (type_of(x->str.name) != t_symbol) - FEwrong_type_argument(@'symbol', x->str.name); + if (ecl_unlikely(type_of(x->str.name) != t_symbol)) + FEerror("Found a corrupt structure with a type name~%" + " ~S~%that is not a symbol.", x->str.name); print_function = si_get_sysprop(x->str.name, @'si::structure-print-function'); if (Null(print_function) || !ecl_print_structure()) { @@ -1560,8 +1561,6 @@ si_write_ugly_object(cl_object x, cl_object stream) break; #ifdef CLOS case t_instance: - if (!ECL_INSTANCEP(CLASS_OF(x))) - FEwrong_type_argument(@'ext::instance', CLASS_OF(x)); call_print_object(x, stream); break; #endif /* CLOS */ diff --git a/src/c/read.d b/src/c/read.d index 2d2ec4547..25b4839d8 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -1913,10 +1913,9 @@ si_readtable_case_set(cl_object r, cl_object mode) } else if (mode == @':invert') { r->readtable.read_case = ecl_case_invert; } else { - FEwrong_type_argument(cl_list(5, @'member', @':upcase', - @':downcase', @':preserve', - @':invert'), - mode); + const char *type = "(member :upcase :downcase :preserve :invert)"; + FEwrong_type_nth_arg(@'si::readtable-case-set', 2, + mode, ecl_read_from_cstring(type)); } @(return mode) } diff --git a/src/c/structure.d b/src/c/structure.d index 78f5266ab..000dbf956 100644 --- a/src/c/structure.d +++ b/src/c/structure.d @@ -92,7 +92,7 @@ ecl_copy_structure(cl_object x) cl_object y; if (!si_structurep(x)) - FEwrong_type_argument(@'structure', x); + 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_argument(@'structure', s); + FEwrong_type_only_arg(@'copy-structure', s, @'structure'); } @(return s) } @@ -135,7 +135,7 @@ cl_object si_structure_name(cl_object s) { if (!si_structurep(s)) - FEwrong_type_argument(@'structure', s); + FEwrong_type_only_arg(@'si::structure-name', s, @'structure'); @(return SNAME(s)) } @@ -144,17 +144,17 @@ si_structure_ref(cl_object x, cl_object type, cl_object index) { if (type_of(x) != T_STRUCTURE || !structure_subtypep(STYPE(x), type)) - FEwrong_type_argument(type, x); + FEwrong_type_nth_arg(@'si::structure-ref', 1, x, type); @(return SLOT(x, fix(index))) } cl_object -ecl_structure_ref(cl_object x, cl_object name, int n) +ecl_structure_ref(cl_object x, cl_object type, int n) { if (type_of(x) != T_STRUCTURE || - !structure_subtypep(STYPE(x), name)) - FEwrong_type_argument(name, x); + !structure_subtypep(STYPE(x), type)) + FEwrong_type_nth_arg(@'si::structure-ref', 1, x, type); return(SLOT(x, n)); } @@ -163,18 +163,18 @@ si_structure_set(cl_object x, cl_object type, cl_object index, cl_object val) { if (type_of(x) != T_STRUCTURE || !structure_subtypep(STYPE(x), type)) - FEwrong_type_argument(type, x); + FEwrong_type_nth_arg(@'si::structure-set', 1, x, type); SLOT(x, fix(index)) = val; @(return val) } cl_object -ecl_structure_set(cl_object x, cl_object name, int n, cl_object v) +ecl_structure_set(cl_object x, cl_object type, int n, cl_object v) { if (type_of(x) != T_STRUCTURE || - !structure_subtypep(STYPE(x), name)) - FEwrong_type_argument(name, x); + !structure_subtypep(STYPE(x), type)) + FEwrong_type_nth_arg(@'si::structure-set', 1, x, type); SLOT(x, n) = v; return(v); } diff --git a/src/c/tcp.d b/src/c/tcp.d index 396d12497..16f32b005 100644 --- a/src/c/tcp.d +++ b/src/c/tcp.d @@ -324,7 +324,8 @@ si_open_unix_socket_stream(cl_object path) struct sockaddr_un addr; if (type_of(path) != t_base_string) - FEwrong_type_argument(@'string', path); + 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 723688a7e..23633f0ff 100644 --- a/src/c/threads.d +++ b/src/c/threads.d @@ -611,9 +611,11 @@ mp_condition_variable_wait(cl_object cv, cl_object lock) int count, rc; cl_object own_process = mp_current_process(); if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); + FEwrong_type_nth_arg(@'mp::condition-variable-wait', 1, cv, + @'mp::condition-variable'); if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); + FEwrong_type_nth_arg(@'mp::condition-variable-wait', 2, lock, + @'mp::lock'); if (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); @@ -652,9 +654,11 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds) struct timeval tp; if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); + FEwrong_type_nth_arg(@'mp::condition-variable-timedwait', + 1, cv, @'mp::condition-variable'); if (type_of(lock) != t_lock) - FEwrong_type_argument(@'mp::lock', lock); + FEwrong_type_nth_arg(@'mp::condition-variable-timedwait', + 2, lock, @'mp::lock'); if (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); @@ -706,7 +710,8 @@ mp_condition_variable_signal(cl_object cv) FEerror("Condition variables are not supported under Windows.", 0); #else if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); + FEwrong_type_only_arg(@'mp::condition-variable-signal', + cv, @'mp::condition-variable'); pthread_cond_signal(&cv->condition_variable.cv); #endif @(return Ct) @@ -719,7 +724,8 @@ mp_condition_variable_broadcast(cl_object cv) FEerror("Condition variables are not supported under Windows.", 0); #else if (type_of(cv) != t_condition_variable) - FEwrong_type_argument(@'mp::condition-variable', cv); + FEwrong_type_only_arg(@'mp::condition-variable-broadcast', + cv, @'mp::condition-variable'); pthread_cond_broadcast(&cv->condition_variable.cv); #endif @(return Ct) @@ -785,7 +791,7 @@ mp_semaphore_trywait(cl_object sem) { cl_object output; if (typeof(sem) != t_semaphore) - FEwrong_type_argument(@'mp::semaphore', cv); + FEwrong_type_only_arg(@'mp::semaphore-trywait', sem, @'mp::semaphore'); AGAIN: #ifdef ECL_WINDOWS_THREADS { @@ -827,7 +833,7 @@ mp_semaphore_wait(cl_object sem) { cl_object output; if (typeof(sem) != t_semaphore) - FEwrong_type_argument(@'mp::semaphore', cv); + FEwrong_type_only_arg(@'mp::semaphore-wait', sem, @'mp::semaphore'); AGAIN: #ifdef ECL_WINDOWS_THREADS { @@ -858,7 +864,7 @@ cl_object mp_semaphore_signal(cl_object sem) { if (typeof(sem) != t_semaphore) - FEwrong_type_argument(@'mp::semaphore', cv); + FEwrong_type_only_arg(@'mp::semaphore-signal', sem, @'mp::semaphore'); AGAIN: #ifdef ECL_WINDOWS_THREADS { @@ -889,7 +895,7 @@ cl_object mp_semaphore_close(cl_object sem) { if (typeof(sem) != t_semaphore) - FEwrong_type_argument(@'mp::semaphore', cv); + FEwrong_type_only_arg(@'mp::semaphore-close', sem, @'mp::semaphore'); #ifdef ECL_WINDOWS_THREADS { HANDLE h = (HANDLE)(sem->semaphore.handle);