diff options
-rw-r--r-- | libguile/ChangeLog | 10 | ||||
-rw-r--r-- | libguile/backtrace.c | 3 | ||||
-rw-r--r-- | libguile/error.c | 27 | ||||
-rw-r--r-- | libguile/error.h | 2 |
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; |