From: Nikodemus S. <de...@us...> - 2008-03-01 19:25:45
|
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)) + |