Fix #!- vs #- confusion in number's singleton-p type method

[sbcl.git] / src / code / save.lisp

diff --git a/src/code/save.lisp b/src/code/save.lisp
index c7b5b6d..c3ebfb9 100644 (file)
--- 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,28 @@ sufficiently motivated to do lengthy fixes."
   (labels ((restart-lisp ()
              (handling-end-of-the-world
                (reinit)
+               #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub)
                (funcall toplevel)))
            (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
@@ -156,7 +160,11 @@ sufficiently motivated to do lengthy fixes."
            ;; Compact the environment even though we're skipping the
            ;; other purification stages.
            (sb!kernel::compact-environment-aux "Auxiliary" 200)
-           (save-core t)))))
+           (save-core t)))
+    ;; Something went very wrong -- reinitialize to have a prayer
+    ;; of being able to report the error.
+    (reinit)
+    (error "Could not save core.")))
 
 (defun deinit ()
   (call-hooks "save" *save-hooks*)
@@ -167,4 +175,5 @@ sufficiently motivated to do lengthy fixes."
   (debug-deinit)
   (foreign-deinit)
   (stream-deinit)
-  (deinit-finalizers))
+  (deinit-finalizers)
+  (drop-all-hash-caches))