mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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

10
libguile/ChangeLog
View file

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

3
libguile/backtrace.c
View file

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

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)

2
libguile/error.h
View file

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