Changeset 7742

Timestamp:

Nov 24, 2007, 6:35:25 PM (17 years ago)

Author:

Gary Byers

Message:

Locking, hash-table-iteration changes.

File:

• branches/working-0711/ccl/lib/macros.lisp (modified) (6 diffs)

branches/working-0711/ccl/lib/macros.lisp

@@ -2348 +2348 @@
 the lock held."
   (declare (ignore whostate))
-  `(with-lock-context
-    (with-recursive-lock (,lock) ,@body)))
+    (let* ((locked (gensym))
+           (l (gensym)))
+      `  (with-lock-context
+           (let ((,locked (make-lock-acquisition))
+             (,l ,lock))
+        (declare (dynamic-extent ,locked))
+        (unwind-protect
+             (progn
+               (%lock-recursive-lock-object ,l ,locked )
+               ,@body)
+          (when (lock-acquisition.status ,locked) (%unlock-recursive-lock-object ,l)))))))
 
 (defmacro with-lock-grabbed-maybe ((lock &optional
@@ -2355 +2364 @@
                                    &body body)
   (declare (ignore whostate))
-  `(with-lock-context
-    (with-recursive-lock-maybe (,lock) ,@body)))
+  (let* ((l (gensym)))
+    `(with-lock-context
+      (let* ((,l ,lock))
+        (when (%try-recursive-lock-object ,l)
+          (unwind-protect
+               (progn ,@body)
+            (%unlock-recursive-lock-object ,l)))))))
 
 (defmacro with-standard-abort-handling (abort-message &body body)
@@ -2601 +2615 @@
      nil))
 
-(defmacro with-hash-write-lock ((hash) &body body)
-  `(with-write-lock ((nhash.exclusion-lock ,hash))
-    ,@body))
-
-;;; To ... er, um, ... expedite implementation, we lock the hash
-;;; table exclusively whenever touching it.  For now.
-
-(defmacro with-exclusive-hash-lock ((hash) &body body)
-  `(with-hash-write-lock (,hash) ,@body))
+
 
 (defmacro with-hash-table-iterator ((mname hash-table) &body body &environment env)
@@ -2618 +2624 @@
    any objects remain in the hash table. When the first value is non-NIL,
    the second and third values are the key and the value of the next object."
-  (let ((state (gensym))
-        (htab (gensym)))
-    (multiple-value-bind (body decls) (parse-body body env)
-      `(let* ((,htab ,hash-table)
-              (,state (vector nil nil nil
-                              nil nil)))
-        (declare (dynamic-extent ,state))
-        (unwind-protect
-             (macrolet ((,mname () `(do-hash-table-iteration ,',state)))
-               (start-hash-table-iterator ,htab ,state)
-               (locally ,@decls ,@body))
-          (finish-hash-table-iterator ,state))))))
+  (let* ((hash (gensym))
+         (keys (gensym))
+         (state (gensym)))
+    `(let* ((,hash ,hash-table)
+            (,keys (make-array (the fixnum (hash-table-count ,hash))))
+            (,state (vector ,hash 0 ,keys (enumerate-hash-keys ,hash ,keys))))
+      (declare (dynamic-extent ,keys ,state))
+      (macrolet ((,mname () `(next-hash-table-iteration ,',state)))
+        ,@body))))
+
 
 (eval-when (compile load eval)
@@ -2990 +2994 @@
         (setf (%process-whostate ,p) ,old-whostate)))))
 
-(defmacro %with-recursive-lock-ptr ((lockptr) &body body)
-  (let* ((locked (gensym)))
-    `(let ((,locked (make-lock-acquisition)))
-      (declare (dynamic-extent ,locked))
-      (unwind-protect
-           (progn
-             (%lock-recursive-lock ,lockptr ,locked )
-             ,@body)
-        (when (lock-acquisition.status ,locked) (%unlock-recursive-lock ,lockptr))))))
-
-(defmacro %with-recursive-lock-ptr-maybe ((lockptr) &body body)
-  `(when (%try-recursive-lock ,lockptr)
-    (unwind-protect
-         (progn ,@body)
-      (%unlock-recursive-lock ,lockptr))))
-
-
-(defmacro with-recursive-lock ((lock) &body body)
-  (let* ((p (gensym)))
-    `(let* ((,p (recursive-lock-ptr ,lock)))
-      (%with-recursive-lock-ptr (,p) ,@body))))
-
-(defmacro with-recursive-lock-maybe ((lock) &body body)
-  (let* ((p (gensym)))
-    `(let* ((,p (recursive-lock-ptr ,lock)))
-      (%with-recursive-lock-ptr-maybe (,p) ,@body))))
+
+
+
 
 (defmacro with-read-lock ((lock) &body body)
@@ -3036 +3017 @@
     `(with-lock-context
       (let* ((,p ,lock))
-        (unwind-protect
-             (progn
-               (write-lock-rwlock ,p)
-               ,@body)
-          (unlock-rwlock ,p))))))
+      (unwind-protect
+           (progn
+             (write-lock-rwlock ,p)
+             ,@body)
+        (unlock-rwlock ,p))))))