|
[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 cell.lisp,1.8,1.9 macros.lisp,1.10,1.11 parms.lisp,1.11,1.12
From: <melisgl@us...> - 2005-08-26 22:16
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3407/src/compiler/x86-64
Modified Files:
cell.lisp macros.lisp parms.lisp
Log Message:
0.9.4.8:
* put a TLS-INDEX-LOCK and pseudo-atomic around tls index
allocation to make bind thread and signal safe
Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- cell.lisp 26 Aug 2005 20:30:04 -0000 1.8
+++ cell.lisp 26 Aug 2005 22:16:47 -0000 1.9
@@ -283,22 +283,40 @@
(define-vop (bind)
(:args (val :scs (any-reg descriptor-reg))
(symbol :scs (descriptor-reg)))
+ (:temporary (:sc descriptor-reg :offset rax-offset) rax)
(:temporary (:sc unsigned-reg) tls-index temp bsp)
- (:generator 5
- (let ((tls-index-valid (gen-label)))
+ (:generator 10
+ (let ((tls-index-valid (gen-label))
+ (get-tls-index-lock (gen-label))
+ (release-tls-index-lock (gen-label)))
(load-tl-symbol-value bsp *binding-stack-pointer*)
(loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
(inst add bsp (* binding-size n-word-bytes))
(store-tl-symbol-value bsp *binding-stack-pointer* temp)
-
(inst or tls-index tls-index)
(inst jmp :ne tls-index-valid)
- ;; allocate a new tls-index
- (load-symbol-value tls-index *free-tls-index*)
- (inst add tls-index 8) ;XXX surely we can do this more
- (store-symbol-value tls-index *free-tls-index*) ;succintly
- (inst sub tls-index 8)
- (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
+
+ (pseudo-atomic
+ (emit-label get-tls-index-lock)
+ (inst mov temp 1)
+ (inst xor rax rax)
+ (inst lock)
+ (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp)
+ (inst jmp :ne get-tls-index-lock)
+ ;; now with the lock held, see if the symbol's tls index has
+ ;; been set in the meantime
+ (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
+ (inst or tls-index tls-index)
+ (inst jmp :ne release-tls-index-lock)
+ ;; allocate a new tls-index
+ (load-symbol-value tls-index *free-tls-index*)
+ (inst add tls-index 8) ;XXX surely we can do this more
+ (store-symbol-value tls-index *free-tls-index*) ;succintly
+ (inst sub tls-index 8)
+ (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
+ (emit-label release-tls-index-lock)
+ (store-symbol-value 0 *tls-index-lock*))
+
(emit-label tls-index-valid)
(inst mov temp
(make-ea :qword :base thread-base-tn :scale 1 :index tls-index))
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/macros.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- macros.lisp 14 Jul 2005 19:13:49 -0000 1.10
+++ macros.lisp 26 Aug 2005 22:16:47 -0000 1.11
@@ -52,32 +52,31 @@
(defmacro load-symbol (reg symbol)
`(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol))))
+(defmacro make-ea-for-symbol-value (symbol)
+ `(make-ea :qword
+ :disp (+ nil-value
+ (static-symbol-offset ',symbol)
+ (ash symbol-value-slot word-shift)
+ (- other-pointer-lowtag))))
+
(defmacro load-symbol-value (reg symbol)
- `(inst mov ,reg
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))))
+ `(inst mov ,reg (make-ea-for-symbol-value ,symbol)))
(defmacro store-symbol-value (reg symbol)
- `(inst mov
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-value-slot word-shift)
- (- other-pointer-lowtag)))
- ,reg))
+ `(inst mov (make-ea-for-symbol-value ,symbol) ,reg))
+
+#!+sb-thread
+(defmacro make-ea-for-symbol-tls-index (symbol)
+ `(make-ea :qword
+ :disp (+ nil-value
+ (static-symbol-offset ',symbol)
+ (ash symbol-tls-index-slot word-shift)
+ (- other-pointer-lowtag))))
#!+sb-thread
(defmacro load-tl-symbol-value (reg symbol)
`(progn
- (inst mov ,reg
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-tls-index-slot word-shift)
- (- other-pointer-lowtag))))
+ (inst mov ,reg (make-ea-for-symbol-tls-index ,symbol))
(inst mov ,reg (make-ea :qword :base thread-base-tn :scale 1 :index ,reg))))
#!-sb-thread
(defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol))
@@ -85,12 +84,7 @@
#!+sb-thread
(defmacro store-tl-symbol-value (reg symbol temp)
`(progn
- (inst mov ,temp
- (make-ea :qword
- :disp (+ nil-value
- (static-symbol-offset ',symbol)
- (ash symbol-tls-index-slot word-shift)
- (- other-pointer-lowtag))))
+ (inst mov ,temp (make-ea-for-symbol-tls-index ,symbol))
(inst mov (make-ea :qword :base thread-base-tn :scale 1 :index ,temp) ,reg)))
#!-sb-thread
(defmacro store-tl-symbol-value (reg symbol temp)
Index: parms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/parms.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- parms.lisp 11 Aug 2005 14:44:16 -0000 1.11
+++ parms.lisp 26 Aug 2005 22:16:47 -0000 1.12
@@ -195,6 +195,7 @@
*gc-pending*
*free-tls-index*
+ *tls-index-lock*
*allocation-pointer*
*binding-stack-pointer*
|
| Thread | Author | Date |
|---|---|---|
| [Sbcl-commits] CVS: sbcl/src/compiler/x86-64 cell.lisp,1.8,1.9 macros.lisp,1.10,1.11 parms.lisp,1.11,1.12 | <melisgl@us...> |