0.8.6.11
[sbcl.git] / src / code / target-signal.lisp
index 1d99910..cdcae59 100644 (file)
 \f
 ;;;; system calls that deal with signals
 
+;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
+;;; should be a valid signal number
 #!-sb-fluid (declaim (inline real-unix-kill))
-(sb!alien:define-alien-routine ("kill" real-unix-kill) sb!alien:int
+(sb!alien:define-alien-routine ("kill" unix-kill) sb!alien:int
   (pid sb!alien:int)
   (signal sb!alien: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)
-  (real-unix-kill pid (unix-signal-number signal)))
-
+;;; Send the signal SIGNAL to the all the process in process group
+;;; PGRP. SIGNAL should be a valid signal number
 #!-sb-fluid (declaim (inline real-unix-killpg))
-(sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int
+(sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int
   (pgrp sb!alien:int)
   (signal sb!alien: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)
-  (real-unix-killpg pgrp (unix-signal-number signal)))
-
-;;; Set the current set of masked signals (those being blocked from
+;;; Reset 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.)
-#!-sunos
-(sb!alien:define-alien-routine ("sigsetmask" unix-sigsetmask)
-                              sb!alien:unsigned-long
-  (mask sb!alien:unsigned-long))
+;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
+;;; operator to create masks, but since we only ever reset to 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.)
+
+;;; 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)
 \f
 ;;;; 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
   (signal sb!alien:int)
   (handler sb!alien:unsigned-long))
-\f
+
 ;;;; interface to enabling and disabling signal handlers
 
-(defun enable-interrupt (signal-designator handler)
-  (declare (type (or function (member :default :ignore)) handler))
+(defun enable-interrupt (signal handler)
+  (declare (type (or function fixnum (member :default :ignore)) handler))
   (without-gcing
-   (let ((result (install-handler (unix-signal-number signal-designator)
+   (let ((result (install-handler signal
                                  (case handler
                                    (:default sig_dfl)
                                    (:ignore sig_ign)
@@ -72,7 +65,7 @@
                                      handler))))))
      (cond ((= result sig_dfl) :default)
           ((= result sig_ign) :ignore)
-          (t (the function (sb!kernel:make-lisp-obj result)))))))
+          (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
 
 (defun default-interrupt (signal)
   (enable-interrupt signal :default))
@@ -86,7 +79,7 @@
 
 ;;; 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
+;;; 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)
   (apply #'%break 'sigint format-string format-arguments))
 #!-linux
 (define-signal-handler sigsys-handler "bad argument to a system call")
 (define-signal-handler sigpipe-handler "SIGPIPE")
-(define-signal-handler sigalrm-handler "SIGALRM")
+
+(defun sigalrm-handler (signal info context)
+  (declare (ignore signal info context))
+  (declare (type system-area-pointer context))
+  (cerror "Continue" 'sb!ext::timeout))
 
 (defun sigquit-handler (signal code context)
   (declare (ignore signal code context))
 (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 :sigill #'sigill-handler)
-  (enable-interrupt :sigtrap #'sigtrap-handler)
-  (enable-interrupt :sigiot #'sigiot-handler)
+  (enable-interrupt sigint #'sigint-handler)
+  (enable-interrupt sigquit #'sigquit-handler)
+  (enable-interrupt sigill #'sigill-handler)
+  (enable-interrupt sigtrap #'sigtrap-handler)
+  (enable-interrupt sigiot #'sigiot-handler)
   #!-linux
-  (enable-interrupt :sigemt #'sigemt-handler)
-  (enable-interrupt :sigfpe #'sb!vm:sigfpe-handler)
-  (enable-interrupt :sigbus #'sigbus-handler)
-  (enable-interrupt :sigsegv #'sigsegv-handler)
+  (enable-interrupt sigemt #'sigemt-handler)
+  (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
+  (enable-interrupt sigbus #'sigbus-handler)
+  (enable-interrupt sigsegv #'sigsegv-handler)
   #!-linux
-  (enable-interrupt :sigsys #'sigsys-handler)
-  (enable-interrupt :sigpipe #'sigpipe-handler)
-  (enable-interrupt :sigalrm #'sigalrm-handler)
+  (enable-interrupt sigsys #'sigsys-handler)
+  (enable-interrupt sigpipe #'sigpipe-handler)
+  (enable-interrupt sigalrm #'sigalrm-handler)
   (values))
 \f
 ;;;; etc.