1.0.13.20: added SB-EXT:*EXIT-HOOKS*

 * Also document *INIT-HOOKS* and *SAVE-HOOKS*.

 * Trailing whitespace cleanup in start-stop.texinfo.

diff --git a/NEWS b/NEWS
index f2af05e..574c63c 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-1.0.14 relative to sbcl-1.0.13:
+  * new feature: SB-EXT:*EXIT-HOOKS* are called when the process exits
+    (see documentation for details.)
   * Revived support for OpenBSD (contributed by Josh Elsasser)
   * bug fix: RESOLVE-CONFLICT (and the other name conflict machinery)
     is now actually exported from SB-EXT as documented.  (reported by

diff --git a/doc/manual/start-stop.texinfo b/doc/manual/start-stop.texinfo
index de0589e..77940c2 100644 (file)
--- a/doc/manual/start-stop.texinfo
+++ b/doc/manual/start-stop.texinfo
@@ -3,10 +3,11 @@
 @chapter Starting and Stopping
 
 @menu
-* Starting SBCL::               
-* Stopping SBCL::               
-* Command Line Options::        
-* Initialization Files::        
+* Starting SBCL::
+* Stopping SBCL::
+* Command Line Options::
+* Initialization Files::
+* Initialization and Exit Hooks::
 @end menu
 
 @node Starting SBCL
@@ -14,9 +15,9 @@
 @section Starting SBCL
 
 @menu
-* Running from Shell::          
-* Running from Emacs::          
-* Shebang Scripts::             
+* Running from Shell::
+* Running from Emacs::
+* Shebang Scripts::
 @end menu
 
 @node Running from Shell
@@ -77,9 +78,9 @@ an example.)
 @section Stopping SBCL
 
 @menu
-* Quit::                        
+* Quit::
 * End of File::
-* Saving a Core Image::              
+* Saving a Core Image::
 * Exit on Errors::
 @end menu
 
@@ -108,9 +109,10 @@ using SBCL as part of a shell pipeline.
 
 SBCL has the ability to save its state as a file for later
 execution. This functionality is important for its bootstrapping
-process, and is also provided as an extension to the user.  
+process, and is also provided as an extension to the user.
 
 @include fun-sb-ext-save-lisp-and-die.texinfo
+@include var-sb-ext-star-save-hooks-star.texinfo
 
 To facilitate distribution of SBCL applications using external
 resources, the filesystem location of the SBCL core file being used is
@@ -163,8 +165,8 @@ passed on to the user program even if they was intended for the
 runtime system or the Lisp system.
 
 @menu
-* Runtime Options::             
-* Toplevel Options::            
+* Runtime Options::
+* Toplevel Options::
 @end menu
 
 @node Runtime Options
@@ -260,10 +262,10 @@ This section covers initialization files processed at startup, which
 can be used to customize the lisp environment.
 
 @menu
-* System Initialization File::  
-* User Initialization File::    
-* Initialization File Semantics::  
-* Initialization Examples::     
+* System Initialization File::
+* User Initialization File::
+* Initialization File Semantics::
+* Initialization Examples::
 @end menu
 
 @node System Initialization File
@@ -302,8 +304,8 @@ Some examples of what you may consider doing in the initialization
 files follow.
 
 @menu
-* Unix-style Command Line Protocol::  
-* Automatic Recompilation of Stale Fasls::  
+* Unix-style Command Line Protocol::
+* Automatic Recompilation of Stale Fasls::
 @end menu
 
 @node Unix-style Command Line Protocol
@@ -320,7 +322,7 @@ initialization file does the trick:
 @lisp
 ;;; If the first user-processable command-line argument is a filename,
 ;;; disable the debugger, load the file handling shebang-line and quit.
