From fd324a9d981355d8bc10d2bd469cb54c4c9108fd Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 20 May 2007 12:34:29 +0000 Subject: [PATCH] 1.0.5.56: conditionally re-enable interrupts interrupting current thread * New variable: *IN-INTERRUPTION* is true IFF we're being called inside *IN-INTERRUPTION* and there are no intervening WITHOUT-INTERRUPTS. * INTERRUPT-THREAD calls the interrupt function inside WITH-INTERRUPTS when interrupting the current thread IFF *IN-INTERRUPTION* is true. * Remove bogus FIXME by yours truly from INVOKE-INTERRUPTION and properly explain what is going on -- and add another FIXME in its place. This makes nested SIGINTs DTRT. --- package-data-list.lisp-expr | 4 +++- src/code/early-impl.lisp | 1 + src/code/signal.lisp | 11 ++++++++++- src/code/target-signal.lisp | 24 +++++++++--------------- src/code/target-thread.lisp | 42 ++++++++++++++++++++++++++---------------- version.lisp-expr | 2 +- 6 files changed, 50 insertions(+), 34 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 79889f3..2e6fb42 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1945,7 +1945,9 @@ SB-KERNEL) have been undone, but probably more remain." "%PRIMITIVE" "%STANDARD-CHAR-P" "*FOREIGN-LOCK*" - "*INTERRUPTS-ENABLED*" "*INTERRUPT-PENDING*" + "*IN-INTERRUPTION*" + "*INTERRUPTS-ENABLED*" + "*INTERRUPT-PENDING*" "*LINKAGE-INFO*" "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*" "*RUNTIME-DLHANDLE*" diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp index ea42696..0e457ca 100644 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@ -33,6 +33,7 @@ ;; pseudo-atomicity too, but they handle it without ;; messing with special variables.) #!+(or x86 x86-64) *pseudo-atomic-bits* + *in-interruption* *interrupts-enabled* *interrupt-pending* *free-interrupt-context-index* diff --git a/src/code/signal.lisp b/src/code/signal.lisp index 41be48f..cc21007 100644 --- a/src/code/signal.lisp +++ b/src/code/signal.lisp @@ -40,6 +40,14 @@ (defvar *interrupts-enabled* t) (defvar *interrupt-pending* nil) +;;; KLUDGE: This tells INTERRUPT-THREAD that it is being invoked as an +;;; interruption, so that if the thread being interrupted is the +;;; current thread it knows to enable interrupts. INVOKE-INTERRUPTION +;;; binds it to T, and WITHOUT-INTERRUPTS binds it to NIL, so that if +;;; interrupts are disable between INTERRUPT-THREAD and this we don't +;;; accidentally re-enable them. +(defvar *in-interruption* nil) + (sb!xc:defmacro without-interrupts (&body body) #!+sb-doc "Execute BODY with all deferrable interrupts deferred. Deferrable interrupts @@ -51,7 +59,8 @@ other threads." `(flet ((,name () ,@body)) (if *interrupts-enabled* (unwind-protect - (let ((*interrupts-enabled* nil)) + (let ((*interrupts-enabled* nil) + (*in-interruption* nil)) (,name)) ;; If we were interrupted in the protected section, then ;; the interrupts are still blocked and it remains so diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index e7e827b..aaebc76 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -13,23 +13,17 @@ (defun invoke-interruption (function) (without-interrupts - ;; FIXME: This is wrong. Imagine the following sequence: + ;; Reset signal mask: the C-side handler has blocked all + ;; deferrable interrupts before arranging return to lisp. This is + ;; safe because we can't get a pending interrupt before we unblock + ;; signals. ;; - ;; 1. an asynch interrupt arrives after entry to - ;; WITHOUT-INTERRUPTS but before RESET-SIGNAL-MASK: pending - ;; machinery blocks all signals and marks the signal as - ;; pending. - ;; - ;; 2. RESET-SIGNAL-MASK is called, and all signals are unblocked. - ;; - ;; 3. Another signal arrives while we already have one pending. - ;; Oops -- we lose(). - ;; - ;; Not sure what the right thing is, but definitely not - ;; RESET-SIGNAL-MASK. Removing it breaks signals.impure.lisp - ;; right now, though, and this is a rare race, so... + ;; FIXME: Should we not reset the _entire_ mask, just restore it + ;; to the state before we got the interrupt? (reset-signal-mask) - (funcall function))) + ;; Tell INTERRUPT-THREAD it's ok to re-enable interrupts. + (let ((*in-interruption* t)) + (funcall function)))) (defmacro in-interruption ((&rest args) &body body) #!+sb-doc diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 8185b81..6f6cd93 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -733,13 +733,15 @@ return DEFAULT if given or else signal JOIN-THREAD-ERROR." (with-mutex ((thread-interruptions-lock ,thread)) ,@body))) -;; Called from the signal handler. +;; Called from the signal handler in C. (defun run-interruption () (in-interruption () (loop (let ((interruption (with-interruptions-lock (*current-thread*) (pop (thread-interruptions *current-thread*))))) (if interruption + ;; This is safe because it's the IN-INTERRUPTION that + ;; has disabled interrupts. (with-interrupts (funcall interruption)) (return)))))) @@ -759,21 +761,29 @@ nature: if you interrupt a thread that was holding important locks then do something that turns out to need those locks, you probably won't like the effect." #!-sb-thread (declare (ignore thread)) - ;; not quite perfect, because it does not take WITHOUT-INTERRUPTS - ;; into account - #!-sb-thread - (funcall function) - #!+sb-thread - (if (eq thread *current-thread*) - (funcall function) - (let ((os-thread (thread-os-thread thread))) - (cond ((not os-thread) - (error 'interrupt-thread-error :thread thread)) - (t - (with-interruptions-lock (thread) - (push function (thread-interruptions thread))) - (when (minusp (signal-interrupt-thread os-thread)) - (error 'interrupt-thread-error :thread thread))))))) + (flet ((interrupt-self () + ;; *IN-INTERRUPTION* is true IFF we're being called as an + ;; interruption without an intervening WITHOUT-INTERRUPTS, + ;; in which case it is safe to enable interrupts. Otherwise + ;; interrupts are either already enabled, or there is an outer + ;; WITHOUT-INTERRUPTS we know nothing about, which makes it + ;; unsafe to enable interrupts. + (if *in-interruption* + (with-interrupts (funcall function)) + (funcall function)))) + #!-sb-thread + (interrupt-self) + #!+sb-thread + (if (eq thread *current-thread*) + (interrupt-self) + (let ((os-thread (thread-os-thread thread))) + (cond ((not os-thread) + (error 'interrupt-thread-error :thread thread)) + (t + (with-interruptions-lock (thread) + (push function (thread-interruptions thread))) + (when (minusp (signal-interrupt-thread os-thread)) + (error 'interrupt-thread-error :thread thread)))))))) (defun terminate-thread (thread) #!+sb-doc diff --git a/version.lisp-expr b/version.lisp-expr index b49a5d6..f39562f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.5.55" +"1.0.5.56" -- 1.7.10.4