From: Christophe R. <cr...@us...> - 2006-10-06 10:54:21
|
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 |