* 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.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index ce628f5..d362e72 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,12 @@
+Sat Sep 14 03:41:15 1996  Gary Houston  <ghouston@actrix.gen.nz>
+
+       * 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  <mdj@woody.nada.kth.se>
 
        * boot-9.scm: Name change: value-ref --> local-ref

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index dcf0489..a2e569b 100644 (file)
--- 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))
-
-
-\f
-(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)))))
 
 \f
 (define (getgrnam name) (getgr name))

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index fa92cd2..91da62b 100644 (file)
--- 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 2d11ff5..4af8303 100644 (file)
--- 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 440b91a..d975da9 100644 (file)
--- 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 816d4f7..046a38f 100644 (file)
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -47,7 +47,8 @@
 
 \f
 extern int scm_ints_disabled;
-extern SCM system_error_sym;
+extern SCM scm_system_error;
+extern SCM scm_num_overflow;
 
 \f
 

diff --git a/libguile/fports.c b/libguile/fports.c
index a5b30a1..c3a1eb4 100644 (file)
--- 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 30b99c0..070f529 100644 (file)
--- 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;
 }