[Sbcl-commits] CVS: sbcl/src/code signal.lisp,1.20,1.21

[Juho S. <js...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv28413/src/code

Modified Files:
	signal.lisp 
Log Message:
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. 



Index: signal.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/signal.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- signal.lisp	8 Jun 2007 12:15:46 -0000	1.20
+++ signal.lisp	11 Jun 2007 03:29:23 -0000	1.21
@@ -90,20 +90,47 @@
     (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