summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog10
-rw-r--r--libguile/backtrace.c3
-rw-r--r--libguile/error.c27
-rw-r--r--libguile/error.h2
4 files changed, 40 insertions, 2 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index dcc9b54f2..ea5359212 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,13 @@
+Thu Mar 13 00:12:35 1997 Gary Houston <ghouston@actrix.gen.nz>
+
+ * backtrace.c (scm_display_error_message): don't segv if message
+ is an immediate.
+
+ * error.h: prototype for scm_error_scm.
+
+ * error.c (scm_error_scm): new procedure, reimplements scm-error
+ in C and uses scm_error.
+
Tue Mar 11 03:51:00 1997 Gary Houston <ghouston@actrix.gen.nz>
* read.c (scm_read_hash_extend): make scm_read_hash_procedures a
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 6451775d4..d07d7e85d 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -99,7 +99,8 @@ scm_display_error_message (message, args, port)
char *start;
char *p;
- if (!SCM_STRINGP (message) || SCM_IMP (args) || !scm_list_p (args))
+ if (SCM_IMP (message) || !SCM_STRINGP (message) || SCM_IMP (args)
+ || !scm_list_p (args))
{
scm_prin1 (message, port, 0);
scm_gen_putc ('\n', port);
diff --git a/libguile/error.c b/libguile/error.c
index 3facf167d..cab5c0d28 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -124,7 +124,7 @@ scm_perror (arg)
void (*scm_error_callback) () = 0;
-/* all errors thrown from C should pass through here. */
+/* All errors should pass through here. */
void
scm_error (key, subr, message, args, rest)
SCM key;
@@ -150,6 +150,31 @@ scm_error (key, subr, message, args, rest)
exit (1);
}
+/* Scheme interface to scm_error. */
+SCM_PROC(s_error_scm, "scm-error", 5, 0, 0, scm_error_scm);
+SCM
+scm_error_scm (key, subr, message, args, rest)
+ SCM key;
+ SCM subr;
+ SCM message;
+ SCM args;
+ SCM rest;
+{
+ SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, s_error_scm);
+ SCM_ASSERT (SCM_FALSEP (subr) || (SCM_NIMP (subr) && SCM_ROSTRINGP (subr)),
+ subr, SCM_ARG2, s_error_scm);
+ SCM_ASSERT (SCM_FALSEP (message)
+ || (SCM_NIMP (message) && SCM_ROSTRINGP (message)),
+ message, SCM_ARG3, s_error_scm);
+
+ scm_error (key,
+ (SCM_FALSEP (subr)) ? NULL : SCM_ROCHARS (subr),
+ (SCM_FALSEP (message)) ? NULL : SCM_ROCHARS (message),
+ args,
+ rest);
+ /* not reached. */
+}
+
SCM_SYMBOL (scm_system_error_key, "system-error");
void
scm_syserror (subr)
diff --git a/libguile/error.h b/libguile/error.h
index f71019bb1..c8c12c88b 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -66,6 +66,8 @@ extern void scm_error SCM_P ((SCM key, char *subr, char *message,
SCM args, SCM rest)) SCM_NORETURN;
extern void (*scm_error_callback) SCM_P ((SCM key, char *subr,
char *message, SCM args, SCM rest));
+extern SCM scm_error_scm SCM_P ((SCM key, SCM subr, SCM message,
+ SCM args, SCM rest)) SCM_NORETURN;
extern void scm_syserror SCM_P ((char *subr)) SCM_NORETURN;
extern void scm_syserror_msg SCM_P ((char *subr, char *message, SCM args,
int eno)) SCM_NORETURN;