1.0.4.59: small signal handling improvements

 * Grovel SIG_DFL and SIG_IGN.

 * Grovel "rare" signals based on the definedness of the signal, not
   LISP_FEATURE_FOO.

 * Make SIGINT signal an INTERACTIVE-INTERRUPT, which should make
   sense on Windows too, if we ever get the ConsoleCtrlHandler
   working.

 * Make SIGTRAP signal an BREAKPOINT-ERROR, and make SYSTEM-CONDITION
   a superclass of both it, INTERACTIVE-INTERRUPT and
   MEMORY-FAULT-ERROR.

 * Inhibit GC while destroying the thread mutex lutex to avoid races
   with the GC.

 ...and add missing NEWS entries due to your truly.

diff --git a/NEWS b/NEWS
index 3934ce2..c81c7ff 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -19,7 +19,15 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4:
   * optimization: Direct calls to CHAR-{EQUAL,LESSP,GREATERP} and
     their NOT- variants no longer cons.
   * enhancement: XREF information is now collected to references made
-    to global variables using SYMBOL-VALUE with a constant argument.
+    to global variables using SYMBOL-VALUE and a constant argument.
+  * enhancement: SIGINT now causes a specific condition
+    SB-SYS:INTERACTIVE-INTERRUPT to be signalled.
+  * bug fix: bad type declaration in the CLOS implementation has
+    been fixed. (reported by James Anderson)
+  * bug fix: incorrect ROOM reporting on x86-64 has been fixed.
+    (thanks to Lutz Euler)
+  * bug fix: DEFSETF now allows &ENVIRONMENT and disallows &AUX as
+    required by the CLHS. (reported by Samium Gromoff)
   * bug fix: dead unbound variable references now signal an error.
     (reported by Marco Monteiro)
   * bug fix: / with an unused value was being deleted in safe code.
@@ -28,7 +36,8 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4:
     line in a file is unlimited.
   * bug fix: some GC deadlocks caused by asynchronous interrupts have
     been fixed by inhibiting interrupts for when GC is disbled.
-  * bug fix: GETHASH, PUTHASH, CLRHASH and REMHASH are now interrupt safe.
+  * bug fix: GETHASH, (SETF GETHASH), CLRHASH and REMHASH are now
+    interrupt safe.
   * bug fix: binding *BREAK-ON-SIGNALS* to a value that is not a type
     specifier no longer causes infinite recursion.
   * improvement: the x86-64/darwin port now passes all tests and

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 19e7f4e..8902474 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1945,7 +1945,9 @@ SB-KERNEL) have been undone, but probably more remain."
                "ADD-FD-HANDLER"
                "ALLOCATE-SYSTEM-MEMORY"
                "BEEP" "BITS"
-               "BYTES" "C-PROCEDURE"
+               "BYTES"
+               "BREAKPOINT-ERROR"
+               "C-PROCEDURE"
                "CLOSE-SHARED-OBJECTS"
                "COMPILER-VERSION"
                "DEALLOCATE-SYSTEM-MEMORY"
@@ -1968,12 +1970,15 @@ SB-KERNEL) have been undone, but probably more remain."
                "GET-PAGE-SIZE" "GET-SYSTEM-INFO"
                "IGNORE-INTERRUPT"
                "IN-INTERRUPTION"
+               "INTERACTIVE-INTERRUPT"
                "INT-SAP"
                "INVALIDATE-DESCRIPTOR"
                "INVOKE-INTERRUPTION"
                "IO-TIMEOUT"
                "LIST-DYNAMIC-FOREIGN-SYMBOLS"
-               "MACRO" "MAKE-FD-STREAM" "MAKE-OBJECT-SET" "MEMMOVE"
+               "MACRO" "MAKE-FD-STREAM" "MAKE-OBJECT-SET"
+               "MEMORY-FAULT-ERROR"
+               "MEMMOVE"
                "NATURALIZE-BOOLEAN" "NATURALIZE-INTEGER"
                "OBJECT-SET-OPERATION"
                "OS-COLD-INIT-OR-REINIT" "OS-CONTEXT-T" "OUTPUT-RAW-BYTES"
@@ -1998,6 +2003,8 @@ SB-KERNEL) have been undone, but probably more remain."
                ;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL.
                "STRUCTURE!OBJECT" "STRUCTURE!OBJECT-MAKE-LOAD-FORM"
                "SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P"
+               "SYSTEM-CONDITION" "SYSTEM-CONDIION-ADDRESS"
+               "SYSTEM-CONDITION-CONTEXT"
                "REINIT-INTERNAL-REAL-TIME"
                "SYSTEM-INTERNAL-RUN-TIME"
                "UNDEFINED-FOREIGN-SYMBOLS-P"

