Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/assembly/x86
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv8414/src/assembly/x86

Modified Files:
	alloc.lisp 
Log Message:
1.0.15.7: threaded BIND and UNBIND improvements on x86

 * TLS index allocation is rare, so move it out of line from BIND.
   Shrinks the threaded core by over 170k bytes.

 * Make UNBIND use three registers instead of four.


Index: alloc.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/x86/alloc.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- alloc.lisp	2 Jan 2008 12:04:09 -0000	1.7
+++ alloc.lisp	1 Mar 2008 19:25:41 -0000	1.8
@@ -78,3 +78,50 @@
                                                          (intern (aref *dword-register-names* tn-offset)))
                        routines)))))
   (frob-cons-routines))
+
+#+sb-assembling
+(macrolet ((def (reg)
+             (let* ((name (intern (format nil "ALLOCATE-TLS-INDEX-IN-~A" reg)))
+                    (target-offset (intern (format nil "~A-OFFSET" reg)))
+                    (other-offset (if (eql 'eax reg)
+                                      'ecx-offset
+                                      'eax-offset)))
+               ;; Symbol starts in TARGET, where the TLS-INDEX ends up in.
+               `(define-assembly-routine ,name
+                    ((:temp other descriptor-reg ,other-offset)
+                     (:temp target descriptor-reg ,target-offset))
+                  (let ((get-tls-index-lock (gen-label))
+                        (release-tls-index-lock (gen-label)))
+                    (pseudo-atomic
+                     ;; Save OTHER & push the symbol. EAX is either one of the two.
+                     (inst push other)
+                     (inst push target)
+                     (emit-label get-tls-index-lock)
+                     (inst mov target 1)
+                     (inst xor eax-tn eax-tn)
+                     (inst lock)
+                     (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) target)
+                     (inst jmp :ne get-tls-index-lock)
+                     ;; The symbol is now in OTHER.
+                     (inst pop other)
+                     ;; Now with the lock held, see if the symbol's tls index has been
+                     ;; set in the meantime.
+                     (loadw target other symbol-tls-index-slot other-pointer-lowtag)
+                     (inst or target target)
+                     (inst jmp :ne release-tls-index-lock)
+                     ;; Allocate a new tls-index.
+                     (load-symbol-value target *free-tls-index*)
+                     (inst add (make-ea-for-symbol-value *free-tls-index*) 4) ; fixnum + 1
+                     (storew target other symbol-tls-index-slot other-pointer-lowtag)
+                     (emit-label release-tls-index-lock)
+                     (store-symbol-value 0 *tls-index-lock*)
+                     ;; Restore OTHER.
+                     (inst pop other))
+                    (inst ret))))))
+  (def eax)
+  (def ebx)
+  (def ecx)
+  (def edx)
+  (def edi)
+  (def esi))
+