summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1996-09-14 07:47:50 +0000
committerGary Houston <ghouston@arglist.com>1996-09-14 07:47:50 +0000
commite1724d200d3d1c81e67c5a5b20413f4889a3acce (patch)
tree255da5d11be37884c735e0cbf6a45ca192fd1ba3 /libguile
parent7d41a049f4e82d4901fb001a6dc403354a91a0f4 (diff)
downloadguile-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/ChangeLog22
-rw-r--r--libguile/__scm.h59
-rw-r--r--libguile/error.c15
-rw-r--r--libguile/error.h3
-rw-r--r--libguile/fports.c5
-rw-r--r--libguile/numbers.c36
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;
}