1 ;;;; code for handling UNIX signals
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!UNIX")
14 ;;; These should probably be somewhere, but I don't know where.
15 (defconstant sig_dfl 0)
16 (defconstant sig_ign 1)
18 ;;;; system calls that deal with signals
20 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
21 ;;; should be a valid signal number
22 #!-sb-fluid (declaim (inline real-unix-kill))
23 (sb!alien:define-alien-routine ("kill" unix-kill) sb!alien:int
25 (signal sb!alien:int))
27 ;;; Send the signal SIGNAL to the all the process in process group
28 ;;; PGRP. SIGNAL should be a valid signal number
29 #!-sb-fluid (declaim (inline real-unix-killpg))
30 (sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int
32 (signal sb!alien:int))
34 ;;; Reset the current set of masked signals (those being blocked from
37 ;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
38 ;;; operator to create masks, but since we only ever reset to 0, we no
39 ;;; longer support it. If you need it, you can pull it out of the CMU
40 ;;; CL sources, or the old SBCL sources; but you might also consider
41 ;;; doing things the SBCL way and moving this kind of C-level work
42 ;;; down to C wrapper functions.)
44 ;;; When inappropriate build options are used, this also prints messages
45 ;;; listing the signals that were masked
46 (sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void)
48 (sb!alien:define-alien-routine "block_blockable_signals" sb!alien:void)
50 ;;;; C routines that actually do all the work of establishing signal handlers
51 (sb!alien:define-alien-routine ("install_handler" install-handler)
52 sb!alien:unsigned-long
54 (handler sb!alien:unsigned-long))
56 ;;;; interface to enabling and disabling signal handlers
58 (defun enable-interrupt (signal handler)
59 (declare (type (or function fixnum (member :default :ignore)) handler))
60 (/show0 "enable-interrupt")
62 (let ((result (install-handler signal
67 (sb!kernel:get-lisp-obj-address
69 (cond ((= result sig_dfl) :default)
70 ((= result sig_ign) :ignore)
71 (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
73 (defun default-interrupt (signal)
74 (enable-interrupt signal :default))
76 (defun ignore-interrupt (signal)
77 (enable-interrupt signal :ignore))
79 ;;;; default LISP signal handlers
81 ;;;; Most of these just call ERROR to report the presence of the signal.
83 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
84 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
85 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
86 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
87 (defun sigint-%break (format-string &rest format-arguments)
89 (let ((foreground-thread (sb!thread::foreground-thread)))
90 (if (eq foreground-thread sb!thread:*current-thread*)
91 (apply #'%break 'sigint format-string format-arguments)
92 (sb!thread:interrupt-thread
94 (lambda () (apply #'%break 'sigint format-string format-arguments)))))
96 (apply #'%break 'sigint format-string format-arguments))
98 (eval-when (:compile-toplevel :execute)
99 (sb!xc:defmacro define-signal-handler (name
101 &optional (function 'error))
102 `(defun ,name (signal info context)
103 (declare (ignore signal info))
104 (declare (type system-area-pointer context))
105 (/show "in Lisp-level signal handler" ,(symbol-name name) (sap-int context))
106 (,function ,(concatenate 'simple-string what " at #X~X")
107 (with-alien ((context (* os-context-t) context))
108 (sap-int (sb!vm:context-pc context)))))))
110 (define-signal-handler sigint-handler "interrupted" sigint-%break)
111 (define-signal-handler sigill-handler "illegal instruction")
112 (define-signal-handler sigtrap-handler "breakpoint/trap")
113 (define-signal-handler sigiot-handler "SIGIOT")
115 (define-signal-handler sigemt-handler "SIGEMT")
116 (define-signal-handler sigbus-handler "bus error")
117 (define-signal-handler sigsegv-handler "segmentation violation")
119 (define-signal-handler sigsys-handler "bad argument to a system call")
120 (define-signal-handler sigpipe-handler "SIGPIPE")
122 (defun sigalrm-handler (signal info context)
123 (declare (ignore signal info context))
124 (declare (type system-area-pointer context))
125 (cerror "Continue" 'sb!ext::timeout))
127 (defun sigquit-handler (signal code context)
128 (declare (ignore signal code context))
129 (throw 'toplevel-catcher nil))
131 (defun sb!kernel:signal-cold-init-or-reinit ()
133 "Enable all the default signals that Lisp knows how to deal with."
134 (enable-interrupt sigint #'sigint-handler)
135 (enable-interrupt sigquit #'sigquit-handler)
136 (enable-interrupt sigill #'sigill-handler)
137 (enable-interrupt sigtrap #'sigtrap-handler)
138 (enable-interrupt sigiot #'sigiot-handler)
140 (enable-interrupt sigemt #'sigemt-handler)
141 (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
142 (enable-interrupt sigbus #'sigbus-handler)
143 (enable-interrupt sigsegv #'sigsegv-handler)
145 (enable-interrupt sigsys #'sigsys-handler)
146 (enable-interrupt sigpipe #'sigpipe-handler)
147 (enable-interrupt sigalrm #'sigalrm-handler)
153 ;;; Magically converted by the compiler into a break instruction.
154 (defun receive-pending-interrupt ()
155 (receive-pending-interrupt))
157 ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
159 ;;;; WITH-ENABLED-INTERRUPTS
161 (defmacro with-enabled-interrupts (interrupt-list &body body)
163 "With-enabled-interrupts ({(interrupt function)}*) {form}*
164 Establish function as a handler for the Unix signal interrupt which
165 should be a number between 1 and 31 inclusive."
171 ,@(do* ((item interrupt-list (cdr item))
172 (intr (caar item) (caar item))
173 (ifcn (cadar item) (cadar item))
175 ((null item) (nreverse forms))
177 (setq intr (symbol-value intr)))
178 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
181 (dolist (,it (nreverse ,il))
182 (enable-interrupt (car ,it) (cadr ,it)))))))