Changeset 6428

Timestamp:

May 5, 2007, 4:24:20 PM (18 years ago)

Author:

Gary Byers

Message:

If PUTHASH decides that it wants to grow the hash table, it tries
to enable the GC before doing so.

File:

• trunk/ccl/level-0/l0-hash.lisp (modified) (1 diff)

trunk/ccl/level-0/l0-hash.lisp

@@ -766 +766 @@
   (without-interrupts
    (block protected
-     (lock-hash-table hash)
-     (%lock-gc-lock)
-     (when (%needs-rehashing-p hash)
-       (%rehash hash))
-     (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
-          ((null iterator))
-       (let* ((vector (hti.vector iterator))
-              (index (index->vector-index (hti.index iterator)))
-              (test (hash-table-test hash)))
-         (declare (fixnum index))
-         (when (and (< index (the fixnum (uvsize vector)))
-                    (not (funcall test (%svref vector index) key)))
-           (unlock-hash-table hash)
-           (%unlock-gc-lock)
-           (error "Can't add key ~s during iteration on hash-table ~s"
-                  key hash))))
-     (let ((vector (nhash.vector  hash)))     
-       (when (eq key (nhash.vector.cache-key vector))
-         (let* ((idx (nhash.vector.cache-idx vector)))
-           (declare (fixnum idx))
-           (setf (%svref vector (the fixnum (1+ (the fixnum (index->vector-index idx)))))
-                 value)
-           (setf (nhash.vector.cache-value vector) value)
-           (return-from protected)))               
-       (let* ((vector-index (funcall (nhash.find-new hash) hash key))
-              (old-value (%svref vector vector-index)))
-         (declare (fixnum vector-index))
-
-         (cond ((eq old-value deleted-hash-key-marker)
-                (%set-hash-table-vector-key vector vector-index key)
-                (setf (%svref vector (the fixnum (1+ vector-index))) value)
-                (setf (nhash.count hash) (the fixnum (1+ (the fixnum (nhash.count hash)))))
-                ;; Adjust deleted-count
-                (when (> 0 (the fixnum
-                             (decf (the fixnum
-                                     (nhash.vector.deleted-count vector)))))
-                  (let ((weak-deletions (nhash.vector.weak-deletions-count vector)))
-                    (declare (fixnum weak-deletions))
-                    (setf (nhash.vector.weak-deletions-count vector) 0)
-                    (incf (the fixnum (nhash.vector.deleted-count vector)) weak-deletions)
-                    (decf (the fixnum (nhash.count hash)) weak-deletions))))
-               ((eq old-value free-hash-key-marker)
-                (when (eql 0 (nhash.grow-threshold hash))                 
-                  (grow-hash-table hash)
-                  (return-from protected (puthash key hash value)))
-                (%set-hash-table-vector-key vector vector-index key)
-                (setf (%svref vector (the fixnum (1+ vector-index))) value)
-                (decf (the fixnum (nhash.grow-threshold hash)))
-                (incf (the fixnum (nhash.count hash))))
-               (t
-                ;; Key was already there, update value.
-                (setf (%svref vector (the fixnum (1+ vector-index))) value)))
-         (setf (nhash.vector.cache-idx vector) (vector-index->index vector-index)
-               (nhash.vector.cache-key vector) key
-               (nhash.vector.cache-value vector) value))))
+     (tagbody
+        (lock-hash-table hash)
+        AGAIN
+        (%lock-gc-lock)
+        (when (%needs-rehashing-p hash)
+          (%rehash hash))
+        (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
+             ((null iterator))
+          (let* ((vector (hti.vector iterator))
+                 (index (index->vector-index (hti.index iterator)))
+                 (test (hash-table-test hash)))
+            (declare (fixnum index))
+            (when (and (< index (the fixnum (uvsize vector)))
+                       (not (funcall test (%svref vector index) key)))
+              (unlock-hash-table hash)
+              (%unlock-gc-lock)
+              (error "Can't add key ~s during iteration on hash-table ~s"
+                     key hash))))
+        (let ((vector (nhash.vector  hash)))     
+          (when (eq key (nhash.vector.cache-key vector))
+            (let* ((idx (nhash.vector.cache-idx vector)))
+              (declare (fixnum idx))
+              (setf (%svref vector (the fixnum (1+ (the fixnum (index->vector-index idx)))))
+                    value)
+              (setf (nhash.vector.cache-value vector) value)
+              (return-from protected)))               
+          (let* ((vector-index (funcall (nhash.find-new hash) hash key))
+                 (old-value (%svref vector vector-index)))
+            (declare (fixnum vector-index))
+
+            (cond ((eq old-value deleted-hash-key-marker)
+                   (%set-hash-table-vector-key vector vector-index key)
+                   (setf (%svref vector (the fixnum (1+ vector-index))) value)
+                   (setf (nhash.count hash) (the fixnum (1+ (the fixnum (nhash.count hash)))))
+                   ;; Adjust deleted-count
+                   (when (> 0 (the fixnum
+                                (decf (the fixnum
+                                        (nhash.vector.deleted-count vector)))))
+                     (let ((weak-deletions (nhash.vector.weak-deletions-count vector)))
+                       (declare (fixnum weak-deletions))
+                       (setf (nhash.vector.weak-deletions-count vector) 0)
+                       (incf (the fixnum (nhash.vector.deleted-count vector)) weak-deletions)
+                       (decf (the fixnum (nhash.count hash)) weak-deletions))))
+                  ((eq old-value free-hash-key-marker)
+                   (when (eql 0 (nhash.grow-threshold hash))
+                     (%unlock-gc-lock)
+                     (grow-hash-table hash)
+                     (go AGAIN))
+                   (%set-hash-table-vector-key vector vector-index key)
+                   (setf (%svref vector (the fixnum (1+ vector-index))) value)
+                   (decf (the fixnum (nhash.grow-threshold hash)))
+                   (incf (the fixnum (nhash.count hash))))
+                  (t
+                   ;; Key was already there, update value.
+                   (setf (%svref vector (the fixnum (1+ vector-index))) value)))
+            (setf (nhash.vector.cache-idx vector) (vector-index->index vector-index)
+                  (nhash.vector.cache-key vector) key
+                  (nhash.vector.cache-value vector) value)))))
    (%unlock-gc-lock)
    (unlock-hash-table hash))