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

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index c492023..4d3e40e 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -44,10 +44,11 @@
 ;;; When inappropriate build options are used, this also prints messages
 ;;; listing the signals that were masked
 (sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void)
+
 
 ;;;; C routines that actually do all the work of establishing signal handlers
 (sb!alien:define-alien-routine ("install_handler" install-handler)
-			       sb!alien:unsigned-long
+                               sb!alien:unsigned-long
   (signal sb!alien:int)
   (handler sb!alien:unsigned-long))
 
@@ -55,17 +56,18 @@
 
 (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))))))
+                                  (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)))))))
+           ((= result sig_ign) :ignore)
+           (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
 
 (defun default-interrupt (signal)
   (enable-interrupt signal :default))
@@ -82,19 +84,27 @@
 ;;; 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))
 
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro define-signal-handler (name
-					 what
-					 &optional (function 'error))
+                                         what
+                                         &optional (function 'error))
     `(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)))))))
+                  (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")
@@ -111,11 +121,11 @@
 (defun sigalrm-handler (signal info context)
   (declare (ignore signal info context))
   (declare (type system-area-pointer context))
-  (cerror "Continue" 'sb!ext::timeout))
+  (sb!impl::run-expired-timers))
 
 (defun sigquit-handler (signal code context)
   (declare (ignore signal code context))
-  (throw 'sb!impl::toplevel-catcher nil))
+  (throw 'toplevel-catcher nil))
 
 (defun sb!kernel:signal-cold-init-or-reinit ()
   #!+sb-doc
@@ -134,6 +144,7 @@
   (enable-interrupt sigsys #'sigsys-handler)
   (enable-interrupt sigpipe #'sigpipe-handler)
   (enable-interrupt sigalrm #'sigalrm-handler)
+  (sb!unix::reset-signal-mask)
   (values))
 
 ;;;; etc.
@@ -153,20 +164,20 @@
    Establish function as a handler for the Unix signal interrupt which
    should be a number between 1 and 31 inclusive."
   (let ((il (gensym))
-	(it (gensym)))
+        (it (gensym)))
     `(let ((,il NIL))
        (unwind-protect
-	   (progn
-	     ,@(do* ((item interrupt-list (cdr item))
-		     (intr (caar item) (caar item))
-		     (ifcn (cadar item) (cadar item))
-		     (forms NIL))
-		    ((null item) (nreverse forms))
-		 (when (symbolp intr)
-		   (setq intr (symbol-value intr)))
-		 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
-		       forms))
-	     ,@body)
-	 (dolist (,it (nreverse ,il))
-	   (enable-interrupt (car ,it) (cadr ,it)))))))
+           (progn
+             ,@(do* ((item interrupt-list (cdr item))
+                     (intr (caar item) (caar item))
+                     (ifcn (cadar item) (cadar item))
+                     (forms NIL))
+                    ((null item) (nreverse forms))
+                 (when (symbolp intr)
+                   (setq intr (symbol-value intr)))
+                 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
+                       forms))
+             ,@body)
+         (dolist (,it (nreverse ,il))
+           (enable-interrupt (car ,it) (cadr ,it)))))))
 |#