mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

* backtrace.c (scm_display_error_message): don't segv if message

Browse source 
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.
This commit is contained in:
Gary Houston 1997-03-13 00:22:20 +00:00
parent b1d24656ea
commit c37e0e559f
4 changed files with 40 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/error.c
View file

@ -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)