X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-signal.lisp;h=849d528a6d0bd670cdac467a8e9fe95611a4f8de;hb=913e06f191acb65c1d99d42234704bec38500ff4;hp=7320196b8814bd6aa839d544abd60ebdf8acfab2;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 7320196..849d528 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -22,11 +22,10 @@
   (pid sb!c-call:int)
   (signal sb!c-call:int))
 
+;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
+;;; should be a valid signal number or a keyword of the standard UNIX
+;;; signal name.
 (defun unix-kill (pid signal)
-  #!+sb-doc
-  "Unix-kill sends the signal signal to the process with process
-   id pid. Signal should be a valid signal number or a keyword of the
-   standard UNIX signal name."
   (real-unix-kill pid (unix-signal-number signal)))
 
 #!-sb-fluid (declaim (inline real-unix-killpg))
@@ -34,48 +33,36 @@
   (pgrp sb!c-call:int)
   (signal sb!c-call:int))
 
+;;; Send the signal SIGNAL to the all the process in process group
+;;; PGRP. SIGNAL should be a valid signal number or a keyword of the
+;;; standard UNIX signal name.
 (defun unix-killpg (pgrp signal)
-  #!+sb-doc
-  "Unix-killpg sends the signal signal to the all the process in process
-  group PGRP. Signal should be a valid signal number or a keyword of
-  the standard UNIX signal name."
   (real-unix-killpg pgrp (unix-signal-number signal)))
 
-(sb!alien:def-alien-routine ("sigblock" unix-sigblock) sb!c-call:unsigned-long
-  #!+sb-doc
-  "Unix-sigblock cause the signals specified in mask to be
-   added to the set of signals currently being blocked from
-   delivery. The macro sigmask is provided to create masks."
-  (mask sb!c-call:unsigned-long))
-
-(sb!alien:def-alien-routine ("sigpause" unix-sigpause) sb!c-call:void
-  #!+sb-doc
-  "Unix-sigpause sets the set of masked signals to its argument
-   and then waits for a signal to arrive, restoring the previous
-   mask upon its return."
-  (mask sb!c-call:unsigned-long))
-
+;;; Set the current set of masked signals (those being blocked from
+;;; delivery).
+;;;
+;;; (Note: CMU CL had a SIGMASK operator to create masks, but since
+;;; SBCL only uses 0, we no longer support it. If you need it, you
+;;; can pull it out of the CMU CL sources, or the old SBCL sources;
+;;; but you might also consider doing things the SBCL way and moving
+;;; this kind of C-level work down to C wrapper functions.)
 (sb!alien:def-alien-routine ("sigsetmask" unix-sigsetmask)
 			    sb!c-call:unsigned-long
-  #!+sb-doc
-  "Unix-sigsetmask sets the current set of masked signals (those
-   begin blocked from delivery) to the argument. The macro sigmask
-   can be used to create the mask. The previous value of the signal
-   mask is returned."
   (mask sb!c-call:unsigned-long))
 
 ;;;; C routines that actually do all the work of establishing signal handlers
 (sb!alien:def-alien-routine ("install_handler" install-handler)
-			  sb!c-call:unsigned-long
+			    sb!c-call:unsigned-long
   (signal sb!c-call:int)
   (handler sb!c-call:unsigned-long))
 
 ;;;; interface to enabling and disabling signal handlers
 
-(defun enable-interrupt (signal handler)
+(defun enable-interrupt (signal-designator handler)
   (declare (type (or function (member :default :ignore)) handler))
   (without-gcing
-   (let ((result (install-handler (unix-signal-number signal)
+   (let ((result (install-handler (unix-signal-number signal-designator)
 				  (case handler
 				    (:default sig_dfl)
 				    (:ignore sig_ign)
@@ -96,6 +83,13 @@
 ;;;;
 ;;;; Most of these just call ERROR to report the presence of the signal.
 
+;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
+;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
+;;; SIGINT in --noprogrammer mode will cleanly terminate the system
+;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
+(defun sigint-%break (format-string &rest format-arguments)
+  (apply #'%break 'sigint format-string format-arguments))
+
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro define-signal-handler (name
 					 what
@@ -108,7 +102,7 @@
 		  (with-alien ((context (* os-context-t) context))
 		    (sap-int (sb!vm:context-pc context)))))))
 
-(define-signal-handler sigint-handler "interrupted" break)
+(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")
@@ -142,7 +136,14 @@
   (enable-interrupt :sigsys #'sigsys-handler)
   (enable-interrupt :sigpipe #'sigpipe-handler)
   (enable-interrupt :sigalrm #'sigalrm-handler)
-  nil)
+  (values))
+
+;;;; etc.
+
+;;; CMU CL comment:
+;;;   Magically converted by the compiler into a break instruction.
+(defun do-pending-interrupt ()
+  (do-pending-interrupt))
 
 ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
 #|