diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index dfa7480f3..9b2d8b65e 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -4,9 +4,7 @@ Sun Mar 2 05:25:11 1997 Gary Houston return the quit args. (scm-style-repl): call -quit, passing return value from error-catching-repl. Make -quit return its args. - stand-along-repl: comment out, since it seems unused. - (top-repl): convert the value returned by scm-style-repl to - an integer and return it. + stand-alone-repl: comment out, since it seems unused. (error-catching-loop thunk): discard trailing junk after a (quit). diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 607db72c4..f413fc9ba 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2455,15 +2455,7 @@ ;; (set-current-error-port errp) (define (top-repl) - ;; scm-style-repl returns the list of arguments from quit: convert to - ;; an integer status and return. - (let ((quit-args (scm-style-repl))) - (if (null? quit-args) - 0 - (let ((cqa (car quit-args))) - (cond ((number? cqa) cqa) - ((eq? cqa #f) 1) - (else 0)))))) + (scm-style-repl)) (defmacro false-if-exception (expr) `(catch #t (lambda () ,expr) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 3481d913b..e9dcce20a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +Sun Mar 2 06:37:31 1997 Gary Houston + + * throw.h: prototype for scm_exit_status. + * throw.c (scm_handle_by_message): if a 'quit is caught, use its + args to derive an exit status. Allows (quit) to work from a + script. + (scm_exit_status): new function. + #include "eq.h". + Sat Mar 1 00:09:15 1997 Mikael Djurfeldt * eval.c (scm_deval): Removed some old code. diff --git a/libguile/throw.c b/libguile/throw.c index b3997b8af..2bebb32e7 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -46,6 +46,7 @@ #include "smob.h" #include "alist.h" #include "eval.h" +#include "eq.h" #include "dynwind.h" #include "backtrace.h" #ifdef DEBUG_EXTENSIONS @@ -448,6 +449,9 @@ scm_handle_by_message (handler_data, tag, args) char *prog_name = (char *) handler_data; SCM p = scm_def_errp; + if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit"))))) + exit (scm_exit_status (args)); + if (! prog_name) prog_name = "guile"; @@ -473,6 +477,23 @@ scm_handle_by_message (handler_data, tag, args) exit (2); } +/* Derive the an exit status from the arguments to (quit ...). */ +int +scm_exit_status (args) + SCM args; +{ + if (SCM_NNULLP (args)) + { + SCM cqa = SCM_CAR (args); + + if (SCM_INUMP (cqa)) + return (SCM_INUM (cqa)); + else if (SCM_FALSEP (cqa)) + return 1; + } + return 0; +} + SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw); SCM diff --git a/libguile/throw.h b/libguile/throw.h index be971a576..99d8ff692 100644 --- a/libguile/throw.h +++ b/libguile/throw.h @@ -83,10 +83,12 @@ extern SCM scm_body_thunk SCM_P ((void *, SCM)); extern SCM scm_handle_by_proc SCM_P ((void *, SCM, SCM)); extern SCM scm_handle_by_message SCM_P ((void *, SCM, SCM)); +extern int scm_exit_status SCM_P ((SCM args)); extern SCM scm_catch SCM_P ((SCM tag, SCM thunk, SCM handler)); extern SCM scm_lazy_catch SCM_P ((SCM tag, SCM thunk, SCM handler)); extern SCM scm_ithrow SCM_P ((SCM key, SCM args, int noreturn)); + extern SCM scm_throw SCM_P ((SCM key, SCM args)); extern void scm_init_throw SCM_P ((void)); #endif /* THROWH */