From a7409fa0a69f733ea2460a1aeddbe04b5c4c0888 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 11 Apr 2007 07:30:57 +0000 Subject: [PATCH] 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. --- NEWS | 13 ++++++++-- package-data-list.lisp-expr | 11 ++++++-- src/code/error.lisp | 22 +++++++++++++--- src/code/interr.lisp | 5 ++-- src/code/target-signal.lisp | 51 ++++++++++++++++++++++++-------------- src/code/target-thread.lisp | 2 +- src/runtime/pthread-lutex.c | 6 ++++- tools-for-build/grovel-headers.c | 13 +++++++--- version.lisp-expr | 2 +- 9 files changed, 91 insertions(+), 34 deletions(-) diff --git a/NEWS b/NEWS index 3934ce2..c81c7ff 100644 --- 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 --- 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 --- 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 --- 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 --- 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) ;;;; 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4