X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsave.lisp;h=1ddf475c3aa6641ef54e4e8ebb044a6affd5cbe4;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=486bc97d3b03d65468967c820567f06d734a1101;hpb=b9147dff981d00779cccc6b9a00be2a388bd28a6;p=sbcl.git diff --git a/src/code/save.lisp b/src/code/save.lisp index 486bc97..1ddf475 100644 --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -49,8 +49,8 @@ The following &KEY arguments are defined: :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 @@ -95,7 +95,7 @@ The save/load process changes the values of some global variables: This is reinitialized to reflect the working directory where the saved core is loaded. -SAVE-LISP-AND-DIE interacts with SB-ALIEN:LOAD-FOREIGN-OBJECT: see its +SAVE-LISP-AND-DIE interacts with SB-ALIEN:LOAD-SHARED-OBJECT: see its documentation for details. On threaded platforms only a single thread may remain running after @@ -125,24 +125,30 @@ sufficiently motivated to do lengthy fixes." (labels ((restart-lisp () (handling-end-of-the-world (reinit) - (funcall toplevel))) + #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub) + (progn + (funcall toplevel) + (sb!ext:quit)))) (foreign-bool (value) (if value 1 0)) (save-core (gc) - (when gc - #!-gencgc (gc) - ;; Do a destructive non-conservative GC, and then save a core. - ;; A normal GC will leave huge amounts of storage unreclaimed - ;; (over 50% on x86). This needs to be done by a single function - ;; since the GC will invalidate the stack. - #!+gencgc (gc-and-save (unix-namestring core-file-name nil) - (foreign-bool executable) - (foreign-bool save-runtime-options))) - (without-gcing - (save (unix-namestring core-file-name nil) - (get-lisp-obj-address #'restart-lisp) - (foreign-bool executable) - (foreign-bool save-runtime-options))))) + (let ((name (native-namestring + (physicalize-pathname core-file-name) + :as-file t))) + (when gc + #!-gencgc (gc) + ;; Do a destructive non-conservative GC, and then save a core. + ;; A normal GC will leave huge amounts of storage unreclaimed + ;; (over 50% on x86). This needs to be done by a single function + ;; since the GC will invalidate the stack. + #!+gencgc (gc-and-save name + (foreign-bool executable) + (foreign-bool save-runtime-options))) + (without-gcing + (save name + (get-lisp-obj-address #'restart-lisp) + (foreign-bool executable) + (foreign-bool save-runtime-options)))))) ;; Save the restart function into a static symbol, to allow GC-AND-SAVE ;; access to it even after the GC has moved it. #!+gencgc