diff options
-rw-r--r-- | libguile/ChangeLog | 38 | ||||
-rw-r--r-- | libguile/__scm.h | 11 | ||||
-rw-r--r-- | libguile/error.c | 203 | ||||
-rw-r--r-- | libguile/error.h | 34 | ||||
-rw-r--r-- | libguile/eval.c | 34 | ||||
-rw-r--r-- | libguile/filesys.c | 1 | ||||
-rw-r--r-- | libguile/fports.c | 2 | ||||
-rw-r--r-- | libguile/gsubr.c | 2 | ||||
-rw-r--r-- | libguile/stackchk.c | 6 | ||||
-rw-r--r-- | libguile/strop.c | 9 | ||||
-rw-r--r-- | libguile/unif.c | 50 |
11 files changed, 241 insertions, 149 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 1eac3eff7..54c3c05bd 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,41 @@ +Thu Sep 19 00:00:29 1996 Gary Houston <ghouston@actrix.gen.nz> + + * filesys.c (scsm_sys_stat): don't SIGSEGV if argument is an + integer (assuming for now accepting an integer is a good thing). + + * error.c, fports.c: replace use of %S in lgh_error args with %s. + %S will be used instead for write'ing arguments. + + * unif.c (scm_transpose_array): change arguments in the SCM_WNA + asserts. fix a few other asserts. + (scm_aind, scm_enclose_array, scm_array_in_bounds_p, + scm_uniform_vector_ref, scm_array_set_x, + scm_dimensions_to_unform_array): change args in + SCM_WNA SCM_ASSERTS and change scm_wta's to scm_wrong_num_args. + strop.c (scm_substring_move_left_x, scm_substring_move_right_x, + scm_substring_fill_x): likewise. + gsubr.c (scm_gsubr_apply): likewise. + eval.c (SCM_APPLY): likewise. + + * eval.c (4 places): replace scm_everr with lgh_error or + scm_wrong_num_args. + + * error.c, error.h (scm_wrong_num_args, scm_wrong_type_arg, + scm_memory_error): new procedures. +* scm_everr: deleted. can use scm_wta, dropping first two args. + scm_error: convert NULL subr to SCM_BOOL_F. + + * __scm.h: don't define SCM_STACK_OVFLOW, SCM_EXIT, SCM_ARG6, SCM_ARG7, + SCM_ARGERR. + + * stackchk.c (scm_report_stack_overflow): use lgh_error instead + of scm_wta. + + * error.c, error.h: new error keys: scm_arg_type_key, + scm_args_number_key, scm_memory_alloc_key, scm_stack_overflow_key, + scm_misc_error_key. + scm_wta: reimplement using lgh_error instead of scm_everr. + Wed Sep 18 17:13:35 1996 Mikael Djurfeldt <mdj@kenneth> * gdbint.c: scm_lread now has one more argument. diff --git a/libguile/__scm.h b/libguile/__scm.h index 86f345edd..44f464b2e 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -321,11 +321,12 @@ extern unsigned int scm_async_clock; #define SCM_ARG3 3 #define SCM_ARG4 4 #define SCM_ARG5 5 -#define SCM_ARG6 6 -#define SCM_ARG7 7 -#define SCM_ARGERR(X) ((X) < SCM_WNA \ + /* #define SCM_ARG6 6 + #define SCM_ARG7 7 */ + /* #define SCM_ARGERR(X) ((X) < SCM_WNA \ ? (char *)(X) \ : "wrong type argument") + */ /* Following must match entry indexes in scm_errmsgs[]. * Also, SCM_WNA must follow the last SCM_ARGn in sequence. @@ -334,8 +335,8 @@ extern unsigned int scm_async_clock; /* #define SCM_OVSCM_FLOW 9 */ #define SCM_OUTOFRANGE 10 #define SCM_NALLOC 11 -#define SCM_STACK_OVFLOW 12 -#define SCM_EXIT 13 + /* #define SCM_STACK_OVFLOW 12 */ + /* #define SCM_EXIT 13 */ /* (...still matching scm_errmsgs) These diff --git a/libguile/error.c b/libguile/error.c index 87d6a958e..13aaf1e8c 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -63,16 +63,11 @@ */ int scm_ints_disabled = 1; - extern int errno; -#ifdef __STDC__ -static void -err_head (char *str) -#else + static void err_head (str) char *str; -#endif { int oerrno = errno; if (SCM_NIMP (scm_cur_outp)) @@ -100,14 +95,9 @@ err_head (str) SCM_PROC(s_errno, "errno", 0, 1, 0, scm_errno); -#ifdef __STDC__ -SCM -scm_errno (SCM arg) -#else -SCM +SCM scm_errno (arg) SCM arg; -#endif { int old = errno; if (!SCM_UNBNDP (arg)) @@ -121,82 +111,19 @@ scm_errno (arg) } SCM_PROC(s_perror, "perror", 1, 0, 0, scm_perror); -#ifdef __STDC__ -SCM -scm_perror (SCM arg) -#else SCM scm_perror (arg) SCM arg; -#endif { SCM_ASSERT (SCM_NIMP (arg) && SCM_STRINGP (arg), arg, SCM_ARG1, s_perror); err_head (SCM_CHARS (arg)); return SCM_UNSPECIFIED; } - -#ifdef __STDC__ -void -scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr) -#else -void -scm_everr (exp, env, arg, pos, s_subr) - SCM exp; - SCM env; - SCM arg; - char *pos; - char *s_subr; -#endif -{ - SCM desc; - SCM args; - - if ((~0x1fL) & (long) pos) - desc = scm_makfrom0str (pos); - else - desc = SCM_MAKINUM ((long)pos); - - { - SCM sym; - if (!s_subr || !*s_subr) - sym = SCM_BOOL_F; - else - sym = SCM_CAR (scm_intern0 (s_subr)); - args = scm_listify (desc, sym, arg, SCM_UNDEFINED); - } - - /* (throw (quote scm_system-error_key) <desc> <proc-name> arg) - * - * <desc> is a string or an integer (see %%system-errors). - * <proc-name> is a symbol or #f in some annoying cases (e.g. cddr). - */ - - scm_ithrow (scm_system_error_key, args, 1); - - /* No return, but just in case: */ - - write (2, "unhandled system error", sizeof ("unhandled system error") - 1); - exit (1); -} - -#ifdef __STDC__ -SCM -scm_wta (SCM arg, char *pos, char *s_subr) -#else -SCM -scm_wta (arg, pos, s_subr) - SCM arg; - char *pos; - char *s_subr; -#endif -{ - scm_everr (SCM_UNDEFINED, SCM_EOL, arg, pos, s_subr); - return SCM_UNSPECIFIED; -} - void (*scm_error_callback) () = 0; +/* all errors thrown from C should pass through here. */ +/* also known as lgh_error. */ void scm_error (key, subr, message, args, rest) SCM key; @@ -209,7 +136,7 @@ scm_error (key, subr, message, args, rest) if (scm_error_callback) (*scm_error_callback) (key, subr, message, args, rest); - arg_list = scm_listify (scm_makfrom0str (subr), + arg_list = scm_listify (subr ? scm_makfrom0str (subr) : SCM_BOOL_F, scm_makfrom0str (message), args, rest, @@ -227,15 +154,19 @@ scm_error (key, subr, message, args, rest) SCM scm_system_error_key; SCM scm_num_overflow_key; SCM scm_out_of_range_key; +SCM scm_arg_type_key; +SCM scm_args_number_key; +SCM scm_memory_alloc_key; +SCM scm_stack_overflow_key; +SCM scm_misc_error_key; -/* various convenient interfaces to lgh_error. */ void scm_syserror (subr) char *subr; { lgh_error (scm_system_error_key, subr, - "%S", + "%s", scm_listify (scm_makfrom0str (strerror (errno)), SCM_UNDEFINED), scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); @@ -261,7 +192,7 @@ scm_sysmissing (subr) #ifdef ENOSYS lgh_error (scm_system_error_key, subr, - "%S", + "%s", scm_listify (scm_makfrom0str (strerror (ENOSYS)), SCM_UNDEFINED), scm_listify (SCM_MAKINUM (ENOSYS), SCM_UNDEFINED)); #else @@ -295,14 +226,104 @@ scm_out_of_range (subr, bad_value) scm_listify (bad_value, SCM_UNDEFINED), SCM_BOOL_F); } - -#ifdef __STDC__ + void -scm_init_error (void) -#else +scm_wrong_num_args (proc) + SCM proc; +{ + lgh_error (scm_args_number_key, + NULL, + "Wrong number of arguments to %s", + scm_listify (proc, SCM_UNDEFINED), + SCM_BOOL_F); +} + +void +scm_wrong_type_arg (subr, pos, bad_value) + char *subr; + int pos; + SCM bad_value; +{ + lgh_error (scm_arg_type_key, + subr, + (pos == 0) ? "Wrong type argument: %S" + : "Wrong type argument in position %s: %S", + (pos == 0) ? scm_listify (bad_value, SCM_UNDEFINED) + : scm_listify (SCM_MAKINUM (pos), bad_value, SCM_UNDEFINED), + SCM_BOOL_F); +} + +void +scm_memory_error (subr) + char *subr; +{ + lgh_error (scm_memory_alloc_key, + subr, + "Memory allocation error", + SCM_BOOL_F, + SCM_BOOL_F); +} + +/* implements the SCM_ASSERT interface. */ +SCM +scm_wta (arg, pos, s_subr) + SCM arg; + char *pos; + char *s_subr; +{ + if (!s_subr || !*s_subr) + s_subr = NULL; + if ((~0x1fL) & (long) pos) + { + /* error string supplied. */ + lgh_error (scm_misc_error_key, + s_subr, + pos, + SCM_BOOL_F, + SCM_BOOL_F); + } + else + { + /* numerical error code. */ + int error = (long) pos; + + switch (error) + { + case SCM_ARGn: + scm_wrong_type_arg (s_subr, 0, arg); + case SCM_ARG1: + scm_wrong_type_arg (s_subr, 1, arg); + case SCM_ARG2: + scm_wrong_type_arg (s_subr, 2, arg); + case SCM_ARG3: + scm_wrong_type_arg (s_subr, 3, arg); + case SCM_ARG4: + scm_wrong_type_arg (s_subr, 4, arg); + case SCM_ARG5: + scm_wrong_type_arg (s_subr, 5, arg); + case SCM_WNA: + scm_wrong_num_args (arg); + case SCM_OUTOFRANGE: + scm_out_of_range (s_subr, arg); + case SCM_NALLOC: + scm_memory_error (s_subr); + default: + /* this shouldn't happen. */ + lgh_error (scm_misc_error_key, + s_subr, + "Unknown error", + SCM_BOOL_F, + SCM_BOOL_F); + } + } + return SCM_UNSPECIFIED; +} + +/* obsolete interface: scm_everr (exp, env, arg, pos, s_subr) + was equivalent to scm_wta (arg, pos, s_subr) */ + void scm_init_error () -#endif { scm_system_error_key = scm_permanent_object (SCM_CAR (scm_intern0 ("system-error"))); @@ -310,6 +331,16 @@ scm_init_error () = scm_permanent_object (SCM_CAR (scm_intern0 ("numerical-overflow"))); scm_out_of_range_key = scm_permanent_object (SCM_CAR (scm_intern0 ("out-of-range"))); + scm_arg_type_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("wrong-type-arg"))); + scm_args_number_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("wrong-number-of-args"))); + scm_memory_alloc_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("memory-allocation-error"))); + scm_stack_overflow_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("stack-overflow"))); + scm_misc_error_key + = scm_permanent_object (SCM_CAR (scm_intern0 ("misc-error"))); #include "error.x" } diff --git a/libguile/error.h b/libguile/error.h index 8ca8e9606..68ddfcdad 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -51,9 +51,16 @@ extern int scm_ints_disabled; extern SCM scm_system_error_key; extern SCM scm_num_overflow_key; extern SCM scm_out_of_range_key; +extern SCM scm_arg_type_key; +extern SCM scm_args_number_key; +extern SCM scm_memory_alloc_key; +extern SCM scm_stack_overflow_key; +extern SCM scm_misc_error_key; +extern SCM scm_errno SCM_P ((SCM arg)); +extern SCM scm_perror SCM_P ((SCM arg)); extern void scm_error SCM_P ((SCM key, char *subr, char *message, SCM args, SCM rest)); extern void (*scm_error_callback) SCM_P ((SCM key, char *subr, @@ -63,27 +70,10 @@ extern void scm_syserror_msg SCM_P ((char *subr, char *message, SCM args)); extern void scm_sysmissing SCM_P ((char *subr)); extern void scm_num_overflow SCM_P ((char *subr)); extern void scm_out_of_range SCM_P ((char *subr, SCM bad_value)); - -#ifdef __STDC__ -extern int scm_handle_it (int i); -extern void scm_warn (char *str1, char *str2); -extern SCM scm_errno (SCM arg); -extern SCM scm_perror (SCM arg); -extern void scm_def_err_response (void); -extern void scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr); -extern SCM scm_wta (SCM arg, char *pos, char *s_subr); -extern void scm_init_error (void); - -#else /* STDC */ -extern int scm_handle_it (); -extern void scm_warn (); -extern SCM scm_errno (); -extern SCM scm_perror (); -extern void scm_def_err_response (); -extern void scm_everr (); -extern SCM scm_wta (); -extern void scm_init_error (); - -#endif /* STDC */ +extern void scm_wrong_num_args SCM_P ((SCM proc)); +extern void scm_wrong_type_arg SCM_P ((char *subr, int pos, SCM bad_value)); +extern void scm_memory_error SCM_P ((char *subr)); +extern SCM scm_wta SCM_P ((SCM arg, char *pos, char *s_subr)); +extern void scm_init_error SCM_P ((void)); #endif /* ERRORH */ diff --git a/libguile/eval.c b/libguile/eval.c index 16ab9d5d9..5acfcedfe 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -242,11 +242,14 @@ scm_lookupcar (vloc, genv) { var = SCM_CAR (var); errout: - scm_everr (vloc, genv, var, - (SCM_NULLP (env) - ? "unbound variable: " - : "damaged environment"), - ""); + /* scm_everr (vloc, genv,...) */ + lgh_error (scm_misc_error_key, + NULL, + SCM_NULLP (env) + ? "Unbound variable: %S" + : "Damaged environment: %S", + scm_listify (var, SCM_UNDEFINED), + SCM_BOOL_F); } #endif SCM_CAR (vloc) = var + 1; @@ -432,8 +435,12 @@ scm_m_vref (xorig, env) ASSYNT (1 == scm_ilength (x), xorig, s_expression, s_vref); if (SCM_NIMP(x) && UDSCM_VARIABLEP (SCM_CAR (x))) { - scm_everr (SCM_UNDEFINED, env, SCM_CAR(SCM_CDR(x)), s_variable, - "global variable reference"); + /* scm_everr (SCM_UNDEFINED, env,..., "global variable reference") */ + lgh_error (scm_misc_error_key, + NULL, + "Bad variable: %S", + scm_listify (SCM_CAR (SCM_CDR (x)), SCM_UNDEFINED), + SCM_BOOL_F); } ASSYNT (SCM_NIMP(x) && DEFSCM_VARIABLEP (SCM_CAR (x)), xorig, s_variable, s_vref); @@ -1848,8 +1855,12 @@ dispatch: default: proc = x; badfun: - scm_everr (x, env, proc, "Wrong type to apply: ", ""); - + /* scm_everr (x, env,...) */ + lgh_error (scm_misc_error_key, + NULL, + "Wrong type to apply: %S", + scm_listify (proc, SCM_UNDEFINED), + SCM_BOOL_F); case scm_tc7_vector: case scm_tc7_wvect: case scm_tc7_bvect: @@ -2021,7 +2032,8 @@ evapply: umwrongnumargs: unmemocar (x, env); wrongnumargs: - scm_everr (x, env, proc, (char *) SCM_WNA, ""); + /* scm_everr (x, env,...) */ + scm_wrong_num_args (proc); default: /* handle macros here */ goto badfun; @@ -2582,7 +2594,7 @@ tail: goto tail; #endif wrongnumargs: - scm_wta (proc, (char *) SCM_WNA, "apply"); + scm_wrong_num_args (proc); default: badproc: scm_wta (proc, (char *) SCM_ARG1, "apply"); diff --git a/libguile/filesys.c b/libguile/filesys.c index c81ee5e85..c9cfab9fc 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -594,7 +594,6 @@ scm_sys_stat (fd_or_path) if (SCM_INUMP (fd_or_path)) { - SCM_ASSERT (SCM_OPFPORTP (fd_or_path), fd_or_path, SCM_ARG1, s_sys_stat); rv = SCM_INUM (fd_or_path); SCM_SYSCALL (rv = fstat (rv, &stat_temp)); } diff --git a/libguile/fports.c b/libguile/fports.c index 1cc25de2a..64842d653 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -171,7 +171,7 @@ scm_open_file (filename, modes) SCM_SYSCALL (f = fopen (file, mode)); if (!f) { - scm_syserror_msg (s_open_file, "%S: %S", + scm_syserror_msg (s_open_file, "%s: %S", scm_listify (scm_makfrom0str (strerror (errno)), filename, SCM_UNDEFINED)); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 5f0a3e981..4dd37a331 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -130,7 +130,7 @@ scm_gsubr_apply(args) for (i = 0; i < GSUBR_REQ(typ); i++) { #ifndef RECKLESS if (SCM_IMP(args)) - scm_wta(SCM_UNDEFINED, (char *)SCM_WNA, SCM_CHARS(SCM_SNAME(GSUBR_PROC(self)))); + scm_wrong_num_args (SCM_SNAME(GSUBR_PROC(self))); #endif v[i] = SCM_CAR(args); args = SCM_CDR(args); diff --git a/libguile/stackchk.c b/libguile/stackchk.c index 2e22edbf7..b10373e7b 100644 --- a/libguile/stackchk.c +++ b/libguile/stackchk.c @@ -57,7 +57,11 @@ void scm_report_stack_overflow () { scm_stack_checking_enabled_p = 0; - scm_wta (SCM_UNDEFINED, (char *) SCM_STACK_OVFLOW, NULL); + lgh_error (scm_stack_overflow_key, + NULL, + "Stack overflow", + SCM_BOOL_F, + SCM_BOOL_F); } #endif diff --git a/libguile/strop.c b/libguile/strop.c index ac312534a..bfcf5f498 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -200,7 +200,8 @@ scm_substring_move_left_x (str1, start1, args) { SCM end1, str2, start2; long i, j, e; - SCM_ASSERT (3==scm_ilength (args), args, SCM_WNA, s_substring_move_left_x); + SCM_ASSERT (3==scm_ilength (args), scm_makfrom0str (s_substring_move_left_x), + SCM_WNA, NULL); end1 = SCM_CAR (args); args = SCM_CDR (args); str2 = SCM_CAR (args); args = SCM_CDR (args); start2 = SCM_CAR (args); @@ -233,7 +234,8 @@ scm_substring_move_right_x (str1, start1, args) { SCM end1, str2, start2; long i, j, e; - SCM_ASSERT (3==scm_ilength (args), args, SCM_WNA, s_substring_move_right_x); + SCM_ASSERT (3==scm_ilength (args), + scm_makfrom0str (s_substring_move_right_x), SCM_WNA, NULL); end1 = SCM_CAR (args); args = SCM_CDR (args); str2 = SCM_CAR (args); args = SCM_CDR (args); start2 = SCM_CAR (args); @@ -267,7 +269,8 @@ scm_substring_fill_x (str, start, args) SCM end, fill; long i, e; char c; - SCM_ASSERT (2==scm_ilength (args), args, SCM_WNA, s_substring_fill_x); + SCM_ASSERT (2==scm_ilength (args), scm_makfrom0str (s_substring_fill_x), + SCM_WNA, NULL); end = SCM_CAR (args); args = SCM_CDR (args); fill = SCM_CAR (args); SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_substring_fill_x); diff --git a/libguile/unif.c b/libguile/unif.c index 7cc8d6ae1..b5f51f224 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -503,7 +503,7 @@ scm_aind (ra, args, what) if (SCM_INUMP (args)) { - SCM_ASSERT (1 == k, SCM_UNDEFINED, SCM_WNA, what); + SCM_ASSERT (1 == k, scm_makfrom0str (what), SCM_WNA, NULL); return pos + (SCM_INUM (args) - s->lbnd) * (s->inc); } while (k && SCM_NIMP (args)) @@ -517,7 +517,8 @@ scm_aind (ra, args, what) k--; s++; } - SCM_ASSERT (0 == k && SCM_NULLP (args), SCM_UNDEFINED, SCM_WNA, what); + SCM_ASSERT (0 == k && SCM_NULLP (args), scm_makfrom0str (what), SCM_WNA, + NULL); return pos; } @@ -610,7 +611,9 @@ scm_dimensions_to_uniform_array (dims, prot, fill) answer = scm_make_uve (SCM_INUM (dims), prot); if (SCM_NNULLP (fill)) { - SCM_ASSERT (1 == scm_ilength (fill), fill, SCM_WNA, s_dimensions_to_uniform_array); + SCM_ASSERT (1 == scm_ilength (fill), + scm_makfrom0str (s_dimensions_to_uniform_array), + SCM_WNA, NULL); scm_array_fill_x (answer, SCM_CAR (fill)); } else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot)) @@ -666,7 +669,9 @@ scm_dimensions_to_uniform_array (dims, prot, fill) } if (SCM_NNULLP (fill)) { - SCM_ASSERT (1 == scm_ilength (fill), fill, SCM_WNA, s_dimensions_to_uniform_array); + SCM_ASSERT (1 == scm_ilength (fill), + scm_makfrom0str (s_dimensions_to_uniform_array), SCM_WNA, + NULL); scm_array_fill_x (ra, SCM_CAR (fill)); } else if (SCM_NIMP (prot) && SCM_SYMBOLP (prot)) @@ -836,14 +841,15 @@ scm_transpose_array (args) SCM ra, res, vargs, *ve = &vargs; scm_array_dim *s, *r; int ndim, i, k; - SCM_ASSERT (SCM_NIMP (args), SCM_UNDEFINED, SCM_WNA, s_transpose_array); + SCM_ASSERT (SCM_NNULLP (args), scm_makfrom0str (s_transpose_array), + SCM_WNA, NULL); ra = SCM_CAR (args); + SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, s_transpose_array); args = SCM_CDR (args); - switch SCM_TYP7 - (ra) + switch (SCM_TYP7 (ra)) { default: - badarg:scm_wta (ra, (char *) SCM_ARG1, s_transpose_array); + badarg:scm_wta (ra, (char *) SCM_ARGn, s_transpose_array); case scm_tc7_bvect: case scm_tc7_string: case scm_tc7_byvect: @@ -856,14 +862,19 @@ scm_transpose_array (args) #ifdef LONGLONGS case scm_tc7_llvect: #endif - SCM_ASSERT (SCM_NIMP (args) && SCM_NULLP (SCM_CDR (args)), SCM_UNDEFINED, SCM_WNA, s_transpose_array); - SCM_ASSERT (SCM_INUM0 == SCM_CAR (args), SCM_CAR (args), SCM_ARG1, s_transpose_array); + SCM_ASSERT (SCM_NIMP (args) && SCM_NULLP (SCM_CDR (args)), + scm_makfrom0str (s_transpose_array), SCM_WNA, NULL); + SCM_ASSERT (SCM_INUMP (SCM_CAR (args)), SCM_CAR (args), SCM_ARG2, + s_transpose_array); + SCM_ASSERT (SCM_INUM0 == SCM_CAR (args), SCM_CAR (args), SCM_OUTOFRANGE, + s_transpose_array); return ra; case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (ra), badarg); vargs = scm_vector (args); - SCM_ASSERT (SCM_LENGTH (vargs) == SCM_ARRAY_NDIM (ra), SCM_UNDEFINED, SCM_WNA, s_transpose_array); - ve = SCM_VELTS (vargs); + SCM_ASSERT (SCM_LENGTH (vargs) == SCM_ARRAY_NDIM (ra), + scm_makfrom0str (s_transpose_array), SCM_WNA, NULL); + ve = SCM_VELTS (vargs); ndim = 0; for (k = 0; k < SCM_ARRAY_NDIM (ra); k++) { @@ -926,7 +937,8 @@ scm_enclose_array (axes) SCM axv, ra, res, ra_inr; scm_array_dim vdim, *s = &vdim; int ndim, j, k, ninr, noutr; - SCM_ASSERT (SCM_NIMP (axes), SCM_UNDEFINED, SCM_WNA, s_enclose_array); + SCM_ASSERT (SCM_NIMP (axes), scm_makfrom0str (s_enclose_array), SCM_WNA, + NULL); ra = SCM_CAR (axes); axes = SCM_CDR (axes); if (SCM_NULLP (axes)) @@ -970,7 +982,8 @@ scm_enclose_array (axes) } noutr = ndim - ninr; axv = scm_make_string (SCM_MAKINUM (ndim), SCM_MAKICHR (0)); - SCM_ASSERT (0 <= noutr && 0 <= ninr, SCM_UNDEFINED, SCM_WNA, s_enclose_array); + SCM_ASSERT (0 <= noutr && 0 <= ninr, scm_makfrom0str (s_enclose_array), + SCM_WNA, NULL); res = scm_make_ra (noutr); SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr); SCM_ARRAY_V (res) = ra_inr; @@ -1013,7 +1026,8 @@ scm_array_in_bounds_p (args) register scm_sizet k; register long j; scm_array_dim *s; - SCM_ASSERT (SCM_NIMP (args), args, SCM_WNA, s_array_in_bounds_p); + SCM_ASSERT (SCM_NIMP (args), scm_makfrom0str (s_array_in_bounds_p), + SCM_WNA, NULL); v = SCM_CAR (args); args = SCM_CDR (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1031,7 +1045,7 @@ tail: { default: badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_in_bounds_p); - wna:scm_wta (args, (char *) SCM_WNA, s_array_in_bounds_p); + wna: scm_wrong_num_args (scm_makfrom0str (s_array_in_bounds_p)); case scm_tc7_smob: k = SCM_ARRAY_NDIM (v); s = SCM_ARRAY_DIMS (v); @@ -1129,7 +1143,7 @@ scm_uniform_vector_ref (v, args) return v; badarg:scm_wta (v, (char *) SCM_ARG1, s_uniform_vector_ref); outrng:scm_out_of_range (s_uniform_vector_ref, SCM_MAKINUM (pos)); - wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_uniform_vector_ref); + wna: scm_wrong_num_args (scm_makfrom0str (s_uniform_vector_ref)); case scm_tc7_smob: { /* enclosed */ int k = SCM_ARRAY_NDIM (v); @@ -1322,7 +1336,7 @@ scm_array_set_x (v, obj, args) default: badarg1:scm_wta (v, (char *) SCM_ARG1, s_array_set_x); outrng:scm_out_of_range (s_array_set_x, SCM_MAKINUM (pos)); - wna:scm_wta (SCM_UNDEFINED, (char *) SCM_WNA, s_array_set_x); + wna: scm_wrong_num_args (scm_makfrom0str (s_array_set_x)); case scm_tc7_smob: /* enclosed */ goto badarg1; case scm_tc7_bvect: |