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

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

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)))))
 
-
+;; associate error symbols with the default handler.
-(set-symbol-property! '%%system-error
+(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)))))
-
-;; 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))
 
 
 (define (getgrnam name) (getgr name))

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,

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, \
+     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) \
-  old version:
+     lgh_error (scm_system_error, \
-  #define SCM_SYSERROR(_subr) \
+		_subr, \
-	  scm_everr (SCM_UNDEFINED, SCM_EOL, SCM_UNDEFINED, \
+		_message, \
-	  strerror (errno), _subr)
+		_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, \
+     lgh_error (scm_system_error, \
-		strerror (ENOSYS), _subr)
+		_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, \
+     lgh_error (scm_system_error, \
-		"missing function", _subr)
+		_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

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"
 }
 

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;
 
 
 

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);
   }

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;
 }