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 #!-sb-fluid (declaim (inline real-unix-kill))
21 (sb!alien:define-alien-routine ("kill" real-unix-kill) sb!alien:int
23 (signal sb!alien:int))
25 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
26 ;;; should be a valid signal number
27 (defun unix-kill (pid signal)
28 (real-unix-kill pid signal))
30 #!-sb-fluid (declaim (inline real-unix-killpg))
31 (sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int
33 (signal sb!alien:int))
35 ;;; Send the signal SIGNAL to the all the process in process group
36 ;;; PGRP. SIGNAL should be a valid signal number
37 (defun unix-killpg (pgrp signal)
38 (real-unix-killpg pgrp signal))
40 ;;; Reset the current set of masked signals (those being blocked from
43 ;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
44 ;;; operator to create masks, but since we only ever reset to 0, we no
45 ;;; longer support it. If you need it, you can pull it out of the CMU
46 ;;; CL sources, or the old SBCL sources; but you might also consider
47 ;;; doing things the SBCL way and moving this kind of C-level work
48 ;;; down to C wrapper functions.)
50 ;;; When inappropriate build options are used, this also prints messages
51 ;;; listing the signals that were masked
52 (sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void)
54 ;;;; C routines that actually do all the work of establishing signal handlers
55 (sb!alien:define-alien-routine ("install_handler" install-handler)
56 sb!alien:unsigned-long
58 (handler sb!alien:unsigned-long))
60 ;;;; interface to enabling and disabling signal handlers
62 (defun enable-interrupt (signal handler)
63 (declare (type (or function fixnum (member :default :ignore)) handler))
65 (let ((result (install-handler signal
70 (sb!kernel:get-lisp-obj-address
72 (cond ((= result sig_dfl) :default)
73 ((= result sig_ign) :ignore)
74 (t (the (or function fixnum) (sb!kernel:make-lisp-obj result)))))))
76 (defun default-interrupt (signal)
77 (enable-interrupt signal :default))
79 (defun ignore-interrupt (signal)
80 (enable-interrupt signal :ignore))
82 ;;;; default LISP signal handlers
84 ;;;; Most of these just call ERROR to report the presence of the signal.
86 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
87 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
88 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
89 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
90 (defun sigint-%break (format-string &rest format-arguments)
91 (apply #'%break 'sigint format-string format-arguments))
93 (eval-when (:compile-toplevel :execute)
94 (sb!xc:defmacro define-signal-handler (name
96 &optional (function 'error))
97 `(defun ,name (signal info context)
98 (declare (ignore signal info))
99 (declare (type system-area-pointer context))
100 (/show "in Lisp-level signal handler" (sap-int context))
101 (,function ,(concatenate 'simple-string what " at #X~X")
102 (with-alien ((context (* os-context-t) context))
103 (sap-int (sb!vm:context-pc context)))))))
105 (define-signal-handler sigint-handler "interrupted" sigint-%break)
106 (define-signal-handler sigill-handler "illegal instruction")
107 (define-signal-handler sigtrap-handler "breakpoint/trap")
108 (define-signal-handler sigiot-handler "SIGIOT")
110 (define-signal-handler sigemt-handler "SIGEMT")
111 (define-signal-handler sigbus-handler "bus error")
112 (define-signal-handler sigsegv-handler "segmentation violation")
114 (define-signal-handler sigsys-handler "bad argument to a system call")
115 (define-signal-handler sigpipe-handler "SIGPIPE")
117 (defun sigalrm-handler (signal info context)
118 (declare (ignore signal info context))
119 (declare (type system-area-pointer context))
120 (cerror "Continue" 'sb!ext::timeout))
122 (defun sigquit-handler (signal code context)
123 (declare (ignore signal code context))
124 (throw 'sb!impl::toplevel-catcher nil))
126 (defun sb!kernel:signal-cold-init-or-reinit ()
128 "Enable all the default signals that Lisp knows how to deal with."
129 (enable-interrupt sigint #'sigint-handler)
130 (enable-interrupt sigquit #'sigquit-handler)
131 (enable-interrupt sigill #'sigill-handler)
132 (enable-interrupt sigtrap #'sigtrap-handler)
133 (enable-interrupt sigiot #'sigiot-handler)
135 (enable-interrupt sigemt #'sigemt-handler)
136 (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
137 (enable-interrupt sigbus #'sigbus-handler)
138 (enable-interrupt sigsegv #'sigsegv-handler)
140 (enable-interrupt sigsys #'sigsys-handler)
141 (enable-interrupt sigpipe #'sigpipe-handler)
142 (enable-interrupt sigalrm #'sigalrm-handler)
148 ;;; Magically converted by the compiler into a break instruction.
149 (defun receive-pending-interrupt ()
150 (receive-pending-interrupt))
152 ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
154 ;;;; WITH-ENABLED-INTERRUPTS
156 (defmacro with-enabled-interrupts (interrupt-list &body body)
158 "With-enabled-interrupts ({(interrupt function)}*) {form}*
159 Establish function as a handler for the Unix signal interrupt which
160 should be a number between 1 and 31 inclusive."
166 ,@(do* ((item interrupt-list (cdr item))
167 (intr (caar item) (caar item))
168 (ifcn (cadar item) (cadar item))
170 ((null item) (nreverse forms))
172 (setq intr (symbol-value intr)))
173 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
176 (dolist (,it (nreverse ,il))
177 (enable-interrupt (car ,it) (cadr ,it)))))))