X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=9ad1f365d850d17c6d531c5e503af25779a8932c;hb=f0d511130027c6878f08d619ccc92ef588d81223;hp=7320196b8814bd6aa839d544abd60ebdf8acfab2;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 7320196..9ad1f36 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -18,64 +18,52 @@ ;;;; system calls that deal with signals #!-sb-fluid (declaim (inline real-unix-kill)) -(sb!alien:def-alien-routine ("kill" real-unix-kill) sb!c-call:int - (pid sb!c-call:int) - (signal sb!c-call:int)) +(sb!alien:define-alien-routine ("kill" real-unix-kill) sb!alien:int + (pid sb!alien:int) + (signal sb!alien:int)) +;;; Send the signal SIGNAL to the process with process id PID. SIGNAL +;;; should be a valid signal number or a keyword of the standard UNIX +;;; signal name. (defun unix-kill (pid signal) - #!+sb-doc - "Unix-kill sends the signal signal to the process with process - id pid. Signal should be a valid signal number or a keyword of the - standard UNIX signal name." (real-unix-kill pid (unix-signal-number signal))) #!-sb-fluid (declaim (inline real-unix-killpg)) -(sb!alien:def-alien-routine ("killpg" real-unix-killpg) sb!c-call:int - (pgrp sb!c-call:int) - (signal sb!c-call:int)) +(sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int + (pgrp sb!alien:int) + (signal sb!alien:int)) +;;; Send the signal SIGNAL to the all the process in process group +;;; PGRP. SIGNAL should be a valid signal number or a keyword of the +;;; standard UNIX signal name. (defun unix-killpg (pgrp signal) - #!+sb-doc - "Unix-killpg sends the signal signal to the all the process in process - group PGRP. Signal should be a valid signal number or a keyword of - the standard UNIX signal name." (real-unix-killpg pgrp (unix-signal-number signal))) -(sb!alien:def-alien-routine ("sigblock" unix-sigblock) sb!c-call:unsigned-long - #!+sb-doc - "Unix-sigblock cause the signals specified in mask to be - added to the set of signals currently being blocked from - delivery. The macro sigmask is provided to create masks." - (mask sb!c-call:unsigned-long)) - -(sb!alien:def-alien-routine ("sigpause" unix-sigpause) sb!c-call:void - #!+sb-doc - "Unix-sigpause sets the set of masked signals to its argument - and then waits for a signal to arrive, restoring the previous - mask upon its return." - (mask sb!c-call:unsigned-long)) - -(sb!alien:def-alien-routine ("sigsetmask" unix-sigsetmask) - sb!c-call:unsigned-long - #!+sb-doc - "Unix-sigsetmask sets the current set of masked signals (those - begin blocked from delivery) to the argument. The macro sigmask - can be used to create the mask. The previous value of the signal - mask is returned." - (mask sb!c-call:unsigned-long)) +;;; Set the current set of masked signals (those being blocked from +;;; delivery). +;;; +;;; (Note: CMU CL had a SIGMASK operator to create masks, but since +;;; SBCL only uses 0, we no longer support it. If you need it, you +;;; can pull it out of the CMU CL sources, or the old SBCL sources; +;;; but you might also consider doing things the SBCL way and moving +;;; this kind of C-level work down to C wrapper functions.) +#!-sunos +(sb!alien:define-alien-routine ("sigsetmask" unix-sigsetmask) + sb!alien:unsigned-long + (mask sb!alien:unsigned-long)) ;;;; C routines that actually do all the work of establishing signal handlers -(sb!alien:def-alien-routine ("install_handler" install-handler) - sb!c-call:unsigned-long - (signal sb!c-call:int) - (handler sb!c-call:unsigned-long)) +(sb!alien:define-alien-routine ("install_handler" install-handler) + sb!alien:unsigned-long + (signal sb!alien:int) + (handler sb!alien:unsigned-long)) ;;;; interface to enabling and disabling signal handlers -(defun enable-interrupt (signal handler) +(defun enable-interrupt (signal-designator handler) (declare (type (or function (member :default :ignore)) handler)) (without-gcing - (let ((result (install-handler (unix-signal-number signal) + (let ((result (install-handler (unix-signal-number signal-designator) (case handler (:default sig_dfl) (:ignore sig_ign) @@ -96,6 +84,13 @@ ;;;; ;;;; Most of these just call ERROR to report the presence of the signal. +;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores +;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that +;;; SIGINT in --disable-debugger mode will cleanly terminate the system +;;; (by respecting the *DEBUGGER-HOOK* established in that mode). +(defun sigint-%break (format-string &rest format-arguments) + (apply #'%break 'sigint format-string format-arguments)) + (eval-when (:compile-toplevel :execute) (sb!xc:defmacro define-signal-handler (name what @@ -108,7 +103,7 @@ (with-alien ((context (* os-context-t) context)) (sap-int (sb!vm:context-pc context))))))) -(define-signal-handler sigint-handler "interrupted" break) +(define-signal-handler sigint-handler "interrupted" sigint-%break) (define-signal-handler sigill-handler "illegal instruction") (define-signal-handler sigtrap-handler "breakpoint/trap") (define-signal-handler sigiot-handler "SIGIOT") @@ -123,7 +118,7 @@ (defun sigquit-handler (signal code context) (declare (ignore signal code context)) - (throw 'sb!impl::top-level-catcher nil)) + (throw 'sb!impl::toplevel-catcher nil)) (defun sb!kernel:signal-cold-init-or-reinit () #!+sb-doc @@ -142,7 +137,14 @@ (enable-interrupt :sigsys #'sigsys-handler) (enable-interrupt :sigpipe #'sigpipe-handler) (enable-interrupt :sigalrm #'sigalrm-handler) - nil) + (values)) + +;;;; etc. + +;;; CMU CL comment: +;;; Magically converted by the compiler into a break instruction. +(defun receive-pending-interrupt () + (receive-pending-interrupt)) ;;; stale code which I'm insufficiently motivated to test -- WHN 19990714 #|