[Openmcl-cvs-notifications] r10454 - /trunk/source/level-1/l1-aprims.lisp

[gb at clozure.com]

Author: gb
Date: Tue Aug 12 19:54:38 2008
New Revision: 10454

Log:
Create *KERNEL-TCR-AREA-LOCK* and initialize it on startup.  (It
encapsulates what the kernel sees as lisp_global(TCR_AREA_LOCK);
holding this lock may help to avoid race conditions in some
cases (PROCESS-WHOSTATE, SYMBOL-VALUE-IN-PROCESS, etc.)

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

Modified: trunk/source/level-1/l1-aprims.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-aprims.lisp (original)
+++ trunk/source/level-1/l1-aprims.lisp Tue Aug 12 19:54:38 2008
@@ -39,6 +39,13 @@
 	  (push (cons symbol initform) standard-initial-bindings))))
     (record-source-file symbol 'variable)
     symbol))
+
+(defstatic *kernel-tcr-area-lock* (%make-lock (%null-ptr) "Kernal tcr-area=
-lock"))
+
+(def-ccl-pointers area-lock ()
+  (let* ((p (recursive-lock-ptr *kernel-tcr-area-lock*)))
+    (%revive-macptr p)
+    (%get-kernel-global-ptr area-lock p)))
 =

 (def-standard-initial-binding *package*)
 (def-standard-initial-binding *gensym-counter* 0)