[Sbcl-commits] CVS: sbcl/src/code save.lisp, 1.42, 1.43 toplevel.lisp, 1.103, 1.104

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8626/src/code

Modified Files:
	save.lisp toplevel.lisp 
Log Message:
1.0.28.43: QUIT related work

 * SAVE-LISP-AND-DIE :TOPLEVEL can return, just call QUIT if it does.

 * --script should not override QUIT called by user with its own exit status.
   (reported by Hubert Kauker)


Index: save.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/save.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- save.lisp	4 Jan 2009 07:35:53 -0000	1.42
+++ save.lisp	12 May 2009 11:00:14 -0000	1.43
@@ -49,8 +49,8 @@
   :TOPLEVEL
      The function to run when the created core file is resumed. The
      default function handles command line toplevel option processing
-     and runs the top level read-eval-print loop. This function should
-     not return.
+     and runs the top level read-eval-print loop. This function returning
+     is equivalent to (SB-EXT:QUIT :UNIX-STATUS 0) being called.
 
   :EXECUTABLE
      If true, arrange to combine the SBCL runtime and the core image
@@ -126,7 +126,9 @@
              (handling-end-of-the-world
                (reinit)
                #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub)
-               (funcall toplevel)))
+               (progn
+                 (funcall toplevel)
+                 (sb!ext:quit))))
            (foreign-bool (value)
              (if value 1 0))
            (save-core (gc)

Index: toplevel.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/toplevel.lisp,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -d -r1.103 -r1.104
--- toplevel.lisp	22 Apr 2009 18:51:21 -0000	1.103
+++ toplevel.lisp	12 May 2009 11:00:14 -0000	1.104
@@ -398,14 +398,12 @@
     t))
 
 (defun process-script (script)
-  (let ((pathname (native-pathname script))
-        (ok nil))
-    (unwind-protect
-         (with-open-file (f pathname :element-type :default)
-           (maybe-skip-shebang-line f)
-           (load f :verbose nil :print nil)
-           (setf ok t))
-      (quit :unix-status (if ok 0 1)))))
+  (let ((pathname (native-pathname script)))
+    (handling-end-of-the-world
+      (with-open-file (f pathname :element-type :default)
+        (maybe-skip-shebang-line f)
+        (load f :verbose nil :print nil)
+        (quit)))))
 
 ;; Errors while processing the command line cause the system to QUIT,
 ;; instead of trying to go into the Lisp debugger, because trying to