[Sbcl-commits] CVS: sbcl/src/compiler/x86 alloc.lisp,1.13,1.14

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8063/src/compiler/x86

Modified Files:
	alloc.lisp 
Log Message:
0.8.18.20:
        * Allocate closures at the beginning of FLET/LABELS form.
        ... fix bug 125.
        * Partial support of stack allocation of dynamic-extent
          closures on x86.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/alloc.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- alloc.lisp	13 Sep 2004 05:40:31 -0000	1.13
+++ alloc.lisp	8 Jan 2005 09:41:50 -0000	1.14
@@ -115,18 +115,19 @@
 
 (define-vop (make-closure)
   (:args (function :to :save :scs (descriptor-reg)))
-  (:info length)
+  (:info length stack-allocate-p)
   (:temporary (:sc any-reg) temp)
   (:results (result :scs (descriptor-reg)))
   (:node-var node)
   (:generator 10
-   (pseudo-atomic
-    (let ((size (+ length closure-info-offset)))
-      (allocation result (pad-data-block size) node)
-      (inst lea result
-	    (make-ea :byte :base result :disp fun-pointer-lowtag))
-      (storew (logior (ash (1- size) n-widetag-bits) closure-header-widetag)
-	      result 0 fun-pointer-lowtag))
+   (maybe-pseudo-atomic stack-allocate-p
+     (let ((size (+ length closure-info-offset)))
+       (allocation result (pad-data-block size) node
+                   stack-allocate-p)
+       (inst lea result
+             (make-ea :byte :base result :disp fun-pointer-lowtag))
+       (storew (logior (ash (1- size) n-widetag-bits) closure-header-widetag)
+               result 0 fun-pointer-lowtag))
     (loadw temp function closure-fun-slot fun-pointer-lowtag)
     (storew temp result closure-fun-slot fun-pointer-lowtag))))