diff options
author | Gary Houston <ghouston@arglist.com> | 1996-09-14 07:47:50 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1996-09-14 07:47:50 +0000 |
commit | e1724d200d3d1c81e67c5a5b20413f4889a3acce (patch) | |
tree | 255da5d11be37884c735e0cbf6a45ca192fd1ba3 /libguile | |
parent | 7d41a049f4e82d4901fb001a6dc403354a91a0f4 (diff) | |
download | guile-e1724d200d3d1c81e67c5a5b20413f4889a3acce.tar.gz |
* numbers.c: use SCM_NUM_OVERFLOW instead of scm_wta or ASSERT.
* error.c, error.h: setup scm_num_overflow key.
* __scm.h: SCM_NUM_OVERFLOW: macro for reporting numerical overflow.
Remove definition of SCM_OVSCM_FLOW.
* fports.c (scm_open_file): use SCM_SYSERROR_M.
* __scm.h: SCM_SYSERROR_M: new macro for system errors with an
explicit message and args.
* error.c, error.h, __scm.h: change system_error_sym to
scm_system_error.
* error.c (system_error_sym): remove leading %% from the Scheme name
"%%system-error".
* __scm.h (SCM_SYSMISSING): Redefine using lgh_error.
* boot-9.scm: remove leading %% from references to '%%system-error.
(%%handle-system-error): don't pass all the thrown arguments when
aborting, just the key and subr.
Remove the code to "Install default handlers for built-in errors."
Remove the definition of the syserror procedure.
Associate 'numerical-overflow with default handler.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/ChangeLog | 22 | ||||
-rw-r--r-- | libguile/__scm.h | 59 | ||||
-rw-r--r-- | libguile/error.c | 15 | ||||
-rw-r--r-- | libguile/error.h | 3 | ||||
-rw-r--r-- | libguile/fports.c | 5 | ||||
-rw-r--r-- | libguile/numbers.c | 36 |
6 files changed, 95 insertions, 45 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index fa92cd205..91da62b16 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,25 @@ +Sat Sep 14 03:35:41 1996 Gary Houston <ghouston@actrix.gen.nz> + + * numbers.c: use SCM_NUM_OVERFLOW instead of scm_wta or ASSERT. + + * error.c, error.h: setup scm_num_overflow key. + + * __scm.h: SCM_NUM_OVERFLOW: macro for reporting numerical overflow. + Remove definition of SCM_OVSCM_FLOW. + + * fports.c (scm_open_file): use SCM_SYSERROR_M. + + * __scm.h: SCM_SYSERROR_M: new macro for system errors with an + explicit message and args. + + * error.c, error.h, __scm.h: change system_error_sym to + scm_system_error. + + * error.c (system_error_sym): remove leading %% from the Scheme name + "%%system-error". + + * __scm.h (SCM_SYSMISSING): Redefine using lgh_error. + Fri Sep 13 12:58:08 1996 Mikael Djurfeldt <mdj@woody.nada.kth.se> * __scm.h, chars.c, debug.c, eval.c, eval.h, extchrs.c, extchrs.h, diff --git a/libguile/__scm.h b/libguile/__scm.h index 2d11ff59d..4af8303ef 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -316,35 +316,44 @@ extern unsigned int scm_async_clock; scm_error (_key, _subr, _message, _args, _rest) #define SCM_SYSERROR(_subr) \ - lgh_error (system_error_sym, \ - _subr, \ - "%S", \ - scm_listify (scm_makfrom0str (strerror (errno)), \ - SCM_UNDEFINED), \ - scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); - -/* - old version: - #define SCM_SYSERROR(_subr) \ - scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \ - strerror (errno), _subr) - */ - - /* equivalent to: - scm_throw (system_error_sym, \ - scm_listify (scm_makfrom0str (strerror (errno)), \ - scm_makfrom0str (_subr), \ - SCM_UNDEFINED)); - */ + lgh_error (scm_system_error, \ + _subr, \ + "%S", \ + scm_listify (scm_makfrom0str (strerror (errno)), \ + SCM_UNDEFINED), \ + scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); + +#define SCM_SYSERROR_M(_subr, _message, _args) \ + lgh_error (scm_system_error, \ + _subr, \ + _message, \ + _args, \ + scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); + #ifdef ENOSYS # define SCM_SYSMISSING(_subr) \ - scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \ - strerror (ENOSYS), _subr) + lgh_error (scm_system_error, \ + _subr, \ + "%S", \ + scm_listify (scm_makfrom0str (strerror (ENOSYS)), \ + SCM_UNDEFINED), \ + scm_listify (SCM_MAKINUM (ENOSYS), SCM_UNDEFINED)); #else # define SCM_SYSMISSING(_subr) \ - scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \ - "missing function", _subr) + lgh_error (scm_system_error, \ + _subr, \ + "missing function", \ + scm_listify (SCM_UNDEFINED), \ + scm_listify (SCM_MAKINUM (0), SCM_UNDEFINED)); #endif + +#define SCM_NUM_OVERFLOW(_subr) \ + lgh_error (scm_num_overflow, \ + _subr, \ + "numerical overflow", \ + scm_listify (SCM_UNDEFINED), \ + scm_listify (SCM_UNDEFINED)); + #define SCM_ARGn 0 #define SCM_ARG1 1 #define SCM_ARG2 2 @@ -361,7 +370,7 @@ extern unsigned int scm_async_clock; * Also, SCM_WNA must follow the last SCM_ARGn in sequence. */ #define SCM_WNA 8 -#define SCM_OVFLOW 9 + /* #define SCM_OVSCM_FLOW 9 */ #define SCM_OUTOFRANGE 10 #define SCM_NALLOC 11 #define SCM_STACK_OVFLOW 12 diff --git a/libguile/error.c b/libguile/error.c index 440b91a87..d975da9b0 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -57,7 +57,6 @@ /* {Errors and Exceptional Conditions} */ -SCM system_error_sym; /* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and * when the interpreter is not running at all. @@ -167,13 +166,13 @@ scm_everr (exp, env, arg, pos, s_subr) args = scm_listify (desc, sym, arg, SCM_UNDEFINED); } - /* (throw (quote %%system-error) <desc> <proc-name> arg) + /* (throw (quote system-error) <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 (system_error_sym, args, 1); + scm_ithrow (scm_system_error, args, 1); /* No return, but just in case: */ @@ -223,6 +222,11 @@ scm_error (key, subr, message, args, rest) exit (1); } +/* error keys: defined here, initialized below, prototyped in error.h, + associated with handler procedures in boot-9.scm. */ +SCM scm_system_error; +SCM scm_num_overflow; + #ifdef __STDC__ void scm_init_error (void) @@ -231,7 +235,10 @@ void scm_init_error () #endif { - system_error_sym = scm_permanent_object (SCM_CAR (scm_intern0 ("%%system-error"))); + scm_system_error + = scm_permanent_object (SCM_CAR (scm_intern0 ("system-error"))); + scm_num_overflow + = scm_permanent_object (SCM_CAR (scm_intern0 ("numerical-overflow"))); #include "error.x" } diff --git a/libguile/error.h b/libguile/error.h index 816d4f767..046a38f0d 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -47,7 +47,8 @@ extern int scm_ints_disabled; -extern SCM system_error_sym; +extern SCM scm_system_error; +extern SCM scm_num_overflow; diff --git a/libguile/fports.c b/libguile/fports.c index a5b30a10d..c3a1eb47c 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -196,7 +196,10 @@ scm_open_file (filename, modes) port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes)); if (port == SCM_BOOL_F) { - SCM_SYSERROR (s_open_file); + SCM_SYSERROR_M (s_open_file, "%S: %S", + scm_listify (scm_makfrom0str (strerror (errno)), + filename, + SCM_UNDEFINED)); /* Force the compiler to keep filename and modes alive. */ scm_cons (filename, modes); } diff --git a/libguile/numbers.c b/libguile/numbers.c index 30b99c00d..070f52911 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -166,7 +166,7 @@ scm_abs(x) #ifdef SCM_BIGDIG return scm_long2big(x); #else - scm_wta(SCM_MAKINUM(-x), (char *)SCM_OVFLOW, s_abs); + SCM_NUM_OVERFLOW (s_abs); #endif return SCM_MAKINUM(x); } @@ -229,7 +229,7 @@ scm_quotient(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_quotient); #endif if ((z = SCM_INUM(y))==0) - ov: scm_wta(y, (char *)SCM_OVFLOW, s_quotient); + ov: SCM_NUM_OVERFLOW (s_quotient); z = SCM_INUM(x)/z; #ifdef BADIVSGNS { @@ -249,7 +249,7 @@ scm_quotient(x, y) #ifdef SCM_BIGDIG return scm_long2big(z); #else - scm_wta(x, (char *)SCM_OVFLOW, s_quotient); + SCM_NUM_OVERFLOW (s_quotient); #endif return SCM_MAKINUM(z); } @@ -289,7 +289,7 @@ scm_remainder(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_remainder); #endif if (!(z = SCM_INUM(y))) - ov: scm_wta(y, (char *)SCM_OVFLOW, s_remainder); + ov: SCM_NUM_OVERFLOW (s_remainder); #if (__TURBOC__==1) if (z < 0) z = -z; #endif @@ -339,7 +339,7 @@ scm_modulo(x, y) SCM_ASSERT(SCM_INUMP(y), y, SCM_ARG2, s_modulo); #endif if (!(yy = SCM_INUM(y))) - ov: scm_wta(y, (char *)SCM_OVFLOW, s_modulo); + ov: SCM_NUM_OVERFLOW (s_modulo); #if (__TURBOC__==1) z = SCM_INUM(x); z = ((yy<0) ? -z : z)%yy; @@ -410,7 +410,7 @@ scm_gcd(x, y) #ifdef SCM_BIGDIG return scm_long2big(u); #else - scm_wta(x, (char *)SCM_OVFLOW, s_gcd); + SCM_NUM_OVERFLOW (s_gcd); #endif return SCM_MAKINUM(u); } @@ -675,7 +675,8 @@ scm_ash(n, cnt) cnt = SCM_INUM(cnt); if (cnt < 0) return SCM_MAKINUM(SCM_SRS(res, -cnt)); res = SCM_MAKINUM(res<<cnt); - if (SCM_INUM(res)>>cnt != SCM_INUM(n)) scm_wta(n, (char *)SCM_OVFLOW, s_ash); + if (SCM_INUM(res)>>cnt != SCM_INUM(n)) + SCM_NUM_OVERFLOW (s_ash); return res; #endif } @@ -1674,7 +1675,8 @@ scm_istr2int(str, len, radix) ds[k++] = SCM_BIGLO(t2); t2 = SCM_BIGDN(t2); } - SCM_ASSERT(blen <= j, (SCM)SCM_MAKINUM(blen), SCM_OVFLOW, "bignum"); + if (blen > j) + SCM_NUM_OVERFLOW ("bignum"); if (t2) {blen++; goto moretodo;} break; default: @@ -2808,7 +2810,7 @@ scm_sum(x, y) # ifdef SCM_FLOATS return scm_makdbl((double)x, 0.0); # else - scm_wta(y, (char *)SCM_OVFLOW, s_sum); + SCM_NUM_OVERFLOW (s_sum); return SCM_UNSPECIFIED; # endif #endif @@ -2951,7 +2953,7 @@ scm_difference(x, y) # ifdef SCM_FLOATS return scm_makdbl((double)x, 0.0); # else - scm_wta(y, (char *)SCM_OVFLOW, s_difference); + SCM_NUM_OVERFLOW (s_difference); return SCM_UNSPECIFIED; # endif #endif @@ -3105,7 +3107,7 @@ scm_product(x, y) # ifdef SCM_FLOATS return scm_makdbl(((double)i)*((double)j), 0.0); # else - scm_wta(y, (char *)SCM_OVFLOW, s_product); + SCM_NUM_OVERFLOW (s_product); # endif #endif return y; @@ -3183,7 +3185,10 @@ scm_divide(x, y) SCM z; if SCM_INUMP(y) { z = SCM_INUM(y); - SCM_ASSERT(z, y, SCM_OVFLOW, s_divide); +#ifndef RECKLESS + if (!z) + SCM_NUM_OVERFLOW (s_divide); +#endif if (1==z) return x; if (z < 0) z = -z; if (z < SCM_BIGRAD) { @@ -3323,7 +3328,7 @@ scm_divide(x, y) #ifdef SCM_FLOATS ov: return scm_makdbl(((double)SCM_INUM(x))/((double)SCM_INUM(y)), 0.0); #else - ov: scm_wta(x, (char *)SCM_OVFLOW, s_divide); + ov: SCM_NUM_OVERFLOW (s_divide); return SCM_UNSPECIFIED; #endif } @@ -3768,7 +3773,10 @@ scm_dbl2big(d) u -= c; digits[i] = c; } - SCM_ASSERT(0==u, SCM_INUM0, SCM_OVFLOW, "dbl2big"); +#ifndef RECKLESS + if (u != 0) + SCM_NUM_OVERFLOW ("dbl2big"); +#endif return ans; } |