X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=ceffe0b15219858fc45be43e1abcfa64e684be9f;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=4d3e40e32cbd884929d09de5348d180f0c7b82c5;hpb=40a26a4dd7f2891e78421ba465b99bb67f892856;p=sbcl.git

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 4d3e40e..ceffe0b 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -11,6 +11,16 @@
 
 (in-package "SB!UNIX")
 
+(defun invoke-interruption (function)
+  (without-interrupts
+    (sb!unix::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)
@@ -57,17 +67,21 @@
 (defun enable-interrupt (signal handler)
   (declare (type (or function fixnum (member :default :ignore)) handler))
   (/show0 "enable-interrupt")
-  (without-gcing
-   (let ((result (install-handler signal
-                                  (case handler
-                                    (:default sig_dfl)
-                                    (:ignore sig_ign)
-                                    (t
-                                     (sb!kernel:get-lisp-obj-address
-                                      handler))))))
-     (cond ((= result sig_dfl) :default)
-           ((= result sig_ign) :ignore)
-           (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
+  (flet ((run-handler (&rest args)
+           (in-interruption ()
+             (apply handler args))))
+    (without-gcing
+      (let ((result (install-handler signal
+                                     (case handler
+                                       (:default sig_dfl)
+                                       (:ignore sig_ign)
+                                       (t
+                                        (sb!kernel:get-lisp-obj-address
+                                         #'run-handler))))))
+        (cond ((= result sig_dfl) :default)
+              ((= result sig_ign) :ignore)
+              (t (the (or function fixnum)
+                   (sb!kernel:make-lisp-obj result))))))))
 
 (defun default-interrupt (signal)
   (enable-interrupt signal :default))
@@ -84,15 +98,9 @@
 ;;; 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)
-  #!+sb-thread
-  (let ((foreground-thread (sb!thread::foreground-thread)))
-    (if (eq foreground-thread sb!thread:*current-thread*)
-        (apply #'%break 'sigint format-string format-arguments)
-        (sb!thread:interrupt-thread
-         foreground-thread
-         (lambda () (apply #'%break 'sigint format-string format-arguments)))))
-  #!-sb-thread
-  (apply #'%break 'sigint format-string 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
@@ -101,37 +109,43 @@
     `(defun ,name (signal info context)
        (declare (ignore signal info))
        (declare (type system-area-pointer context))
-       (/show "in Lisp-level signal handler" ,(symbol-name name) (sap-int context))
-       (,function ,(concatenate 'simple-string what " at #X~X")
-                  (with-alien ((context (* os-context-t) context))
-                    (sap-int (sb!vm:context-pc context)))))))
+       (/show "in Lisp-level signal handler" ,(symbol-name name)
+              (sap-int context))
+       (with-interrupts
+         (,function ,(concatenate 'simple-string what " at #X~X")
+                    (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")
 (define-signal-handler sigtrap-handler "breakpoint/trap")
-(define-signal-handler sigiot-handler "SIGIOT")
 #!-linux
 (define-signal-handler sigemt-handler "SIGEMT")
 (define-signal-handler sigbus-handler "bus error")
 (define-signal-handler sigsegv-handler "segmentation violation")
 #!-linux
 (define-signal-handler sigsys-handler "bad argument to a system call")
-(define-signal-handler sigpipe-handler "SIGPIPE")
 
 (defun sigalrm-handler (signal info context)
   (declare (ignore signal info context))
   (declare (type system-area-pointer context))
   (sb!impl::run-expired-timers))
 
-(defun sigquit-handler (signal code context)
+(defun sigterm-handler (signal code context)
   (declare (ignore signal code context))
-  (throw 'toplevel-catcher nil))
+  (sb!thread::terminate-session)
+  (sb!ext:quit))
+
+;; Also known as SIGABRT.
+(defun sigiot-handler (signal code context)
+  (declare (ignore signal code context))
+  (sb!impl::%halt))
 
 (defun sb!kernel:signal-cold-init-or-reinit ()
   #!+sb-doc
   "Enable all the default signals that Lisp knows how to deal with."
   (enable-interrupt sigint #'sigint-handler)
-  (enable-interrupt sigquit #'sigquit-handler)
+  (enable-interrupt sigterm #'sigterm-handler)
   (enable-interrupt sigill #'sigill-handler)
   (enable-interrupt sigtrap #'sigtrap-handler)
   (enable-interrupt sigiot #'sigiot-handler)
@@ -142,13 +156,17 @@
   (enable-interrupt sigsegv #'sigsegv-handler)
   #!-linux
   (enable-interrupt sigsys #'sigsys-handler)
-  (enable-interrupt sigpipe #'sigpipe-handler)
+  (ignore-interrupt sigpipe)
   (enable-interrupt sigalrm #'sigalrm-handler)
   (sb!unix::reset-signal-mask)
   (values))
 
 ;;;; etc.
 
+;;; extract si_code from siginfo_t
+(sb!alien:define-alien-routine ("siginfo_code" siginfo-code) sb!alien:int
+  (info system-area-pointer))
+
 ;;; CMU CL comment:
 ;;;   Magically converted by the compiler into a break instruction.
 (defun receive-pending-interrupt ()