Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv8791/src/code
Modified Files:
target-signal.lisp
Log Message:
1.0.16.39: small lisp-side interrupt handling improvements
* In INVOKE-INTERRUPTION, disable interrupts before doing the interrupt
handler bindings -- no point in making the window for recursive interrupts
any bigger then it already is.
* Similarly, ALLOW-WITH-INTERRUPTS only after the *STACK-TOP-HINT*
has been computed. (Actually, the stack top hint computation should
not be done for all interrupts, instead it would be better to add
an argument to indicate we want to start from the interrupted frame
to MAP-BACKTRACE.)
* Declare the &REST argument of (FLET RUN-HANDLER) dynamic extent.
Index: target-signal.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-signal.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- target-signal.lisp 28 Jan 2008 15:11:00 -0000 1.42
+++ target-signal.lisp 19 May 2008 14:06:28 -0000 1.43
@@ -30,8 +30,8 @@
,@body)))
(defun invoke-interruption (function)
- (with-interrupt-bindings
- (without-interrupts
+ (without-interrupts
+ (with-interrupt-bindings
;; 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
@@ -40,9 +40,8 @@
;; FIXME: Should we not reset the _entire_ mask, but just
;; restore it to the state before we got the interrupt?
(reset-signal-mask)
- (allow-with-interrupts
- (let ((sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
- (funcall function))))))
+ (let ((sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
+ (allow-with-interrupts (funcall function))))))
(defmacro in-interruption ((&key) &body body)
#!+sb-doc
@@ -93,6 +92,7 @@
(declare (type (or function fixnum (member :default :ignore)) handler))
(/show0 "enable-interrupt")
(flet ((run-handler (&rest args)
+ (declare (dynamic-extent args))
(in-interruption ()
(apply handler args))))
(without-gcing
|