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 (defmacro with-interrupt-bindings (&body body)
15 (with-unique-names (empty)
17 ;; KLUDGE: Whatever is on the PCL stacks before the interrupt
18 ;; handler runs doesn't really matter, since we're not on the
19 ;; same call stack, really -- and if we don't bind these (esp.
20 ;; the cache one) we can get a bogus metacircle if an interrupt
21 ;; handler calls a GF that was being computed when the interrupt
23 ((sb!pcl::*cache-miss-values-stack* nil)
24 (sb!pcl::*dfun-miss-gfs-on-stack* nil)
25 ;; Unless we do this, ADJUST-ARRAY and SORT would need to
26 ;; disable interrupts.
28 (sb!impl::*zap-array-data-temp* ,empty)
29 (sb!impl::*merge-sort-temp-vector* ,empty))
32 (defun invoke-interruption (function)
34 (with-interrupt-bindings
35 ;; Reset signal mask: the C-side handler has blocked all
36 ;; deferrable interrupts before arranging return to lisp. This is
37 ;; safe because we can't get a pending interrupt before we unblock
39 (unblock-deferrable-signals)
40 (let ((sb!debug:*stack-top-hint*
41 (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
42 (allow-with-interrupts (funcall function))))))
44 (defmacro in-interruption ((&key) &body body)
46 "Convenience macro on top of INVOKE-INTERRUPTION."
47 `(dx-flet ((interruption () ,@body))
48 (invoke-interruption #'interruption)))
50 ;;;; system calls that deal with signals
52 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
53 ;;; should be a valid signal number
54 #!-sb-fluid (declaim (inline real-unix-kill))
55 (sb!alien:define-alien-routine ("kill" unix-kill) sb!alien:int
57 (signal sb!alien:int))
59 ;;; Send the signal SIGNAL to the all the process in process group
60 ;;; PGRP. SIGNAL should be a valid signal number
61 #!-sb-fluid (declaim (inline real-unix-killpg))
62 (sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int
64 (signal sb!alien:int))
66 ;;; Reset the current set of masked signals (those being blocked from
69 ;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
70 ;;; operator to create masks, but since we only ever reset to 0, we no
71 ;;; longer support it. If you need it, you can pull it out of the CMU
72 ;;; CL sources, or the old SBCL sources; but you might also consider
73 ;;; doing things the SBCL way and moving this kind of C-level work
74 ;;; down to C wrapper functions.)
76 (sb!alien:define-alien-routine "unblock_deferrable_signals" sb!alien:void)
77 (sb!alien:define-alien-routine "unblock_gc_signals" sb!alien:void)
80 ;;;; C routines that actually do all the work of establishing signal handlers
81 (sb!alien:define-alien-routine ("install_handler" install-handler)
82 sb!alien:unsigned-long
84 (handler sb!alien:unsigned-long))
86 ;;;; interface to enabling and disabling signal handlers
88 (defun enable-interrupt (signal handler)
89 (declare (type (or function fixnum (member :default :ignore)) handler))
90 (/show0 "enable-interrupt")
91 (flet ((run-handler (&rest args)
92 (declare (truly-dynamic-extent args))
94 (apply handler args))))
96 (let ((result (install-handler signal
101 (sb!kernel:get-lisp-obj-address
103 (cond ((= result sig-dfl) :default)
104 ((= result sig-ign) :ignore)
105 (t (the (or function fixnum)
106 (sb!kernel:make-lisp-obj result))))))))
108 (defun default-interrupt (signal)
109 (enable-interrupt signal :default))
111 (defun ignore-interrupt (signal)
112 (enable-interrupt signal :ignore))
114 ;;;; default LISP signal handlers
116 ;;;; Most of these just call ERROR to report the presence of the signal.
118 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
119 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
120 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
121 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
122 (eval-when (:compile-toplevel :execute)
123 (sb!xc:defmacro define-signal-handler (name what &optional (function 'error))
124 `(defun ,name (signal info context)
125 (declare (ignore signal info))
126 (declare (type system-area-pointer context))
127 (/show "in Lisp-level signal handler" ,(symbol-name name)
130 (,function ,(concatenate 'simple-string what " at #X~X")
131 (with-alien ((context (* os-context-t) context))
132 (sap-int (sb!vm:context-pc context))))))))
134 (define-signal-handler sigill-handler "illegal instruction")
136 (define-signal-handler sigemt-handler "SIGEMT")
137 (define-signal-handler sigbus-handler "bus error")
138 (define-signal-handler sigsegv-handler "segmentation violation")
140 (define-signal-handler sigsys-handler "bad argument to a system call")
142 (defun sigint-handler (signal info context)
143 (declare (ignore signal info))
144 (declare (type system-area-pointer context))
145 (/show "in Lisp-level SIGINT handler" (sap-int context))
146 (flet ((interrupt-it ()
147 (with-alien ((context (* os-context-t) context))
148 (%break 'sigint 'interactive-interrupt
150 :address (sap-int (sb!vm:context-pc context))))))
151 (sb!thread:interrupt-thread (sb!thread::foreground-thread)
154 (defun sigalrm-handler (signal info context)
155 (declare (ignore signal info context))
156 (declare (type system-area-pointer context))
157 (sb!impl::run-expired-timers))
159 (defun sigterm-handler (signal code context)
160 (declare (ignore signal code context))
161 (sb!thread::terminate-session)
164 (defun sb!kernel:signal-cold-init-or-reinit ()
166 "Enable all the default signals that Lisp knows how to deal with."
167 (enable-interrupt sigint #'sigint-handler)
168 (enable-interrupt sigterm #'sigterm-handler)
169 (enable-interrupt sigill #'sigill-handler)
171 (enable-interrupt sigemt #'sigemt-handler)
172 (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
173 (enable-interrupt sigbus #'sigbus-handler)
174 (enable-interrupt sigsegv #'sigsegv-handler)
176 (enable-interrupt sigsys #'sigsys-handler)
177 (ignore-interrupt sigpipe)
178 (enable-interrupt sigalrm #'sigalrm-handler)
179 #!+hpux (ignore-interrupt sigxcpu)
180 (unblock-deferrable-signals)
186 ;;; extract si_code from siginfo_t
187 (sb!alien:define-alien-routine ("siginfo_code" siginfo-code) sb!alien:int
188 (info system-area-pointer))
191 ;;; Magically converted by the compiler into a break instruction.
192 (defun receive-pending-interrupt ()
193 (receive-pending-interrupt))