Changeset 6428


Ignore:
Timestamp:
May 5, 2007, 11:24:20 PM (15 years ago)
Author:
gb
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-0/l0-hash.lisp

    r6015 r6428  
    766766  (without-interrupts
    767767   (block protected
    768      (lock-hash-table hash)
    769      (%lock-gc-lock)
    770      (when (%needs-rehashing-p hash)
    771        (%rehash hash))
    772      (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
    773           ((null iterator))
    774        (let* ((vector (hti.vector iterator))
    775               (index (index->vector-index (hti.index iterator)))
    776               (test (hash-table-test hash)))
    777          (declare (fixnum index))
    778          (when (and (< index (the fixnum (uvsize vector)))
    779                     (not (funcall test (%svref vector index) key)))
    780            (unlock-hash-table hash)
    781            (%unlock-gc-lock)
    782            (error "Can't add key ~s during iteration on hash-table ~s"
    783                   key hash))))
    784      (let ((vector (nhash.vector  hash)))     
    785        (when (eq key (nhash.vector.cache-key vector))
    786          (let* ((idx (nhash.vector.cache-idx vector)))
    787            (declare (fixnum idx))
    788            (setf (%svref vector (the fixnum (1+ (the fixnum (index->vector-index idx)))))
    789                  value)
    790            (setf (nhash.vector.cache-value vector) value)
    791            (return-from protected)))               
    792        (let* ((vector-index (funcall (nhash.find-new hash) hash key))
    793               (old-value (%svref vector vector-index)))
    794          (declare (fixnum vector-index))
    795 
    796          (cond ((eq old-value deleted-hash-key-marker)
    797                 (%set-hash-table-vector-key vector vector-index key)
    798                 (setf (%svref vector (the fixnum (1+ vector-index))) value)
    799                 (setf (nhash.count hash) (the fixnum (1+ (the fixnum (nhash.count hash)))))
    800                 ;; Adjust deleted-count
    801                 (when (> 0 (the fixnum
    802                              (decf (the fixnum
    803                                      (nhash.vector.deleted-count vector)))))
    804                   (let ((weak-deletions (nhash.vector.weak-deletions-count vector)))
    805                     (declare (fixnum weak-deletions))
    806                     (setf (nhash.vector.weak-deletions-count vector) 0)
    807                     (incf (the fixnum (nhash.vector.deleted-count vector)) weak-deletions)
    808                     (decf (the fixnum (nhash.count hash)) weak-deletions))))
    809                ((eq old-value free-hash-key-marker)
    810                 (when (eql 0 (nhash.grow-threshold hash))                 
    811                   (grow-hash-table hash)
    812                   (return-from protected (puthash key hash value)))
    813                 (%set-hash-table-vector-key vector vector-index key)
    814                 (setf (%svref vector (the fixnum (1+ vector-index))) value)
    815                 (decf (the fixnum (nhash.grow-threshold hash)))
    816                 (incf (the fixnum (nhash.count hash))))
    817                (t
    818                 ;; Key was already there, update value.
    819                 (setf (%svref vector (the fixnum (1+ vector-index))) value)))
    820          (setf (nhash.vector.cache-idx vector) (vector-index->index vector-index)
    821                (nhash.vector.cache-key vector) key
    822                (nhash.vector.cache-value vector) value))))
     768     (tagbody
     769        (lock-hash-table hash)
     770        AGAIN
     771        (%lock-gc-lock)
     772        (when (%needs-rehashing-p hash)
     773          (%rehash hash))
     774        (do* ((iterator (nhash.iterator hash) (hti.prev-iterator iterator)))
     775             ((null iterator))
     776          (let* ((vector (hti.vector iterator))
     777                 (index (index->vector-index (hti.index iterator)))
     778                 (test (hash-table-test hash)))
     779            (declare (fixnum index))
     780            (when (and (< index (the fixnum (uvsize vector)))
     781                       (not (funcall test (%svref vector index) key)))
     782              (unlock-hash-table hash)
     783              (%unlock-gc-lock)
     784              (error "Can't add key ~s during iteration on hash-table ~s"
     785                     key hash))))
     786        (let ((vector (nhash.vector  hash)))     
     787          (when (eq key (nhash.vector.cache-key vector))
     788            (let* ((idx (nhash.vector.cache-idx vector)))
     789              (declare (fixnum idx))
     790              (setf (%svref vector (the fixnum (1+ (the fixnum (index->vector-index idx)))))
     791                    value)
     792              (setf (nhash.vector.cache-value vector) value)
     793              (return-from protected)))               
     794          (let* ((vector-index (funcall (nhash.find-new hash) hash key))
     795                 (old-value (%svref vector vector-index)))
     796            (declare (fixnum vector-index))
     797
     798            (cond ((eq old-value deleted-hash-key-marker)
     799                   (%set-hash-table-vector-key vector vector-index key)
     800                   (setf (%svref vector (the fixnum (1+ vector-index))) value)
     801                   (setf (nhash.count hash) (the fixnum (1+ (the fixnum (nhash.count hash)))))
     802                   ;; Adjust deleted-count
     803                   (when (> 0 (the fixnum
     804                                (decf (the fixnum
     805                                        (nhash.vector.deleted-count vector)))))
     806                     (let ((weak-deletions (nhash.vector.weak-deletions-count vector)))
     807                       (declare (fixnum weak-deletions))
     808                       (setf (nhash.vector.weak-deletions-count vector) 0)
     809                       (incf (the fixnum (nhash.vector.deleted-count vector)) weak-deletions)
     810                       (decf (the fixnum (nhash.count hash)) weak-deletions))))
     811                  ((eq old-value free-hash-key-marker)
     812                   (when (eql 0 (nhash.grow-threshold hash))
     813                     (%unlock-gc-lock)
     814                     (grow-hash-table hash)
     815                     (go AGAIN))
     816                   (%set-hash-table-vector-key vector vector-index key)
     817                   (setf (%svref vector (the fixnum (1+ vector-index))) value)
     818                   (decf (the fixnum (nhash.grow-threshold hash)))
     819                   (incf (the fixnum (nhash.count hash))))
     820                  (t
     821                   ;; Key was already there, update value.
     822                   (setf (%svref vector (the fixnum (1+ vector-index))) value)))
     823            (setf (nhash.vector.cache-idx vector) (vector-index->index vector-index)
     824                  (nhash.vector.cache-key vector) key
     825                  (nhash.vector.cache-value vector) value)))))
    823826   (%unlock-gc-lock)
    824827   (unlock-hash-table hash))
Note: See TracChangeset for help on using the changeset viewer.