\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:def-alien-routine ("kill" real-unix-kill) sb!c-call:int
- (pid sb!c-call:int)
- (signal sb!c-call:int))
-
-(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!alien:define-alien-routine ("kill" unix-kill) sb!alien:int
+ (pid 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
#!-sb-fluid (declaim (inline real-unix-killpg))
-(sb!alien:def-alien-routine ("killpg" real-unix-killpg) sb!c-call:int
- (pgrp sb!c-call:int)
- (signal sb!c-call:int))
-
-(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))
-
-(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))
+(sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int
+ (pgrp sb!alien:int)
+ (signal sb!alien:int))
+
+;;; Reset the current set of masked signals (those being blocked from
+;;; delivery).
+;;;
+;;; (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:def-alien-routine ("install_handler" install-handler)
- sb!c-call:unsigned-long
- (signal sb!c-call:int)
- (handler sb!c-call:unsigned-long))
-\f
+(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 handler)
- (declare (type (or function (member :default :ignore)) handler))
+ (declare (type (or function fixnum (member :default :ignore)) handler))
+ (/show0 "enable-interrupt")
(without-gcing
- (let ((result (install-handler (unix-signal-number signal)
+ (let ((result (install-handler signal
(case handler
(:default sig_dfl)
(:ignore sig_ign)
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))
;;;;
;;;; 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 --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))
+
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro define-signal-handler (name
what
`(defun ,name (signal info context)
(declare (ignore signal info))
(declare (type system-area-pointer context))
- (/show "in Lisp-level signal handler" (sap-int 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)))))))
-(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")
#!-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))
- (throw 'sb!impl::top-level-catcher nil))
+ (throw 'sb!impl::toplevel-catcher nil))
(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)
- nil)
+ (enable-interrupt sigsys #'sigsys-handler)
+ (enable-interrupt sigpipe #'sigpipe-handler)
+ (enable-interrupt sigalrm #'sigalrm-handler)
+ (values))
+\f
+;;;; etc.
+
+;;; CMU CL comment:
+;;; Magically converted by the compiler into a break instruction.
+(defun receive-pending-interrupt ()
+ (receive-pending-interrupt))
\f
;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
#|