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)
49 ;;;; C routines that actually do all the work of establishing signal handlers
50 (sb!alien:define-alien-routine ("install_handler" install-handler)
51 sb!alien:unsigned-long
53 (handler sb!alien:unsigned-long))
55 ;;;; interface to enabling and disabling signal handlers
57 (defun enable-interrupt (signal handler)
58 (declare (type (or function fixnum (member :default :ignore)) handler))
59 (/show0 "enable-interrupt")
61 (let ((result (install-handler signal
66 (sb!kernel:get-lisp-obj-address
68 (cond ((= result sig_dfl) :default)
69 ((= result sig_ign) :ignore)
70 (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
72 (defun default-interrupt (signal)
73 (enable-interrupt signal :default))
75 (defun ignore-interrupt (signal)
76 (enable-interrupt signal :ignore))
78 ;;;; default LISP signal handlers
80 ;;;; Most of these just call ERROR to report the presence of the signal.
82 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
83 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
84 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
85 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
86 (defun sigint-%break (format-string &rest format-arguments)
88 (let ((foreground-thread (sb!thread::foreground-thread)))
89 (if (eq foreground-thread sb!thread:*current-thread*)
90 (apply #'%break 'sigint format-string format-arguments)
91 (sb!thread:interrupt-thread
93 (lambda () (apply #'%break 'sigint format-string format-arguments)))))
95 (apply #'%break 'sigint format-string format-arguments))
97 (eval-when (:compile-toplevel :execute)
98 (sb!xc:defmacro define-signal-handler (name
100 &optional (function 'error))
101 `(defun ,name (signal info context)
102 (declare (ignore signal info))
103 (declare (type system-area-pointer context))
104 (/show "in Lisp-level signal handler" ,(symbol-name name) (sap-int context))
105 (,function ,(concatenate 'simple-string what " at #X~X")
106 (with-alien ((context (* os-context-t) context))
107 (sap-int (sb!vm:context-pc context)))))))
109 (define-signal-handler sigint-handler "interrupted" sigint-%break)
110 (define-signal-handler sigill-handler "illegal instruction")
111 (define-signal-handler sigtrap-handler "breakpoint/trap")
112 (define-signal-handler sigiot-handler "SIGIOT")
114 (define-signal-handler sigemt-handler "SIGEMT")
115 (define-signal-handler sigbus-handler "bus error")
116 (define-signal-handler sigsegv-handler "segmentation violation")
118 (define-signal-handler sigsys-handler "bad argument to a system call")
119 (define-signal-handler sigpipe-handler "SIGPIPE")
121 (defun sigalrm-handler (signal info context)
122 (declare (ignore signal info context))
123 (declare (type system-area-pointer context))
124 (sb!impl::run-expired-timers))
126 (defun sigquit-handler (signal code context)
127 (declare (ignore signal code context))
128 (throw 'toplevel-catcher nil))
130 (defun sb!kernel:signal-cold-init-or-reinit ()
132 "Enable all the default signals that Lisp knows how to deal with."
133 (enable-interrupt sigint #'sigint-handler)
134 (enable-interrupt sigquit #'sigquit-handler)
135 (enable-interrupt sigill #'sigill-handler)
136 (enable-interrupt sigtrap #'sigtrap-handler)
137 (enable-interrupt sigiot #'sigiot-handler)
139 (enable-interrupt sigemt #'sigemt-handler)
140 (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
141 (enable-interrupt sigbus #'sigbus-handler)
142 (enable-interrupt sigsegv #'sigsegv-handler)
144 (enable-interrupt sigsys #'sigsys-handler)
145 (enable-interrupt sigpipe #'sigpipe-handler)
146 (enable-interrupt sigalrm #'sigalrm-handler)
147 (sb!unix::reset-signal-mask)
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)))))))