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.
+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.
#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.
/* #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
*/
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))
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))
}
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;
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,
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));
#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
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")));
= 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"
}
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;
\f
+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,
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 */
{
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;
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);
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:
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;
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");
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));
}
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));
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);
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
{
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);
{
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);
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);
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))
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;
}
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))
}
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))
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:
#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++)
{
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))
}
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;
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);
{
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);
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);
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:
HCoop / bpt / guile.git / commitdiff