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
|