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:def-alien-routine ("kill" real-unix-kill) sb!c-call:int
23 (signal sb!c-call:int))
25 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
26 ;;; should be a valid signal number or a keyword of the standard UNIX
28 (defun unix-kill (pid signal)
29 (real-unix-kill pid (unix-signal-number signal)))
31 #!-sb-fluid (declaim (inline real-unix-killpg))
32 (sb!alien:def-alien-routine ("killpg" real-unix-killpg) sb!c-call:int
34 (signal sb!c-call:int))
36 ;;; Send the signal SIGNAL to the all the process in process group
37 ;;; PGRP. SIGNAL should be a valid signal number or a keyword of the
38 ;;; standard UNIX signal name.
39 (defun unix-killpg (pgrp signal)
40 (real-unix-killpg pgrp (unix-signal-number signal)))
42 ;;; Set the current set of masked signals (those being blocked from
45 ;;; (Note: CMU CL had a SIGMASK operator to create masks, but since
46 ;;; SBCL only uses 0, we no longer support it. If you need it, you
47 ;;; can pull it out of the CMU CL sources, or the old SBCL sources;
48 ;;; but you might also consider doing things the SBCL way and moving
49 ;;; this kind of C-level work down to C wrapper functions.)
50 (sb!alien:def-alien-routine ("sigsetmask" unix-sigsetmask)
51 sb!c-call:unsigned-long
52 (mask sb!c-call:unsigned-long))
54 ;;;; C routines that actually do all the work of establishing signal handlers
55 (sb!alien:def-alien-routine ("install_handler" install-handler)
56 sb!c-call:unsigned-long
57 (signal sb!c-call:int)
58 (handler sb!c-call:unsigned-long))
60 ;;;; interface to enabling and disabling signal handlers
62 (defun enable-interrupt (signal-designator handler)
63 (declare (type (or function (member :default :ignore)) handler))
65 (let ((result (install-handler (unix-signal-number signal-designator)
70 (sb!kernel:get-lisp-obj-address
72 (cond ((= result sig_dfl) :default)
73 ((= result sig_ign) :ignore)
74 (t (the function (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 --noprogrammer 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")
116 (define-signal-handler sigalrm-handler "SIGALRM")
118 (defun sigquit-handler (signal code context)
119 (declare (ignore signal code context))
120 (throw 'sb!impl::top-level-catcher nil))
122 (defun sb!kernel:signal-cold-init-or-reinit ()
124 "Enable all the default signals that Lisp knows how to deal with."
125 (enable-interrupt :sigint #'sigint-handler)
126 (enable-interrupt :sigquit #'sigquit-handler)
127 (enable-interrupt :sigill #'sigill-handler)
128 (enable-interrupt :sigtrap #'sigtrap-handler)
129 (enable-interrupt :sigiot #'sigiot-handler)
131 (enable-interrupt :sigemt #'sigemt-handler)
132 (enable-interrupt :sigfpe #'sb!vm:sigfpe-handler)
133 (enable-interrupt :sigbus #'sigbus-handler)
134 (enable-interrupt :sigsegv #'sigsegv-handler)
136 (enable-interrupt :sigsys #'sigsys-handler)
137 (enable-interrupt :sigpipe #'sigpipe-handler)
138 (enable-interrupt :sigalrm #'sigalrm-handler)
144 ;;; Magically converted by the compiler into a break instruction.
145 (defun do-pending-interrupt ()
146 (do-pending-interrupt))
148 ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
150 ;;;; WITH-ENABLED-INTERRUPTS
152 (defmacro with-enabled-interrupts (interrupt-list &body body)
154 "With-enabled-interrupts ({(interrupt function)}*) {form}*
155 Establish function as a handler for the Unix signal interrupt which
156 should be a number between 1 and 31 inclusive."
162 ,@(do* ((item interrupt-list (cdr item))
163 (intr (caar item) (caar item))
164 (ifcn (cadar item) (cadar item))
166 ((null item) (nreverse forms))
168 (setq intr (symbol-value intr)))
169 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
172 (dolist (,it (nreverse ,il))
173 (enable-interrupt (car ,it) (cadr ,it)))))))