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

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.
+	stand-alone-repl: comment out, since it seems unused.
-	(top-repl): convert the value returned by scm-style-repl to
-	an integer and return it.
 	
 	(error-catching-loop thunk): discard trailing junk after a (quit).
 

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
+  (scm-style-repl))
-  ;; 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))))))
 
 (defmacro false-if-exception (expr)
   `(catch #t (lambda () ,expr)

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.

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

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