X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=a920f15da921d9e9314d1b4533154cd876db9753;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=34629f5cf84856d905784eb2a6e232f3f68ba1d1;hpb=f9ef8b045b60ae064c7bd40af599b46707ea4d8a;p=sbcl.git diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 34629f5..a920f15 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -23,10 +23,9 @@ (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. +;;; should be a valid signal number (defun unix-kill (pid signal) - (real-unix-kill pid (unix-signal-number signal))) + (real-unix-kill pid signal)) #!-sb-fluid (declaim (inline real-unix-killpg)) (sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int @@ -34,36 +33,36 @@ (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. +;;; PGRP. SIGNAL should be a valid signal number (defun unix-killpg (pgrp signal) - (real-unix-killpg pgrp (unix-signal-number signal))) + (real-unix-killpg pgrp 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) ;;;; 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)) - + ;;;; 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 +71,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)) @@ -118,8 +117,7 @@ (defun sigalrm-handler (signal info context) (declare (ignore signal info context)) (declare (type system-area-pointer context)) - (cerror "Continue" 'sb!kernel::timeout)) - + (cerror "Continue" 'sb!ext::timeout)) (defun sigquit-handler (signal code context) (declare (ignore signal code context)) @@ -128,20 +126,20 @@ (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)) ;;;; etc.