mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* throw.h: prototype for scm_exit_status.

Browse source 
* 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".
This commit is contained in:
Gary Houston 1997-03-02 07:32:19 +00:00
parent 8e44e7a0c7
commit 1a36eef2ea
5 changed files with 34 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

4
ice-9/ChangeLog
View file

@ -4,9 +4,7 @@ Sun Mar 2 05:25:11 1997 Gary Houston <ghouston@actrix.gen.nz>
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).

10
ice-9/boot-9.scm
View file

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

9
libguile/ChangeLog
View file

@ -1,3 +1,12 @@
Sun Mar 2 06:37:31 1997 Gary Houston <ghouston@actrix.gen.nz>
* 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 <mdj@mdj.nada.kth.se>
* eval.c (scm_deval): Removed some old code.

21
libguile/throw.c
View file

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

2
libguile/throw.h
View file

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