1.0.6.56: replace CALL-WITH-DX-FUNCTION with DX-FLET

[sbcl.git] / src / code / signal.lisp

diff --git a/src/code/signal.lisp b/src/code/signal.lisp
index fca9c58..02a215a 100644 (file)
--- 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))