diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index ce628f5fe..d362e72a7 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,12 @@ +Sat Sep 14 03:41:15 1996 Gary Houston + + * 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. + Fri Sep 13 04:58:11 1996 Mikael Djurfeldt * boot-9.scm: Name change: value-ref --> local-ref diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index dcf048964..a2e569bfd 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -665,7 +665,7 @@ ((= n 21) (unmask-signals) (timer-thunk)) ((= n 20) (unmask-signals) (gc-thunk)) ((= n 19) (unmask-signals) (alarm-thunk)) - (else (unmask-signals) (throw '%%system-error n #f)))) + (else (unmask-signals) (throw 'system-error n #f)))) ;; The default handler for built-in error types when @@ -706,7 +706,7 @@ (display " (bad message args)" cep))) (newline cep) (force-output cep) - (apply throw 'abort key arg-list))) + (apply throw 'abort key (list (car arg-list))))) (else ;; old style errors. (let* ((desc (car arg-list)) @@ -727,27 +727,13 @@ (fixed-args (cons msg rest))) (apply error fixed-args))))) - -(set-symbol-property! '%%system-error - 'throw-handler-default - %%handle-system-error) - - -;; Install default handlers for built-in errors. -;; -(map (lambda (err) - (set-symbol-property! (cadr err) - 'throw-handler-default - %%handle-system-error)) - (cdr %%system-errors)) - - - -(begin - (define (syserror key fn err . args) - (errno err) - (apply error (cons fn args))) - (set-symbol-property! 'syserror 'throw-handler-default syserror)) +;; associate error symbols with the default handler. +(let loop ((keys '(system-error numerical-overflow))) + (cond ((not (null? keys)) + (set-symbol-property! (car keys) + 'throw-handler-default + %%handle-system-error) + (loop (cdr keys))))) (define (getgrnam name) (getgr name)) 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 + + * 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 * __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)); + lgh_error (scm_system_error, \ + _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) - */ +#define SCM_SYSERROR_M(_subr, _message, _args) \ + lgh_error (scm_system_error, \ + _subr, \ + _message, \ + _args, \ + scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED)); - /* equivalent to: - scm_throw (system_error_sym, \ - scm_listify (scm_makfrom0str (strerror (errno)), \ - scm_makfrom0str (_subr), \ - 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) arg) + /* (throw (quote system-error) arg) * * is a string or an integer (see %%system-errors). * 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 != 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; }