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:
 ;;;; -*- 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
   * 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
 @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
 @end menu
 
 @node Starting SBCL

@@ -14,9 +15,9 @@
 @section Starting SBCL
 
 @menu
 @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
 @end menu
 
 @node Running from Shell

@@ -77,9 +78,9 @@ an example.)
 @section Stopping SBCL
 
 @menu
 @section Stopping SBCL
 
 @menu

-* Quit::                        
+* Quit::

 * End of File::
 * End of File::

-* Saving a Core Image::              
+* Saving a Core Image::

 * Exit on Errors::
 @end menu
 
 * 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
 
 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 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
 
 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 system or the Lisp system.
 
 @menu

-* Runtime Options::             
-* Toplevel Options::            
+* Runtime Options::
+* Toplevel Options::

 @end menu
 
 @node Runtime 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
 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
 @end menu
 
 @node System Initialization File

@@ -302,8 +304,8 @@ Some examples of what you may consider doing in the initialization
 files follow.
 
 @menu
 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
 @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.
 @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
                    (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
                                        (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
             (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)
 
 @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).
                                  (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
          (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
                "*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.
 
                ;; 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"
 
                ;; 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"
                ;; 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
 
 (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))
   (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)
   (/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))
   ;; 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
 \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)
            ;; 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)
 
 ;;; 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))
   (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 ()
            (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)
   (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.")
 
 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))
 \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")
   (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)
       (/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".)
 ;;; 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"