* 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".

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index dfa7480..9b2d8b6 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -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).
 

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 607db72..f413fc9 100644 (file)
--- 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 3481d91..e9dcce2 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -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.

diff --git a/libguile/throw.c b/libguile/throw.c
index b3997b8..2bebb32 100644 (file)
--- 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 be971a5..99d8ff6 100644 (file)
--- 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 */