In the mips sigtrap hander, and for the case of a break instruction in a

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

diff --git a/src/code/save.lisp b/src/code/save.lisp
index 1d3b3fa..defb53a 100644 (file)
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -27,10 +27,10 @@
 ;;; image to make a running Lisp, the memory never gets reclaimed.
 ;;; (But with the PURIFY option it seems to work OK.)
 (defun save-lisp-and-die (core-file-name &key
 ;;; image to make a running Lisp, the memory never gets reclaimed.
 ;;; (But with the PURIFY option it seems to work OK.)
 (defun save-lisp-and-die (core-file-name &key

-                                        (toplevel #'toplevel-init)
-                                        (purify t)
-                                        (root-structures ())
-                                        (environment-name "auxiliary"))
+                                         (toplevel #'toplevel-init)
+                                         (purify t)
+                                         (root-structures ())
+                                         (environment-name "auxiliary"))

   #!+sb-doc
   "Save a \"core image\", i.e. enough information to restart a Lisp
 process later in the same state, in the file of the specified name.
   #!+sb-doc
   "Save a \"core image\", i.e. enough information to restart a Lisp
 process later in the same state, in the file of the specified name.

@@ -77,7 +77,8 @@ automatically reloaded on startup, but references to foreign symbols
 do not survive intact on all platforms: in this case a WARNING is
 signalled when saving the core. If no warning is signalled, then the
 foreign symbol references will remain intact. Platforms where this is
 do not survive intact on all platforms: in this case a WARNING is
 signalled when saving the core. If no warning is signalled, then the
 foreign symbol references will remain intact. Platforms where this is

-currently the case are x86/FreeBSD, x86/Linux, and sparc/SunOS.
+currently the case are x86/FreeBSD, x86/Linux, x86/NetBSD,
+sparc/Linux, sparc/SunOS, and ppc/Darwin.

 
 This implementation is not as polished and painless as you might like:
   * It corrupts the current Lisp image enough that the current process
 
 This implementation is not as polished and painless as you might like:
   * It corrupts the current Lisp image enough that the current process

@@ -98,22 +99,24 @@ sufficiently motivated to do lengthy fixes."
   ;; SAVE-LISP-AND-DIE.)
   (if purify
       (purify :root-structures root-structures
   ;; SAVE-LISP-AND-DIE.)
   (if purify
       (purify :root-structures root-structures

-             :environment-name environment-name)
+              :environment-name environment-name)

       #-gencgc (gc) #+gencgc (gc :full t))
   (flet ((restart-lisp ()
            (handling-end-of-the-world
       #-gencgc (gc) #+gencgc (gc :full t))
   (flet ((restart-lisp ()
            (handling-end-of-the-world

-           (reinit)
-           (funcall toplevel))))
+             (reinit)
+             (funcall toplevel))))

     ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the
     ;; LET as well, to avoid the off chance of an interrupt triggering
     ;; GC and making our saved RESTART-LISP address invalid?
     (without-gcing
      (save (unix-namestring core-file-name nil)
     ;; FIXME: Perhaps WITHOUT-GCING should be wrapped around the
     ;; LET as well, to avoid the off chance of an interrupt triggering
     ;; GC and making our saved RESTART-LISP address invalid?
     (without-gcing
      (save (unix-namestring core-file-name nil)

-          (get-lisp-obj-address #'restart-lisp)))))
+           (get-lisp-obj-address #'restart-lisp)))))

 
 (defun deinit ()
 
 (defun deinit ()

-  (mapc #'funcall *save-hooks*)
-  (when (fboundp 'cancel-finalization)    
+  (dolist (hook *save-hooks*)
+    (with-simple-restart (continue "Skip this save hook.")
+      (funcall hook)))
+  (when (fboundp 'cancel-finalization)

     (cancel-finalization sb!sys:*tty*))
   (profile-deinit)
   (debug-deinit)
     (cancel-finalization sb!sys:*tty*))
   (profile-deinit)
   (debug-deinit)