summaryrefslogtreecommitdiff
path: root/libguile/unif.c
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1996-09-19 09:08:07 +0000
committerGary Houston <ghouston@arglist.com>1996-09-19 09:08:07 +0000
commitf5bf2977c67516e13bbadf40ab28bf7806c46057 (patch)
treed1c79764c7c1788ccbac4def72ba9130c9b01273 /libguile/unif.c
parent2194b6f00e053c36c59df2d2cc686385e64cca68 (diff)
downloadguile-f5bf2977c67516e13bbadf40ab28bf7806c46057.tar.gz
* 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.
Diffstat (limited to 'libguile/unif.c')
-rw-r--r--libguile/unif.c50
1 files changed, 32 insertions, 18 deletions
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: