From af4d83b57531e98d455f31980ef6359465d3d5a7 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Thu, 17 Nov 2005 12:13:35 +0000 Subject: [PATCH] 0.9.6.48: more stability * zero the value on the binding stack when UNBINDing to prevent gc lossage under rare circumstances (see internals manual) --- contrib/sb-md5/md5-tests.lisp | 2 +- doc/internals/specials.texinfo | 55 +++++++++++++++++++++++++++++++++++++ src/compiler/alpha/cell.lisp | 2 ++ src/compiler/hppa/cell.lisp | 2 ++ src/compiler/mips/cell.lisp | 2 ++ src/compiler/ppc/cell.lisp | 2 ++ src/compiler/sparc/cell.lisp | 2 ++ src/compiler/x86-64/cell.lisp | 3 ++ src/compiler/x86/cell.lisp | 3 ++ tests/threads.impure.lisp | 59 ++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 11 files changed, 132 insertions(+), 2 deletions(-) create mode 100644 doc/internals/specials.texinfo diff --git a/contrib/sb-md5/md5-tests.lisp b/contrib/sb-md5/md5-tests.lisp index 5c0aff6..40b3052 100644 --- a/contrib/sb-md5/md5-tests.lisp +++ b/contrib/sb-md5/md5-tests.lisp @@ -34,7 +34,7 @@ t) into test-forms finally (return `(progn ,@test-forms)))) ) ; EVAL-WHEN - + (macrolet ((define-rfc1321-tests (test-list) `(progn diff --git a/doc/internals/specials.texinfo b/doc/internals/specials.texinfo new file mode 100644 index 0000000..036851e --- /dev/null +++ b/doc/internals/specials.texinfo @@ -0,0 +1,55 @@ +@node Specials +@comment node-name, next, previous, up +@chapter Specials + +@menu +* Overview:: +* Binding and unbinding:: +@end menu + +@node Overview +@section Overview + +Unithread SBCL uses a shallow binding scheme: the current value of a +symbol is stored directly in its value slot. Accessing specials is +pretty fast but it's still a lot slower than accessing lexicals. + +With multithreading it's slightly more complicated. The symbol's value +slot contains the global value and each symbol has a @code{TLS-INDEX} +slot that - when it's first bound - is set to a unique index of the +thread local area reserved for this purpose. The tls index is +initially zero and at index zero in the tls @code{NO-TLS-VALUE-MARKER} +resides. @code{NO-TLS-VALUE-MARKER} is different from +@code{UNBOUND-MARKER} to allow @code{PROGV} to bind a special to no +value locally in a thread. + +@node Binding and unbinding +@section Binding and unbinding + +Binding goes like this: the binding stack pointer (bsp) is bumped, old +value and symbol are stored at bsp - 1, new value is stored in +symbol's value slot or the tls. + +Unbinding: the symbol's value is restored from bsp - 1, value and +symbol at bsp - 1 are set to zero, and finally bsp is decremented. + +The @code{UNBIND-TO-HERE} VOP assists in unwinding the stack. It +iterates over the bindings on the binding stack until it reaches the +prescribed point. For each binding with a non-zero symbol it does an +@code{UNBIND}. + +How can a binding's symbol be zero? @code{BIND} is not pseudo atomic +(for performance reasons) and it can be interrupted by a signal. If +the signal hits after the bsp is incremented but before the values on +the stack are set the symbol is zero because a thread starts with a +zeroed tls plus @code{UNBIND} and @code{UNBIND-TO-HERE} both zero the +binding being unbound. + +Zeroing the binding's symbol would not be enough as the binding's +value can be moved or garbage collected and if the above interrupt +initiates gc (or be @code{SIG_STOP_FOR_GC}) it will be greeted by a +garbage pointer. + +Furthermore, @code{BIND} must always write the value to the binding +stack first and the symbol second because the symbol being non-zero +means validity to @code{UNBIND-TO-HERE}. diff --git a/src/compiler/alpha/cell.lisp b/src/compiler/alpha/cell.lisp index 0a02a9f..8347d6f 100644 --- a/src/compiler/alpha/cell.lisp +++ b/src/compiler/alpha/cell.lisp @@ -179,6 +179,7 @@ (loadw value bsp-tn (- binding-value-slot binding-size)) (#!+gengc storew-and-remember-slot #!-gengc storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst subq bsp-tn (* 2 n-word-bytes) bsp-tn))) @@ -202,6 +203,7 @@ (inst beq symbol skip) (#!+gengc storew-and-remember-slot #!-gengc storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) diff --git a/src/compiler/hppa/cell.lisp b/src/compiler/hppa/cell.lisp index a843e2d..8c16d62 100644 --- a/src/compiler/hppa/cell.lisp +++ b/src/compiler/hppa/cell.lisp @@ -167,6 +167,7 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst addi (- (* binding-size n-word-bytes)) bsp-tn bsp-tn))) @@ -181,6 +182,7 @@ (inst comb := symbol zero-tn skip) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) SKIP diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp index 0e3d636..024d1c7 100644 --- a/src/compiler/mips/cell.lisp +++ b/src/compiler/mips/cell.lisp @@ -184,6 +184,7 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst addu bsp-tn bsp-tn (* -2 n-word-bytes)))) @@ -205,6 +206,7 @@ (inst beq symbol zero-tn skip) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index 8dccc05..0ade25c 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -171,6 +171,7 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-symbol-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst subi bsp-tn bsp-tn (* 2 n-word-bytes)))) @@ -193,6 +194,7 @@ (inst beq skip) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-symbol-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index 9903824..525e6cb 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -167,6 +167,7 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (inst sub bsp-tn bsp-tn (* 2 n-word-bytes)))) @@ -189,6 +190,7 @@ (inst b :eq skip) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 9596bc9..8eac0c0 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -353,6 +353,7 @@ (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp))) @@ -365,6 +366,7 @@ (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -390,6 +392,7 @@ #!+sb-thread (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 9301d09..9a6950d 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -357,6 +357,7 @@ (inst fs-segment-prefix) (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-binding-stack-pointer bsp))) @@ -369,6 +370,7 @@ (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -393,6 +395,7 @@ tls-index symbol symbol-tls-index-slot other-pointer-lowtag) #!+sb-thread (inst fs-segment-prefix) #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index bc56053..d9d6f02 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -476,6 +476,65 @@ (lambda () (sb-ext:run-program "sleep" '("1") :search t :wait nil))) +;;;; Binding stack safety + +(defparameter *x* nil) +(defparameter *n-gcs-requested* 0) +(defparameter *n-gcs-done* 0) + +(let ((counter 0)) + (defun make-something-big () + (let ((x (make-string 32000))) + (incf counter) + (let ((counter counter)) + (sb-ext:finalize x (lambda () (format t " ~S" counter) + (force-output))))))) + +(defmacro wait-for-gc () + `(progn + (incf *n-gcs-requested*) + (loop while (< *n-gcs-done* *n-gcs-requested*)))) + +(defun send-gc () + (loop until (< *n-gcs-done* *n-gcs-requested*)) + (format t "G" *n-gcs-requested* *n-gcs-done*) + (force-output) + (sb-ext:gc) + (incf *n-gcs-done*)) + +(defun exercise-binding () + (loop + (let ((*x* (make-something-big))) + (let ((*x* 42)) + ;; at this point the binding stack looks like this: + ;; NO-TLS-VALUE-MARKER, *x*, SOMETHING, *x* + t)) + (wait-for-gc) + ;; sig_stop_for_gc_handler binds FREE_INTERRUPT_CONTEXT_INDEX. By + ;; now SOMETHING is gc'ed and the binding stack looks like this: 0, + ;; 0, SOMETHING, 0 (because the symbol slots are zeroed on + ;; unbinding but values are not). + (let ((*x* nil)) + ;; bump bsp as if a BIND had just started + (incf sb-vm::*binding-stack-pointer* 2) + (wait-for-gc) + (decf sb-vm::*binding-stack-pointer* 2)))) + +(with-test (:name (:binding-stack-gc-safety)) + (let (threads) + (unwind-protect + (progn + (push (sb-thread:make-thread #'exercise-binding) threads) + (push (sb-thread:make-thread (lambda () + (loop + (send-gc)))) + threads) + (sleep 4)) + (mapc #'sb-thread:terminate-thread threads)))) + +(format t "~&binding test done~%") + + #| ;; a cll post from eric marsden | (defun crash () | (setq *debugger-hook* diff --git a/version.lisp-expr b/version.lisp-expr index 51c538a..3bc3a72 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.6.47" +"0.9.6.48" -- 1.7.10.4