Changeset 10913


Ignore:
Timestamp:
Sep 28, 2008, 2:27:38 PM (11 years ago)
Author:
gz
Message:

Propagate r10912 to trunk

File:
1 edited

Legend:

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

    r10871 r10913  
    116116        (not (eql (the fixnum (%get-gc-count)) (the fixnum (nhash.vector.gc-count vector))))))))
    117117
    118 (defun %set-does-not-need-rehashing (hash)
    119   (let* ((vector (nhash.vector hash))
    120          (flags (nhash.vector.flags vector)))
     118(defun %set-does-not-need-rehashing (vector)
     119  (let* ((flags (nhash.vector.flags vector)))
    121120    (declare (fixnum flags))
    122121    (setf (nhash.vector.gc-count vector) (%get-gc-count))
     
    679678;; old and new vectors.
    680679(defun %lock-free-rehash (hash)
    681   ;; Prevent puthash from adding new entries.  Note this doesn't keep it from undeleting
    682   ;; existing entries, so we might still lose, but this makes the odds much smaller.
    683   (setf (nhash.grow-threshold hash) 0)
    684680  (let* ((old-vector (nhash.vector hash))
    685681         (inherited-flags (logand $nhash_weak_flags_mask (nhash.vector.flags old-vector)))
    686          count new-vector grow-threshold vector-size)
    687     (tagbody
    688      RESTART
    689      (setq count (lock-free-count-entries hash))
    690      (multiple-value-setq (grow-threshold vector-size)
    691        (compute-hash-size count (nhash.rehash-size hash) (nhash.rehash-ratio hash)))
    692      (setq new-vector (%cons-nhash-vector vector-size inherited-flags))
    693      REHASH
    694      (loop for i from $nhash.vector_overhead below (uvsize old-vector) by 2
    695        do (let ((value (atomic-swap-gvector (%i+ i 1) old-vector rehashing-value-marker)))
    696             (when (eq value rehashing-value-marker) (error "Who else is doing this?"))
    697             (unless (eq value free-hash-marker)
    698               (let* ((key (%svref old-vector i))
    699                      (new-index (%growhash-probe new-vector hash key))
    700                      (new-vector-index (index->vector-index new-index)))
    701                 (setf (%svref new-vector new-vector-index) key)
    702                 (setf (%svref new-vector (%i+ new-vector-index 1)) value)
    703                 (when (%i<= (decf grow-threshold) 0)
    704                   ;; Too many entries got undeleted while we were rehashing!
    705                   (go RESTART))))))
    706      (when (%needs-rehashing-p new-vector) ;; keys moved, but at least can use the same new-vector.
    707        (%init-misc free-hash-marker new-vector)
    708        (%init-nhash-vector new-vector inherited-flags)
    709        (go REHASH)))
     682         (grow-threshold (nhash.grow-threshold hash))
     683         count new-vector vector-size)
     684    ;; Prevent puthash from adding new entries.  Note this doesn't keep it from undeleting
     685    ;; existing entries, so we might still lose, but this makes the odds much smaller.
     686    (setf (nhash.grow-threshold hash) 0)
     687    (setq count (lock-free-count-entries hash))
     688    (multiple-value-setq (grow-threshold vector-size)
     689      (if (%i<= grow-threshold 0) ; if ran out of room, grow, else get just enough.
     690        (compute-hash-size count (nhash.rehash-size hash) (nhash.rehash-ratio hash))
     691        (compute-hash-size count 1 (nhash.rehash-ratio hash))))
     692    (setq new-vector (%cons-nhash-vector vector-size inherited-flags))
     693    (loop with full-count = grow-threshold
     694          for i from $nhash.vector_overhead below (uvsize old-vector) by 2
     695          do (let* ((value (atomic-swap-gvector (%i+ i 1) old-vector rehashing-value-marker))
     696                    (key (%svref old-vector i)))
     697               (when (eq value rehashing-value-marker) (error "Who else is doing this?"))
     698               (unless (or (eq value free-hash-marker) (eq key deleted-hash-key-marker))
     699                 (let* ((new-index (%growhash-probe new-vector hash key))
     700                        (new-vector-index (index->vector-index new-index)))
     701                   (%set-hash-table-vector-key new-vector new-vector-index key)
     702                   (setf (%svref new-vector (%i+ new-vector-index 1)) value)
     703                   (decf grow-threshold)
     704                   (when (%i<= grow-threshold 0)
     705                     ;; Too many entries got undeleted while we were rehashing (that's the
     706                     ;; only way we could end up with more than COUNT entries, as adding
     707                     ;; new entries is blocked).  Grow the output vector.
     708                     (multiple-value-bind (bigger-threshold bigger-vector-size)
     709                         (compute-hash-size full-count (nhash.rehash-size hash) (nhash.rehash-ratio hash))
     710                       (assert (> bigger-vector-size vector-size))
     711                       (let ((bigger-vector (%cons-nhash-vector bigger-vector-size 0)))
     712                         (%copy-gvector-to-gvector new-vector
     713                                                   $nhash.vector_overhead
     714                                                   bigger-vector
     715                                                   $nhash.vector_overhead
     716                                                   (%i- (uvsize new-vector) $nhash.vector_overhead))
     717                         (setf (nhash.vector.flags bigger-vector) (nhash.vector.flags new-vector))
     718                         (%lock-free-rehash-in-place hash bigger-vector)
     719                         (setq grow-threshold (- bigger-threshold full-count))
     720                         (setq full-count bigger-threshold)
     721                         (setq new-vector bigger-vector)
     722                         (setq vector-size bigger-vector-size))))))))
     723    (when (%needs-rehashing-p new-vector) ;; keys moved, but at least can use the same new-vector.
     724      (%lock-free-rehash-in-place hash new-vector))
    710725    (setf (nhash.vector.hash new-vector) hash)
    711726    (setf (nhash.grow-threshold hash) grow-threshold)
     
    714729    ;; no big deal.
    715730    (setf (nhash.vector hash) new-vector)))
     731
     732;; This is called on a new vector that hasn't been installed yet, so no other thread is
     733;; accessing it.  However, gc might be deleting stuff from it, which is why it tests
     734;; key for deleted-hash-key-marker in addition to free-hash-marker value
     735(defun %lock-free-rehash-in-place (hash vector)
     736  (let* ((vector-index (- $nhash.vector_overhead 2))
     737         (size (nhash.vector-size vector))
     738         (rehash-bits (%make-rehash-bits hash size))
     739         (index -1))
     740    (declare (fixnum size index vector-index))
     741    (%set-does-not-need-rehashing vector)
     742    (loop
     743      (when (>= (incf index) size) (return))
     744      (setq vector-index (+ vector-index 2))
     745      (unless (%already-rehashed-p index rehash-bits)
     746        (let* ((value (%svref vector (%i+ vector-index 1)))
     747               (key (%svref vector vector-index)))
     748          (if (or (eq value free-hash-marker)
     749                  (eq key deleted-hash-key-marker))
     750            (unless (eq key free-hash-marker)
     751              (setf (%svref vector vector-index) free-hash-marker))
     752            (let* ((last-index index)
     753                   (first t))
     754              (loop
     755                (let ((found-index (%rehash-probe rehash-bits hash key vector)))
     756                  (%set-already-rehashed-p found-index rehash-bits)
     757                  (when (eq last-index found-index)
     758                    (return))
     759                  (let* ((found-vector-index (index->vector-index found-index))
     760                         (newvalue (%svref vector (the fixnum (1+ found-vector-index))))
     761                         (newkey (%svref vector found-vector-index)))
     762                    (declare (fixnum found-vector-index))
     763                    (when first         ; or (eq last-index index) ?
     764                      (setq first nil)
     765                      (setf (%svref vector (the fixnum (1+ vector-index))) free-hash-marker)
     766                      (setf (%svref vector vector-index) free-hash-marker))
     767                    (%set-hash-table-vector-key vector found-vector-index key)
     768                    (setf (%svref vector (the fixnum (1+ found-vector-index))) value)
     769                    (when (or (eq newkey deleted-hash-key-marker)
     770                              (eq newvalue free-hash-marker))
     771                      (return))
     772                    (when (eq key newkey)
     773                      (cerror "Delete one of the entries." "Duplicate key: ~s in ~s ~s ~s ~s ~s"
     774                              key hash value newvalue index found-index)                       
     775                      (return))
     776                    (setq key newkey
     777                          value newvalue
     778                          last-index found-index))))))))))
     779  t )
    716780
    717781
     
    812876    (lock-free-rehash hash)))
    813877
    814 
    815878(defun lock-free-count-entries (hash)
    816879  ;; Other threads could be adding/removing entries while we count, some of
     
    822885    with vector = (nhash.vector hash)
    823886    for i fixnum from $nhash.vector_overhead below (uvsize vector) by 2
    824     count (and (neq (%svref vector i) free-hash-marker)
    825                (let ((value (%svref vector (%i+ i 1))))
    826                  (when (eq value rehashing-value-marker)
    827                    ;; This table is being rehashed.  Wait for it to be
    828                    ;; done and try again.
    829                    (lock-free-rehash hash)
    830                    (return-from lock-free-count-entries (lock-free-count-entries hash)))
    831                  (neq value free-hash-marker)))))
     887    count (let ((value (%svref vector (%i+ i 1))))
     888            (when (eq value rehashing-value-marker)
     889              ;; This table is being rehashed.  Wait for it to be
     890              ;; done and try again.
     891              (lock-free-rehash hash)
     892              (return-from lock-free-count-entries (lock-free-count-entries hash)))
     893            (neq value free-hash-marker))))
    832894
    833895;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
    13981460    (setf (nhash.vector.cache-key vector) free-hash-marker
    13991461          (nhash.vector.cache-value vector) nil)
    1400     (%set-does-not-need-rehashing hash)
     1462    (%set-does-not-need-rehashing vector)
    14011463    (loop
    14021464      (when (>= (incf index) size) (return))
     
    14651527;;; Hash to an index that is not set in rehash-bits
    14661528 
    1467 (defun %rehash-probe (rehash-bits hash key)
     1529(defun %rehash-probe (rehash-bits hash key &optional (vector (nhash.vector hash)))
    14681530  (declare (optimize (speed 3)(safety 0))) 
    1469   (multiple-value-bind (hash-code index entries)(compute-hash-code hash key t)
     1531  (multiple-value-bind (hash-code index entries)(compute-hash-code hash key t vector)
    14701532    (declare (fixnum hash-code index entries))
    14711533    (when (null hash-code)(cerror "nuts" "Nuts"))
    1472     (let* ((vector (nhash.vector hash))
    1473            (vector-index (index->vector-index  index)))
     1534    (let* ((vector-index (index->vector-index index)))
    14741535      (if (or (not (%already-rehashed-p index rehash-bits))
    14751536              (eq key (%svref vector vector-index)))
Note: See TracChangeset for help on using the changeset viewer.