[Openmcl-cvs-notifications] r14748 - /trunk/source/level-1/l1-lisp-threads.lisp

[gb at clozure.com]

Author: gb
Date: Thu Apr 28 19:51:11 2011
New Revision: 14748

Log:
CLEANUP-THREAD-TCR: a thread needs to hold the state-change lock to
set its lisp-thread.tcr to NIL.

LISP-THREAD-SUSPEND-COUNT: hold the state-change lock while accessing
another thread's TCR.

(More things should probably do this.)

Modified:
    trunk/source/level-1/l1-lisp-threads.lisp

Modified: trunk/source/level-1/l1-lisp-threads.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-lisp-threads.lisp (original)
+++ trunk/source/level-1/l1-lisp-threads.lisp Thu Apr 28 19:51:11 2011
@@ -440,7 +440,7 @@
     (declare (fixnum flags))
     (if (logbitp arch::tcr-flag-bit-awaiting-preset flags)
       (thread-change-state thread :run :reset)
-      (progn
+      (with-lock-grabbed ((lisp-thread.state-change-lock thread))
 	(thread-change-state thread :run :exit)
 	(setf (lisp-thread.tcr thread) nil)))))
 =

@@ -491,15 +491,18 @@
        #+64-bit-target %%get-unsigned-longlong tcrp target::tcr.native-thr=
ead-id))))
 =

 (defun lisp-thread-suspend-count (thread)
-  (with-macptrs (tcrp)
-    (%setf-macptr-to-object tcrp (lisp-thread.tcr thread))
-    (unless (%null-ptr-p tcrp)
-      #+(and windows-target x8632-target)
-      (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
-	(%get-unsigned-long aux target::tcr-aux.suspend-count))
-      #-(and windows-target x8632-target)
-      (#+32-bit-target %get-unsigned-long
-       #+64-bit-target %%get-unsigned-longlong tcrp target::tcr.suspend-co=
unt))))
+  (with-lock-grabbed ((lisp-thread.state-change-lock thread))
+    (let* ((tcr (lisp-thread.tcr thread)))
+      (if (null tcr)
+        0
+        (with-macptrs (tcrp)
+          (%setf-macptr-to-object tcrp tcr)
+          #+(and windows-target x8632-target)
+          (let ((aux (%get-ptr tcrp (- target::tcr.aux target::tcr-bias))))
+            (%get-unsigned-long aux target::tcr-aux.suspend-count))
+          #-(and windows-target x8632-target)
+          (#+32-bit-target %get-unsigned-long
+                             #+64-bit-target %%get-unsigned-longlong tcrp =
target::tcr.suspend-count))))))
 =

 (defun tcr-clear-preset-state (tcr)
   (let* ((flags (%fixnum-ref tcr (- target::tcr.flags target::tcr-bias))))