-(let ((script (and (second *posix-argv*) 
+(let ((script (and (second *posix-argv*)
                    (probe-file (second *posix-argv*)))))
    (when script
       ;; Handle shebang-line
@@ -329,7 +331,7 @@ initialization file does the trick:
                                        (declare (ignore char arg))
                                        (read-line stream)))
       ;; Disable debugger
-      (setf *invoke-debugger-hook* 
+      (setf *invoke-debugger-hook*
             (lambda (condition hook)
               (declare (ignore hook))
               ;; Uncomment to get backtraces on errors
@@ -378,8 +380,8 @@ handles recompilation automatically for ASDF-based systems.
 @lisp
 (require :asdf)
 
-;;; If a fasl was stale, try to recompile and load (once). 
-(defmethod asdf:perform :around ((o asdf:load-op) 
+;;; If a fasl was stale, try to recompile and load (once).
+(defmethod asdf:perform :around ((o asdf:load-op)
                                  (c asdf:cl-source-file))
    (handler-case (call-next-method o c)
       ;; If a fasl was stale, try to recompile and load (once).
@@ -387,3 +389,13 @@ handles recompilation automatically for ASDF-based systems.
          (asdf:perform (make-instance 'asdf:compile-op) c)
          (call-next-method))))
 @end lisp
+
+@node Initialization and Exit Hooks
+@comment  node-name,  next,  previous,  up
+@section Initialization and Exit Hooks
+
+SBCL provides hooks into the system initialization and exit.
+
+@include var-sb-ext-star-init-hooks-star.texinfo
+@include var-sb-ext-star-exit-hooks-star.texinfo
+

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index e100300..a8b42e0 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -587,7 +587,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "*DEBUG-PRINT-VARIABLE-ALIST*"
 
                ;; Hooks into init & save sequences
-               "*INIT-HOOKS*" "*SAVE-HOOKS*"
+               "*INIT-HOOKS*" "*SAVE-HOOKS*" "*EXIT-HOOKS*"
 
                ;; There is no one right way to report progress on
                ;; hairy compiles.
@@ -825,6 +825,9 @@ possibly temporariliy, because it might be used internally."
                ;; name to the string if possible
                "BLOCK-GENSYM"
 
+               ;; Calling a list of hook functions, plus error handling.
+               "CALL-HOOKS"
+
                ;; Constant form evaluation
                "CONSTANT-FORM-VALUE"
                "CONSTANT-TYPEP"

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 9e3359e..f0c780a 100644 (file)
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -271,10 +271,12 @@
 
 (defun quit (&key recklessly-p (unix-status 0))
   #!+sb-doc
-  "Terminate the current Lisp. Things are cleaned up (with
-UNWIND-PROTECT and so forth) unless RECKLESSLY-P is non-NIL. On
-UNIX-like systems, UNIX-STATUS is used as the status code."
+  "Terminate the current Lisp. *EXIT-HOOKS* are pending unwind-protect
+cleanup forms are run unless RECKLESSLY-P is true. On UNIX-like
+systems, UNIX-STATUS is used as the status code."
   (declare (type (signed-byte 32) unix-status))
+  ;; FIXME: Windows is not "unix-like", but still has the same
+  ;; unix-status... maybe we should just revert to calling it :STATUS?
   (/show0 "entering QUIT")
   (if recklessly-p
       (sb!unix:unix-exit unix-status)
@@ -307,9 +309,7 @@ UNIX-like systems, UNIX-STATUS is used as the status code."
   ;; re-disable ldb again.
   (when (eq *invoke-debugger-hook* 'sb!debug::debugger-disabled-hook)
     (sb!debug::disable-debugger))
-  (dolist (hook *init-hooks*)
-    (with-simple-restart (continue "Skip this initialization hook.")
-      (funcall hook))))
+  (call-hooks "initialization" *init-hooks*))
 \f
 ;;;; some support for any hapless wretches who end up debugging cold
 ;;;; init code

diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 7ba3b3b..c4f84de 100644 (file)
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -248,11 +248,7 @@ run in any thread.")
            ;; for finalizers and after-gc hooks.
            (when (sb!thread:thread-alive-p sb!thread:*current-thread*)
              (run-pending-finalizers)
-             (dolist (hook *after-gc-hooks*)
-               (handler-case
-                   (funcall hook)
-                 (serious-condition (c)
-                   (warn "Error calling after-GC hook ~S:~% ~A" hook c)))))))))
+             (call-hooks "after-GC" *after-gc-hooks* :on-error :warn))))))
 
 ;;; This is the user-advertised garbage collection function.
 (defun gc (&key (gen 0) (full nil) &allow-other-keys)

diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index f6c5f25..1918c87 100644 (file)
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -140,3 +140,13 @@ EXPERIMENTAL: Interface subject to change."
   (def %compare-and-swap-symbol-plist (symbol) symbol-plist)
   (def %compare-and-swap-symbol-value (symbol) symbol-value)
   (def %compare-and-swap-svref (vector index) svref))
+
+(defun call-hooks (kind hooks &key (on-error :error))
+  (dolist (hook hooks)
+    (handler-case
+        (funcall hook)
+      (serious-condition (c)
+        (if (eq :warn on-error)
+            (warn "Problem running ~A hook ~S:~%  ~A" kind hook c)
+            (with-simple-restart (continue "Skip this ~A hook." kind)
+              (error "Problem running ~A hook ~S:~%  ~A" kind hook c)))))))

diff --git a/src/code/save.lisp b/src/code/save.lisp
index bb0bcc5..0373fce 100644 (file)
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -147,9 +147,7 @@ sufficiently motivated to do lengthy fixes."
            (save-core t)))))
 
 (defun deinit ()
-  (dolist (hook *save-hooks*)
-    (with-simple-restart (continue "Skip this save hook.")
-      (funcall hook)))
+  (call-hooks "save" *save-hooks*)
   (when (rest (sb!thread:list-all-threads))
     (error "Cannot save core with multiple threads running."))
   (float-deinit)

diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp
index 259f3d7..f65e25d 100644 (file)
--- a/src/code/target-extensions.lisp
+++ b/src/code/target-extensions.lisp
@@ -35,6 +35,13 @@ order when a saved core image starts up, after the system itself has
 been initialized. Unused by SBCL itself: reserved for user and
 applications.")
 
+(defvar *exit-hooks* nil
+  #!+sb-doc
+  "This is a list of functions which are called in an unspecified
+order when SBCL process exits. Unused by SBCL itself: reserved for
+user and applications. Using (QUIT :RECKLESSLY-P T), or calling
+exit(3) directly will circumvent these hooks.")
+
 \f
 ;;; Binary search for simple vectors
 (defun binary-search (value seq &key (key #'identity))

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index eddb5f8..4cc0b0c 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -76,7 +76,9 @@ command-line.")
   (with-unique-names (caught)
     `(let ((,caught (catch '%end-of-the-world
                       (/show0 "inside CATCH '%END-OF-THE-WORLD")
-                      ,@body)))
+                      (unwind-protect
+                           (progn ,@body)
+                        (call-hooks "exit" *exit-hooks*)))))
       (/show0 "back from CATCH '%END-OF-THE-WORLD, flushing output")
       (flush-standard-output-streams)
       (sb!thread::terminate-session)

diff --git a/version.lisp-expr b/version.lisp-expr
index 4825adf..78a7e73 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.13.19"
+"1.0.13.20"