X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsignal.lisp;h=a4c529878aba4eb1ff4de5f6298c0fd67e6e05b0;hb=5bad55941fafc315116f6fcf2c8c2cce8af7ed9a;hp=7b1b6799be6d822995b919605250cf0271291eff;hpb=68a83a65688bb578163c502e045da298d20a1f0c;p=sbcl.git diff --git a/src/code/signal.lisp b/src/code/signal.lisp index 7b1b679..a4c5298 100644 --- a/src/code/signal.lisp +++ b/src/code/signal.lisp @@ -23,29 +23,27 @@ ;;; sets *interrupt-pending* and returns without handling the signal. ;;; ;;; When we drop out the without interrupts, we check to see whether -;;; *interrupt-pending* has been set. If so, we call -;;; do-pending-interrupt, which generates a SIGTRAP. The C code +;;; *INTERRUPT-PENDING* has been set. If so, we call +;;; RECEIVE-PENDING-INTERRUPT, which generates a SIGTRAP. The C code ;;; invokes the handler for the saved signal instead of the SIGTRAP ;;; after replacing the signal mask in the signal context with the ;;; saved value. When that hander returns, the original signal mask is ;;; installed, allowing any other pending signals to be handled. ;;; -;;; This means that the cost of without-interrupts is just a special +;;; This means that the cost of WITHOUT-INTERRUPTS is just a special ;;; binding in the case when no signals are delivered (the normal ;;; case). It's only when a signal is actually delivered that we use ;;; any system calls, and by then the cost of the extra system calls ;;; are lost in the noise when compared with the cost of delivering ;;; the signal in the first place. -#!-gengc (progn - (defvar *interrupts-enabled* t) (defvar *interrupt-pending* nil) (sb!xc:defmacro without-interrupts (&body body) #!+sb-doc "Execute BODY in a context impervious to interrupts." - (let ((name (gensym))) + (let ((name (gensym "WITHOUT-INTERRUPTS-BODY-"))) `(flet ((,name () ,@body)) (if *interrupts-enabled* (unwind-protect @@ -57,7 +55,7 @@ ;; whether interrupts are pending before executing themselves ;; immediately? (when *interrupt-pending* - (do-pending-interrupt))) + (receive-pending-interrupt))) (,name))))) (sb!xc:defmacro with-interrupts (&body body) @@ -70,175 +68,5 @@ (,name) (let ((*interrupts-enabled* t)) (when *interrupt-pending* - (do-pending-interrupt)) + (receive-pending-interrupt)) (,name)))))) - -) ; PROGN - -;;; On the GENGC system, we have to do it slightly differently because of the -;;; existence of threads. Each thread has a suspends_disabled_count in its -;;; mutator structure. When this value is other then zero, the low level stuff -;;; will not suspend the thread, but will instead set the suspend_pending flag -;;; (also in the mutator). So when we finish the without-interrupts, we just -;;; check the suspend_pending flag and trigger a do-pending-interrupt if -;;; necessary. - -#!+gengc -(defmacro without-interrupts (&body body) - `(unwind-protect - (progn - (locally - (declare (optimize (speed 3) (safety 0))) - (incf (sb!kernel:mutator-interrupts-disabled-count))) - ,@body) - (locally - (declare (optimize (speed 3) (safety 0))) - (when (and (zerop (decf (sb!kernel:mutator-interrupts-disabled-count))) - (not (zerop (sb!kernel:mutator-interrupt-pending)))) - (do-pending-interrupt))))) - -;;;; utilities for dealing with signal names and numbers - -(defstruct (unix-signal - (:constructor make-unix-signal (%name %number)) - (:copier nil)) - ;; signal keyword (e.g. :SIGINT for the Unix SIGINT signal) - (%name (required-argument) :type keyword :read-only t) - ;; signal number - (%number (required-argument) :type integer :read-only t)) - -;;; list of all defined UNIX-SIGNALs -(defvar *unix-signals* nil) - -(defmacro !def-unix-signal (name number) - (declare (type keyword name)) - (declare (type (and fixnum unsigned-byte) number)) - `(push (make-unix-signal ,name ,number) *unix-signals*)) - -(/show0 "signal.lisp 131") - -(defun unix-signal-or-lose (designator) - (or (find designator (the list *unix-signals*) - :key (etypecase designator - (symbol #'unix-signal-%name) - (number #'unix-signal-%number))) - (error "not a valid signal name or number: ~S" designator))) - -(/show0 "signal.lisp 142") - -;;; Return the name of the designated signal. -(defun unix-signal-name (designator) - (symbol-name (unix-signal-%name (unix-signal-or-lose designator)))) - -(/show0 "signal.lisp 150") - -;;; Return the number of the designated signal. -(defun unix-signal-number (designator) - (unix-signal-%number (unix-signal-or-lose designator))) - -(/show0 "signal.lisp 168") - -;;; known signals -(/show0 "defining Unix signals") -(!def-unix-signal :CHECK 0) ; check -(/show0 "done defining CHECK") -(!def-unix-signal :SIGHUP 1) ; hangup -(/show0 "done defining SIGHUP") -(!def-unix-signal :SIGINT 2) ; interrupt -(/show0 "done defining SIGINT") -(!def-unix-signal :SIGQUIT 3) ; quit -(!def-unix-signal :SIGILL 4) ; illegal instruction -(!def-unix-signal :SIGTRAP 5) ; trace trap -(!def-unix-signal :SIGIOT 6) ; IOT instruction -#!-linux -(!def-unix-signal :SIGEMT 7) ; EMT instruction -(!def-unix-signal :SIGFPE 8) ; floating point exception -(!def-unix-signal :SIGKILL 9) ; kill -(!def-unix-signal :SIGBUS #!-linux 10 #!+linux 7) ; bus error -(!def-unix-signal :SIGSEGV 11) ; segmentation violation -#!-linux -(!def-unix-signal :SIGSYS 12) ; bad argument to system call -(!def-unix-signal :SIGPIPE 13) ; write on a pipe with no one to read it -(!def-unix-signal :SIGALRM 14) ; alarm clock -(!def-unix-signal :SIGTERM 15) ; software termination signal -#!+linux -(!def-unix-signal :SIGSTKFLT 16) ; stack fault on coprocessor -(!def-unix-signal :SIGURG ; urgent condition present on socket - #!+svr4 21 - #!-(or hpux svr4 linux) 16 - #!+hpux 29 - #!+linux 23) -(!def-unix-signal :SIGSTOP ; stop - #!-(or hpux svr4 linux) 17 - #!+hpux 24 - #!+svr4 23 - #!+linux 19) -(!def-unix-signal :SIGTSTP ; stop signal generated from keyboard - #!-(or hpux svr4 linux) 18 - #!+hpux 25 - #!+svr4 24 - #!+linux 20) -(!def-unix-signal :SIGCONT ; continue after stop - #!-(or hpux svr4 linux) 19 - #!+hpux 26 - #!+svr4 25 - #!+linux 18) -(!def-unix-signal :SIGCHLD ; Child status has changed. - #!-(or linux hpux) 20 - #!+hpux 18 - #!+linux 17) -(!def-unix-signal :SIGTTIN ; background read attempted from control terminal - #!-(or hpux svr4) 21 - #!+hpux 27 - #!+svr4 26) -(!def-unix-signal :SIGTTOU ; background write attempted to control terminal - #!-(or hpux svr4) 22 - #!+hpux 28 - #!+svr4 27) -(!def-unix-signal :SIGIO ; I/O is possible on a descriptor. - #!-(or hpux irix linux) 23 - #!+(or hpux irix) 22 - #!+linux 29) -#!-hpux -(!def-unix-signal :SIGXCPU ; CPU time limit exceeded - #!-svr4 24 - #!+svr4 30) -#!-hpux -(!def-unix-signal :SIGXFSZ ; file size limit exceeded - #!-svr4 25 - #!+svr4 31) -(!def-unix-signal :SIGVTALRM ; virtual time alarm - #!-(or hpux svr4) 26 - #!+hpux 20 - #!+svr4 28) -(!def-unix-signal :SIGPROF ; profiling timer alarm - #!-(or hpux svr4 linux) 27 - #!+hpux 21 - #!+svr4 29 - #!+linux 30) -(!def-unix-signal :SIGWINCH ; window size change - #!-(or hpux svr4) 28 - #!+hpux 23 - #!+svr4 20) -(!def-unix-signal :SIGUSR1 ; user-defined signal 1 - #!-(or hpux svr4 linux) 30 - #!+(or hpux svr4) 16 - #!+linux 10) -(!def-unix-signal :SIGUSR2 ; user-defined signal 2 - #!-(or hpux svr4 linux) 31 - #!+(or hpux svr4) 17 - #!+linux 12) - -;;; SVR4 (or Solaris?) specific signals -#!+svr4 -(!def-unix-signal :SIGWAITING 32) ; Process's LWPs are blocked. - -(sb!xc:defmacro sigmask (&rest signals) - #!+sb-doc - "Returns a mask given a set of signals." - (apply #'logior - (mapcar (lambda (signal) - (ash 1 (1- (unix-signal-number signal)))) - signals))) - -(/show0 "done with signal.lisp")