[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 alloc.lisp, 1.10, 1.11 cell.lisp, 1.13, 1.14 system.lisp, 1.6, 1.7

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv608/src/compiler/x86-64

Modified Files:
	alloc.lisp cell.lisp system.lisp 
Log Message:
0.9.17.8:
	MORE THREADSAFE FUNCALLABLE-INSTANCE
	... in a threaded world, we can't set the function and lexenv
		of a funcallable instance separately, because some other
		thread might inconveniently funcall the object 'twixt
		the one and the other.
	... instead, make the funcallable-instance-function a 
		fully-fledged slot, and give a funcallable-instance a
		trampoline which knows how to call it.
	... which means implementing this strategy for $n$ 
		architectures.  Tested on x86, x86-64, ppc, alpha and
		sparc; completely untested on mips, and unimplemented
		on hppa.

	This removes some of the complexity in calling closures (the
	closure-self slot is now redundant, as is the extra 
	indirection).  Other miscellaneous fixes:
	* extract-fun-type worked only by accident;
	* new magic :init :funcallable-instance-tramp for primitive 
	  objects
	* verify_space() need no longer worry its little brain about
	  undefined_tramp and closure_tramp (I think)
	* test case for threaded funcallable-instance interaction.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/alloc.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- alloc.lisp	9 Mar 2006 12:58:44 -0000	1.10
+++ alloc.lisp	6 Oct 2006 10:54:16 -0000	1.11
@@ -218,7 +218,6 @@
             (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))
-    (storew result result closure-self-slot fun-pointer-lowtag)
     (loadw temp function closure-fun-slot fun-pointer-lowtag)
     (storew temp result closure-fun-slot fun-pointer-lowtag))))
 
@@ -240,6 +239,12 @@
   (:generator 1
     (inst mov result unbound-marker-widetag)))
 
+(define-vop (make-funcallable-instance-tramp)
+  (:args)
+  (:results (result :scs (any-reg)))
+  (:generator 1
+    (inst lea result (make-fixup "funcallable_instance_tramp" :foreign))))
+
 (define-vop (fixed-alloc)
   (:args)
   (:info name words type lowtag)

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- cell.lisp	15 May 2006 11:56:21 -0000	1.13
+++ cell.lisp	6 Oct 2006 10:54:16 -0000	1.14
@@ -419,9 +419,6 @@
   funcallable-instance-info-offset fun-pointer-lowtag
   (descriptor-reg any-reg) * %funcallable-instance-info)
 
-(define-vop (funcallable-instance-lexenv cell-ref)
-  (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag))
-
 (define-vop (closure-ref slot-ref)
   (:variant closure-info-offset fun-pointer-lowtag))
 

Index: system.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/system.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- system.lisp	15 Nov 2005 12:49:30 -0000	1.6
+++ system.lisp	6 Oct 2006 10:54:16 -0000	1.7
@@ -234,9 +234,6 @@
 (define-source-transform %closure-fun (closure)
   `(%simple-fun-self ,closure))
 
-(define-source-transform %funcallable-instance-fun (fin)
-  `(%simple-fun-self ,fin))
-
 (define-vop (%set-fun-self)
   (:policy :fast-safe)
   (:translate (setf %simple-fun-self))
@@ -251,20 +248,6 @@
                             fun-pointer-lowtag)))
     (storew temp function simple-fun-self-slot fun-pointer-lowtag)
     (move result new-self)))
-
-;;; KLUDGE: This seems to be some kind of weird override of the way
-;;; that the objdef.lisp code would ordinarily set up the slot
-;;; accessor. It's inherited from CMU CL, and it works, and naively
-;;; deleting it seemed to cause problems, but it's not obvious why
-;;; it's done this way. Any ideas? -- WHN 2001-08-02
-(defknown ((setf %funcallable-instance-fun)) (function function) function
-  (unsafe))
-;;; CMU CL comment:
-;;;   We would have really liked to use a source-transform for this, but
-;;;   they don't work with SETF functions.
-;;; FIXME: Can't we just use DEFSETF or something?
-(deftransform (setf %funcallable-instance-fun) ((value fin))
-  '(setf (%simple-fun-self fin) value))
 
 ;;;; other miscellaneous VOPs