diff --git a/src/code/error.lisp b/src/code/error.lisp
index 1cf2c8e..a7b2f9a 100644 (file)
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -165,8 +165,24 @@
                  *heap-exhausted-error-requested-bytes*)
          (print-unreadable-object (condition stream))))))
 
-(define-condition memory-fault-error (error)
-  ((address :initarg :address :reader memory-fault-error-address))
+(define-condition system-condition (condition)
+  ((address :initarg :address :reader system-condition-address :initform nil)
+   (context :initarg :context :reader system-condition-context :initform nil)))
+
+(define-condition memory-fault-error (system-condition error) ()
+  (:report
+   (lambda (condition stream)
+     (format stream "Unhandled memory fault at #x~X."
+             (system-condition-address condition)))))
+
+(define-condition breakpoint-error (system-condition error) ()
+  (:report
+   (lambda (condition stream)
+     (format stream "Uhandled breakpoint/trap at #x~X."
+             (system-condition-address condition)))))
+
+(define-condition interactive-interrupt (system-condition serious-condition) ()
   (:report
    (lambda (condition stream)
-     (format stream "Memory fault in address #x~X" (memory-fault-error-address condition)))))
+     (format stream "Interactive interrupt at #x~X."
+             (system-condition-address condition)))))

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index b441516..8fb704a 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -490,5 +490,6 @@
   (declare (type system-area-pointer context-sap))
   (infinite-error-protect
    (let ((context (sap-alien context-sap (* os-context-t))))
-     (error "Unhandled breakpoint/trap at #x~X."
-            (sap-int (sb!vm:context-pc context))))))
+     (error 'breakpoint-error
+            :context context
+            :address (sap-int (sb!vm:context-pc context))))))

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index c3b6644..7125c73 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -13,17 +13,28 @@
 
 (defun invoke-interruption (function)
   (without-interrupts
-    (sb!unix::reset-signal-mask)
+    ;; FIXME: This is wrong. Imagine the following sequence:
+    ;;
+    ;; 1. an asynch interrupt arrives after entry to
+    ;;    WITHOUT-INTERRUPTS but before RESET-SIGNAL-MASK: pending
+    ;;    machinery blocks all signals and marks the signal as
+    ;;    pending.
+    ;;
+    ;; 2. RESET-SIGNAL-MASK is called, and all signals are unblocked.
+    ;;
+    ;; 3. Another signal arrives while we already have one pending.
+    ;;    Oops -- we lose().
+    ;;
+    ;; Not sure what the right thing is, but definitely not
+    ;; RESET-SIGNAL-MASK. Removing it breaks signals.impure.lisp
+    ;; right now, though, and this is a rare race, so...
+    (reset-signal-mask)
     (funcall function)))
 
 (defmacro in-interruption ((&rest args) &body body)
   #!+sb-doc
   "Convenience macro on top of INVOKE-INTERRUPTION."
   `(invoke-interruption (lambda () ,@body) ,@args))
-
-;;; These should probably be somewhere, but I don't know where.
-(defconstant sig_dfl 0)
-(defconstant sig_ign 1)
 \f
 ;;;; system calls that deal with signals
 
@@ -73,13 +84,13 @@
     (without-gcing
       (let ((result (install-handler signal
                                      (case handler
-                                       (:default sig_dfl)
-                                       (:ignore sig_ign)
+                                       (:default sig-dfl)
+                                       (:ignore sig-ign)
                                        (t
                                         (sb!kernel:get-lisp-obj-address
                                          #'run-handler))))))
-        (cond ((= result sig_dfl) :default)
-              ((= result sig_ign) :ignore)
+        (cond ((= result sig-dfl) :default)
+              ((= result sig-ign) :ignore)
               (t (the (or function fixnum)
                    (sb!kernel:make-lisp-obj result))))))))
 
@@ -97,15 +108,8 @@
 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
-(defun sigint-%break (format-string &rest format-arguments)
-  (flet ((break-it ()
-           (apply #'%break 'sigint format-string format-arguments)))
-    (sb!thread:interrupt-thread (sb!thread::foreground-thread) #'break-it)))
-
 (eval-when (:compile-toplevel :execute)
-  (sb!xc:defmacro define-signal-handler (name
-                                         what
-                                         &optional (function 'error))
+  (sb!xc:defmacro define-signal-handler (name what &optional (function 'error))
     `(defun ,name (signal info context)
        (declare (ignore signal info))
        (declare (type system-area-pointer context))
@@ -116,7 +120,6 @@
                     (with-alien ((context (* os-context-t) context))
                       (sap-int (sb!vm:context-pc context))))))))
 
