From 939275c1bc2f18ef93cd1dd4ab35a18f6008cfd9 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Fri, 26 Aug 2005 22:16:47 +0000 Subject: [PATCH] 0.9.4.8: * put a TLS-INDEX-LOCK and pseudo-atomic around tls index allocation to make bind thread and signal safe --- NEWS | 2 ++ src/compiler/x86-64/cell.lisp | 36 ++++++++++++++++++++++++-------- src/compiler/x86-64/macros.lisp | 44 +++++++++++++++++---------------------- src/compiler/x86-64/parms.lisp | 1 + src/compiler/x86/cell.lisp | 36 ++++++++++++++++++++++++-------- src/compiler/x86/macros.lisp | 44 +++++++++++++++++---------------------- src/compiler/x86/parms.lisp | 1 + src/runtime/dynbind.c | 25 +++++++++++++++------- src/runtime/thread.c | 4 +++- version.lisp-expr | 2 +- 10 files changed, 118 insertions(+), 77 deletions(-) diff --git a/NEWS b/NEWS index af2db8d..39717a2 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,8 @@ changes in sbcl-0.9.5 relative to sbcl-0.9.4: ** bug fix: binding a special with PROGV to no value is not the same as that symbol not having been bound (thanks to Hannu Koivisto) + ** bug fix: binding specials is thread safe (thanks to + Hannu Koivisto) * fixed some bugs revealed by Paul Dietz' test suite: ** ENSURE-GENERIC-FUNCTION should take a method class object for the :method-class keyword argument. diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 6a3a89c..3d4b698 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -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)) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 0a1ae74..4a6a36b 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -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) diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index 1a68504..f80bbf2 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -195,6 +195,7 @@ *gc-pending* *free-tls-index* + *tls-index-lock* *allocation-pointer* *binding-stack-pointer* diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 74c23e9..f8b139e 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -287,22 +287,40 @@ (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) + (:temporary (:sc descriptor-reg :offset eax-offset) eax) (: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 4) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 4) - (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 eax eax) + (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 4) ;XXX surely we can do this more + (store-symbol-value tls-index *free-tls-index*) ;succintly + (inst sub tls-index 4) + (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 fs-segment-prefix) (inst mov temp (make-ea :dword :scale 1 :index tls-index)) diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 477a806..b0f685f 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -67,32 +67,31 @@ (defmacro load-symbol (reg symbol) `(inst mov ,reg (+ nil-value (static-symbol-offset ,symbol)))) +(defmacro make-ea-for-symbol-value (symbol) + `(make-ea :dword + :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 :dword - :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 :dword - :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 :dword + :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 :dword - :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 fs-segment-prefix) (inst mov ,reg (make-ea :dword :scale 1 :index ,reg)))) #!-sb-thread @@ -101,12 +100,7 @@ #!+sb-thread (defmacro store-tl-symbol-value (reg symbol temp) `(progn - (inst mov ,temp - (make-ea :dword - :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 fs-segment-prefix) (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg))) #!-sb-thread diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 23fc57b..0107ecd 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -315,6 +315,7 @@ *gc-pending* *free-tls-index* + *tls-index-lock* *allocation-pointer* *binding-stack-pointer* diff --git a/src/runtime/dynbind.c b/src/runtime/dynbind.c index 8c2d26a..da22189 100644 --- a/src/runtime/dynbind.c +++ b/src/runtime/dynbind.c @@ -36,16 +36,27 @@ void bind_variable(lispobj symbol, lispobj value, void *th) lispobj old_tl_value; struct binding *binding; struct thread *thread=(struct thread *)th; -#ifdef LISP_FEATURE_SB_THREAD - struct symbol *sym=(struct symbol *)native_pointer(symbol); -#endif binding = GetBSP(); SetBSP(binding+1); #ifdef LISP_FEATURE_SB_THREAD - if(!sym->tls_index) { - sym->tls_index=SymbolValue(FREE_TLS_INDEX,0); - SetSymbolValue(FREE_TLS_INDEX, - make_fixnum(fixnum_value(sym->tls_index)+1),0); + { + struct symbol *sym=(struct symbol *)native_pointer(symbol); + if(!sym->tls_index) { + lispobj *tls_index_lock= + &((struct symbol *)native_pointer(TLS_INDEX_LOCK))->value; + SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th); + SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th); + get_spinlock(tls_index_lock,(long)th); + if(!sym->tls_index) { + sym->tls_index=SymbolValue(FREE_TLS_INDEX,0); + SetSymbolValue(FREE_TLS_INDEX, + make_fixnum(fixnum_value(sym->tls_index)+1),0); + } + release_spinlock(tls_index_lock); + SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th); + if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th))) + do_pending_interrupt(); + } } #endif old_tl_value=SymbolTlValue(symbol,thread); diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 117e3ec..0377562 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -174,12 +174,14 @@ create_thread_struct(lispobj initial_function) { int i; for(i=0;i<(dynamic_values_bytes/sizeof(lispobj));i++) per_thread->dynamic_values[i]=NO_TLS_VALUE_MARKER_WIDETAG; - if(SymbolValue(FREE_TLS_INDEX,0)==UNBOUND_MARKER_WIDETAG) + if(SymbolValue(FREE_TLS_INDEX,0)==UNBOUND_MARKER_WIDETAG) { SetSymbolValue (FREE_TLS_INDEX, make_fixnum(MAX_INTERRUPTS+ sizeof(struct thread)/sizeof(lispobj)), 0); + SetSymbolValue(TLS_INDEX_LOCK,make_fixnum(0),0); + } #define STATIC_TLS_INIT(sym,field) \ ((struct symbol *)(sym-OTHER_POINTER_LOWTAG))->tls_index= \ make_fixnum(THREAD_SLOT_OFFSET_WORDS(field)) diff --git a/version.lisp-expr b/version.lisp-expr index 0a106d9..6f0e405 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.4.7" +"0.9.4.8" -- 1.7.10.4