src/code/target-signal.lisp

   1 ;;;; code for handling UNIX signals
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package "SB!UNIX")
  13
  14 (defun invoke-interruption (function)
  15   (without-interrupts
  16     ;; Reset signal mask: the C-side handler has blocked all
  17     ;; deferrable interrupts before arranging return to lisp. This is
  18     ;; safe because we can't get a pending interrupt before we unblock
  19     ;; signals.
  20     ;;
  21     ;; FIXME: Should we not reset the _entire_ mask, just restore it
  22     ;; to the state before we got the interrupt?
  23     (reset-signal-mask)
  24     (allow-with-interrupts (funcall function))))
  25
  26 (defmacro in-interruption ((&rest args) &body body)
  27   #!+sb-doc
  28   "Convenience macro on top of INVOKE-INTERRUPTION."
  29   `(invoke-interruption (lambda () ,@body) ,@args))
  30 \f
  31 ;;;; system calls that deal with signals
  32
  33 ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
  34 ;;; should be a valid signal number
  35 #!-sb-fluid (declaim (inline real-unix-kill))
  36 (sb!alien:define-alien-routine ("kill" unix-kill) sb!alien:int
  37   (pid sb!alien:int)
  38   (signal sb!alien:int))
  39
  40 ;;; Send the signal SIGNAL to the all the process in process group
  41 ;;; PGRP. SIGNAL should be a valid signal number
  42 #!-sb-fluid (declaim (inline real-unix-killpg))
  43 (sb!alien:define-alien-routine ("killpg" unix-killpg) sb!alien:int
  44   (pgrp sb!alien:int)
  45   (signal sb!alien:int))
  46
  47 ;;; Reset the current set of masked signals (those being blocked from
  48 ;;; delivery).
  49 ;;;
  50 ;;; (Note: CMU CL had a more general SIGSETMASK call and a SIGMASK
  51 ;;; operator to create masks, but since we only ever reset to 0, we no
  52 ;;; longer support it. If you need it, you can pull it out of the CMU
  53 ;;; CL sources, or the old SBCL sources; but you might also consider
  54 ;;; doing things the SBCL way and moving this kind of C-level work
  55 ;;; down to C wrapper functions.)
  56
  57 ;;; When inappropriate build options are used, this also prints messages
  58 ;;; listing the signals that were masked
  59 (sb!alien:define-alien-routine "reset_signal_mask" sb!alien:void)
  60
  61 \f
  62 ;;;; C routines that actually do all the work of establishing signal handlers
  63 (sb!alien:define-alien-routine ("install_handler" install-handler)
  64                                sb!alien:unsigned-long
  65   (signal sb!alien:int)
  66   (handler sb!alien:unsigned-long))
  67
  68 ;;;; interface to enabling and disabling signal handlers
  69
  70 (defun enable-interrupt (signal handler)
  71   (declare (type (or function fixnum (member :default :ignore)) handler))
  72   (/show0 "enable-interrupt")
  73   (flet ((run-handler (&rest args)
  74            (in-interruption ()
  75              (apply handler args))))
  76     (without-gcing
  77       (let ((result (install-handler signal
  78                                      (case handler
  79                                        (:default sig-dfl)
  80                                        (:ignore sig-ign)
  81                                        (t
  82                                         (sb!kernel:get-lisp-obj-address
  83                                          #'run-handler))))))
  84         (cond ((= result sig-dfl) :default)
  85               ((= result sig-ign) :ignore)
  86               (t (the (or function fixnum)
  87                    (sb!kernel:make-lisp-obj result))))))))
  88
  89 (defun default-interrupt (signal)
  90   (enable-interrupt signal :default))
  91
  92 (defun ignore-interrupt (signal)
  93   (enable-interrupt signal :ignore))
  94 \f
  95 ;;;; default LISP signal handlers
  96 ;;;;
  97 ;;;; Most of these just call ERROR to report the presence of the signal.
  98
  99 ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
 100 ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
 101 ;;; SIGINT in --disable-debugger mode will cleanly terminate the system
 102 ;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
 103 (eval-when (:compile-toplevel :execute)
 104   (sb!xc:defmacro define-signal-handler (name what &optional (function 'error))
 105     `(defun ,name (signal info context)
 106        (declare (ignore signal info))
 107        (declare (type system-area-pointer context))
 108        (/show "in Lisp-level signal handler" ,(symbol-name name)
 109               (sap-int context))
 110        (with-interrupts
 111          (,function ,(concatenate 'simple-string what " at #X~X")
 112                     (with-alien ((context (* os-context-t) context))
 113                       (sap-int (sb!vm:context-pc context))))))))
 114
 115 (define-signal-handler sigill-handler "illegal instruction")
 116 #!-linux
 117 (define-signal-handler sigemt-handler "SIGEMT")
 118 (define-signal-handler sigbus-handler "bus error")
 119 (define-signal-handler sigsegv-handler "segmentation violation")
 120 #!-linux
 121 (define-signal-handler sigsys-handler "bad argument to a system call")
 122
 123 (defun sigint-handler (signal info context)
 124   (declare (ignore signal info))
 125   (declare (type system-area-pointer context))
 126   (/show "in Lisp-level SIGINT handler" (sap-int context))
 127   (flet ((interrupt-it ()
 128            (with-alien ((context (* os-context-t) context))
 129              (%break 'sigint 'interactive-interrupt
 130                      :context context
 131                      :address (sap-int (sb!vm:context-pc context))))))
 132     (sb!thread:interrupt-thread (sb!thread::foreground-thread)
 133                                 #'interrupt-it)))
 134
 135 (defun sigalrm-handler (signal info context)
 136   (declare (ignore signal info context))
 137   (declare (type system-area-pointer context))
 138   (sb!impl::run-expired-timers))
 139
 140 (defun sigterm-handler (signal code context)
 141   (declare (ignore signal code context))
 142   (sb!thread::terminate-session)
 143   (sb!ext:quit))
 144
 145 ;; Also known as SIGABRT.
 146 (defun sigiot-handler (signal code context)
 147   (declare (ignore signal code context))
 148   (sb!impl::%halt))
 149
 150 (defun sb!kernel:signal-cold-init-or-reinit ()
 151   #!+sb-doc
 152   "Enable all the default signals that Lisp knows how to deal with."
 153   (enable-interrupt sigint #'sigint-handler)
 154   (enable-interrupt sigterm #'sigterm-handler)
 155   (enable-interrupt sigill #'sigill-handler)
 156   (enable-interrupt sigiot #'sigiot-handler)
 157   #!-linux
 158   (enable-interrupt sigemt #'sigemt-handler)
 159   (enable-interrupt sigfpe #'sb!vm:sigfpe-handler)
 160   (enable-interrupt sigbus #'sigbus-handler)
 161   (enable-interrupt sigsegv #'sigsegv-handler)
 162   #!-linux
 163   (enable-interrupt sigsys #'sigsys-handler)
 164   (ignore-interrupt sigpipe)
 165   (enable-interrupt sigalrm #'sigalrm-handler)
 166   (sb!unix::reset-signal-mask)
 167   (values))
 168 \f
 169 ;;;; etc.
 170
 171 ;;; extract si_code from siginfo_t
 172 (sb!alien:define-alien-routine ("siginfo_code" siginfo-code) sb!alien:int
 173   (info system-area-pointer))
 174
 175 ;;; CMU CL comment:
 176 ;;;   Magically converted by the compiler into a break instruction.
 177 (defun receive-pending-interrupt ()
 178   (receive-pending-interrupt))