From: Juho Snellman <jsnell@iki.fi>
Date: Mon, 11 Jun 2007 03:29:23 +0000 (+0000)
Subject: 1.0.6.44: make WITHOUT-INTERRUPTS non-consing
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=911adc876f0c319ccd612d8ad563d3c215aa3de1;p=sbcl.git

1.0.6.44: make WITHOUT-INTERRUPTS non-consing

	* Consing up a closure for CALL-WITHOUT-INTERRUPTS is a performance
          problem, stack-allocate the closure on platforms with dx support.
        * Doing the stack-allocation properly is a bit tricky, encapsulate
          the right way into the CALL-WITH-DX-FUNCTION macro.
        * TODO: apply the same procedure to other CALL-WITH-FOOs.
---

diff --git a/src/code/signal.lisp b/src/code/signal.lisp
index fca9c58..a7db12d 100644
--- a/src/code/signal.lisp
+++ b/src/code/signal.lisp
@@ -90,20 +90,47 @@ 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)))
+    `(call-with-dx-function (call-without-interrupts
+                             ,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)))))
+         ,@body))))
+
+;;; Helper for making the DX closure allocation in WITHOUT-INTERRUPTS
+;;; less ugly.
+;;;
+;;; TODO: generalize for cases where FUNCTION takes more arguments
+;;; than just the thunk; use in other WITH-FOO macros that expand to a
+;;; CALL-WITH-FOO. I just did WITHOUT-INTERRUPTS since it's
+;;; performance critical (for example each call to GETHASH was consing
+;;; 48 bytes of WITHOUT-INTERRUPTS closures). --JES, 2007-06-08
+(sb!xc:defmacro call-with-dx-function ((function &rest args) &body body)
+  (with-unique-names (fun1 fun2)
+    `(flet ((,fun1 (,@args)
+              ,@body))
+       (declare (optimize sb!c::stack-allocate-dynamic-extent))
+       (flet ((,fun2 (,@args)
+                ;; Avoid consing up a closure: FUN1 will be inlined
+                ;; and FUN2 will be stack-allocated, so we avoid
+                ;; consing up a closure. This is split into two
+                ;; separate functions to ensure that the body doesn't
+                ;; get compiled with (OPTIMIZE
+                ;; SB!C::STACK-ALLOCATE-DYNAMIC-EXTENT), which could
+                ;; cause problems e.g. when the body contains
+                ;; DYNAMIC-EXTENT declarations and the code is being
+                ;; compiled with (SAFETY 3).
+                (,fun1 ,@args)))
+         (declare (dynamic-extent (function ,fun2)))
+         (,function (function ,fun2))))))
 
 (sb!xc:defmacro with-interrupts (&body body)
   #!+sb-doc
diff --git a/version.lisp-expr b/version.lisp-expr
index f7a79d0..65231a4 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.6.43"
+"1.0.6.44"