-(define-signal-handler sigint-handler "interrupted" sigint-%break)
 (define-signal-handler sigill-handler "illegal instruction")
 #!-linux
 (define-signal-handler sigemt-handler "SIGEMT")
@@ -125,6 +128,18 @@
 #!-linux
 (define-signal-handler sigsys-handler "bad argument to a system call")
 
+(defun sigint-handler (signal info context)
+  (declare (ignore signal info))
+  (declare (type system-area-pointer context))
+  (/show "in Lisp-level SIGINT handler" (sap-int context))
+  (flet ((interrupt-it ()
+           (with-alien ((context (* os-context-t) context))
+             (%break 'sigint 'interactive-interrupt
+                     :context context
+                     :address (sap-int (sb!vm:context-pc context))))))
+    (sb!thread:interrupt-thread (sb!thread::foreground-thread)
+                                #'interrupt-it)))
+
 (defun sigalrm-handler (signal info context)
   (declare (ignore signal info context))
   (declare (type system-area-pointer context))

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 37d95c7..be8eeb4 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -499,7 +499,7 @@ this semaphore, then N of them is woken up."
     (when *session*
       (%delete-thread-from-session thread *session*)))
   #!+sb-lutex
-  (when (thread-interruptions-lock thread)
+  (without-gcing
     (/show0 "FREEING MUTEX LUTEX")
     (with-lutex-address (lutex (mutex-lutex (thread-interruptions-lock thread)))
       (%lutex-destroy lutex))))

diff --git a/src/runtime/pthread-lutex.c b/src/runtime/pthread-lutex.c
index 2da0291..1f2f414 100644 (file)
--- a/src/runtime/pthread-lutex.c
+++ b/src/runtime/pthread-lutex.c
@@ -138,7 +138,11 @@ lutex_lock (tagged_lutex_t tagged_lutex)
     struct lutex *lutex = (struct lutex*) native_pointer(tagged_lutex);
 
     ret = thread_mutex_lock(lutex->mutex);
-    /* The mutex is locked by the same thread. */
+    /* The mutex is locked by the same thread.
+     *
+     * FIXME: Usually when POSIX says that "an error value is returned"
+     * it actually refers to errno...
+     */
     if (ret == EDEADLK)
         return ret;
     lutex_assert(ret == 0);

diff --git a/tools-for-build/grovel-headers.c b/tools-for-build/grovel-headers.c
index 9b16e06..554ff33 100644 (file)
--- a/tools-for-build/grovel-headers.c
+++ b/tools-for-build/grovel-headers.c
@@ -336,6 +336,9 @@ main(int argc, char *argv[])
     printf("\n");
 
     printf(";;; signals\n");
+    defconstant("sig-dfl", SIG_DFL);
+    defconstant("sig-ign", SIG_IGN);
+
     defsignal("sigalrm", SIGALRM);
     defsignal("sigbus", SIGBUS);
     defsignal("sigchld", SIGCHLD);
@@ -354,11 +357,11 @@ main(int argc, char *argv[])
     defsignal("sigprof", SIGPROF);
     defsignal("sigquit", SIGQUIT);
     defsignal("sigsegv", SIGSEGV);
-#if ((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86))
+#ifdef SIGSTKFLT
     defsignal("sigstkflt", SIGSTKFLT);
 #endif
     defsignal("sigstop", SIGSTOP);
-#if (!((defined LISP_FEATURE_LINUX) && (defined LISP_FEATURE_X86)))
+#ifdef SIGSYS
     defsignal("sigsys", SIGSYS);
 #endif
     defsignal("sigterm", SIGTERM);
@@ -370,12 +373,14 @@ main(int argc, char *argv[])
     defsignal("sigusr1", SIGUSR1);
     defsignal("sigusr2", SIGUSR2);
     defsignal("sigvtalrm", SIGVTALRM);
-#ifdef LISP_FEATURE_SUNOS
+#ifdef SIGWAITING
     defsignal("sigwaiting", SIGWAITING);
 #endif
     defsignal("sigwinch", SIGWINCH);
-#ifndef LISP_FEATURE_HPUX
+#ifndef SIGXCPU
     defsignal("sigxcpu", SIGXCPU);
+#endif
+#ifdef SIGXFSZ
     defsignal("sigxfsz", SIGXFSZ);
 #endif
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 5eac1b3..2c7aad3 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.4.58"
+"1.0.4.59"