X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsignal.lisp;h=02a215af07f92c5992aed74dad2b8631cc1a4012;hb=95a76d208004b4ad58ebee3bf36a3f4ae75fdb46;hp=fca9c580e579dfb5eaa78a027b35428285333bc3;hpb=c548f73e8dd676d6ec4576eba6ab661a5061bdfe;p=sbcl.git

diff --git a/src/code/signal.lisp b/src/code/signal.lisp
index fca9c58..02a215a 100644
--- a/src/code/signal.lisp
+++ b/src/code/signal.lisp
@@ -90,20 +90,26 @@ WITHOUT-INTERRUPTS in:
     (lambda () (with-local-interrupts ...)))
 "
   (with-unique-names (outer-allow-with-interrupts)
-    `(call-without-interrupts
-      (lambda (,outer-allow-with-interrupts)
-        (declare (disable-package-locks allow-with-interrupts with-interrupts)
-                 (ignorable ,outer-allow-with-interrupts))
-        (macrolet ((allow-with-interrupts (&body allow-forms)
-                     `(call-allowing-with-interrupts
-                       (lambda () ,@allow-forms)
-                       ,',outer-allow-with-interrupts))
-                   (with-local-interrupts (&body with-forms)
-                     `(call-with-local-interrupts
-                       (lambda () ,@with-forms)
-                       ,',outer-allow-with-interrupts)))
-         (declare (enable-package-locks allow-with-interrupts with-interrupts))
-         ,@body)))))
+    `(dx-flet ((without-interrupts-thunk (,outer-allow-with-interrupts)
+                 (declare (disable-package-locks allow-with-interrupts
+                                                 with-interrupts)
+                          (ignorable ,outer-allow-with-interrupts))
+                 (macrolet ((allow-with-interrupts (&body allow-forms)
+                              `(dx-flet ((allow-with-interrupts-thunk ()
+                                            ,@allow-forms))
+                                 (call-allowing-with-interrupts
+                                  #'allow-with-interrupts-thunk
+                                  ,',outer-allow-with-interrupts)))
+                            (with-local-interrupts (&body with-forms)
+                              `(dx-flet ((with-local-interrupts-thunk ()
+                                           ,@with-forms))
+                                 (call-with-local-interrupts
+                                  #'with-local-interrupts-thunk
+                                  ,',outer-allow-with-interrupts))))
+                   (declare (enable-package-locks allow-with-interrupts
+                                                  with-interrupts))
+                   ,@body)))
+       (call-without-interrupts #'without-interrupts-thunk))))
 
 (sb!xc:defmacro with-interrupts (&body body)
   #!+sb-doc
@@ -114,9 +120,10 @@ As interrupts are normally allowed WITH-INTERRUPTS only makes sense if there
 is an outer WITHOUT-INTERRUPTS with a corresponding ALLOW-WITH-INTERRUPTS:
 interrupts are not enabled if any outer WITHOUT-INTERRUPTS is not accompanied
 by ALLOW-WITH-INTERRUPTS."
-  `(call-with-interrupts
-    (lambda () ,@body)
-    (and (not *interrupts-enabled*) *allow-with-interrupts*)))
+  `(dx-flet ((with-interrupts-thunk () ,@body))
+     (call-with-interrupts
+      #'with-interrupts-thunk
+      (and (not *interrupts-enabled*) *allow-with-interrupts*))))
 
 (defun call-allowing-with-interrupts (function allowp)
   (declare (function function))