Changeset 16340


Ignore:
Timestamp:
Jan 8, 2015, 12:30:40 AM (5 years ago)
Author:
gz
Message:

In lock-free-rehash, never shrink the vector below the current capacity, or below the size originally specified to make-hash-table.
In lock-free-clrhash, create a new vector instead of clearing the old if the remaining capacity would be too small.

Fixes ticket:1258

Location:
trunk/source
Files:
5 edited

Legend:

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

    r16305 r16340  
    6161
    6262(defun %cons-hash-table (keytrans-function compare-function vector
    63                          threshold rehash-ratio rehash-size find find-new owner &optional lock-free-p)
     63                         threshold rehash-ratio rehash-size find find-new owner lock-free-p &optional min-size)
    6464  (%istruct
    6565   'HASH-TABLE                          ; type
     
    8080   find-new                             ; nhash.find-new
    8181   nil                                  ; nhash.read-only
     82   (or min-size 0)                      ; nhash.min-size
    8283   ))
    8384
     
    437438       table.
    438439     :REHASH-SIZE -- Indicates how to expand the table when it fills up.
    439        If an integer, add space for that many elements. If a floating
    440        point number (which must be greater than 1.0), multiply the size
    441        by that amount.
     440       If an integer (which must be greater than 0), add space for that
     441       many elements. If a floating point number (which must be greater
     442       than 1.0), multiply the size by that amount.
    442443     :REHASH-THRESHOLD -- Indicates how dense the table can become before
    443444       forcing a rehash. Can be any positive number <=1, with density
     
    451452  (unless (and (realp rehash-threshold) (<= 0.0 rehash-threshold) (<= rehash-threshold 1.0))
    452453    (report-bad-arg rehash-threshold '(real 0 1)))
    453   (unless (or (fixnump rehash-size) (and (realp rehash-size) (< 1.0 rehash-size)))
    454     (report-bad-arg rehash-size '(or fixnum (real 1 *))))
     454  (unless (or (and (fixnump rehash-size) (<= 1 rehash-size))
     455              (and (realp rehash-size) (< 1.0 rehash-size)))
     456    (report-bad-arg rehash-size '(or (integer 1 *) (real (1) *))))
    455457  (unless (fixnump size) (report-bad-arg size 'fixnum))
    456458  (setq rehash-threshold (/ 1.0 (max 0.01 rehash-threshold)))
     
    488490      (setq lock-free nil))
    489491    (multiple-value-bind (grow-threshold total-size)
    490         (compute-hash-size (1- size) 1 rehash-threshold)
     492        (compute-hash-size size 0 rehash-threshold)
    491493      (let* ((flags (+ (if weak (ash 1 $nhash_weak_bit) 0)
    492494                       (ecase weak
     
    501503                    find-function find-put-function
    502504                    (unless shared *current-process*)
    503                     lock-free)))
     505                    lock-free
     506                    size)))
    504507        (setf (nhash.vector.hash (nhash.vector hash)) hash)
    505508        hash))))
    506509
    507510(defun compute-hash-size (size rehash-size rehash-ratio)
    508   (let* ((new-size size))
     511  (let* ((new-size (max 30 (if (fixnump rehash-size)
     512                             (%i+ size rehash-size)
     513                             (max (1+ size) (ceiling (* size rehash-size)))))))
    509514    (declare (fixnum size new-size))
    510     (setq new-size (max 30 (if (fixnump rehash-size)
    511                              (%i+ size rehash-size)
    512                              (ceiling (* size rehash-size)))))
    513     (if (<= new-size size)
    514       (setq new-size (1+ size)))        ; God save you if you make this happen
    515    
    516515    (let ((vector-size (%hash-size (max (+ new-size 2) (ceiling (* new-size rehash-ratio))))))
    517516      ; TODO: perhaps allow more entries, based on actual size:
     
    737736      (if (%i<= grow-threshold 0) ; if ran out of room, grow, else get just enough.
    738737        (compute-hash-size count (nhash.rehash-size hash) (nhash.rehash-ratio hash))
    739         (compute-hash-size count 1 (nhash.rehash-ratio hash))))
     738        (compute-hash-size (max (nhash.min-size hash) (+ count grow-threshold)) 0 (nhash.rehash-ratio hash))))
    740739    (setq new-vector (%cons-nhash-vector vector-size inherited-flags))
    741740    (loop with full-count = grow-threshold
     
    753752                   (decf grow-threshold)
    754753                   (when (%i<= grow-threshold 0)
    755                      (error "Bug: undeleted entries?")
    756                      #+obsolete ;; we no longer undelete entries
    757                      ;; Too many entries got undeleted while we were rehashing (that's the
    758                      ;; only way we could end up with more than COUNT entries, as adding
    759                      ;; new entries is blocked).  Grow the output vector.
    760                      (multiple-value-bind (bigger-threshold bigger-vector-size)
    761                          (compute-hash-size full-count (nhash.rehash-size hash) (nhash.rehash-ratio hash))
    762                        (assert (> bigger-vector-size vector-size))
    763                        (let ((bigger-vector (%cons-nhash-vector bigger-vector-size 0)))
    764                          (%copy-gvector-to-gvector new-vector
    765                                                    $nhash.vector_overhead
    766                                                    bigger-vector
    767                                                    $nhash.vector_overhead
    768                                                    (%i- (uvsize new-vector) $nhash.vector_overhead))
    769                          (setf (nhash.vector.flags bigger-vector) (nhash.vector.flags new-vector))
    770                          (%lock-free-rehash-in-place hash bigger-vector)
    771                          (setq grow-threshold (- bigger-threshold full-count))
    772                          (setq full-count bigger-threshold)
    773                          (setq new-vector bigger-vector)
    774                          (setq vector-size bigger-vector-size)))))))
     754                     (error "Bug: undeleted entries?")))))
    775755          finally (setf (nhash.vector.count new-vector) (- full-count grow-threshold)))
    776756
     
    778758      (%lock-free-rehash-in-place hash new-vector))
    779759    (setf (nhash.vector.hash new-vector) hash)
    780     (setf (nhash.grow-threshold hash) grow-threshold)
    781     ;; At this point, another thread might decrement the threshold while they're looking at the old
    782     ;; vector. That's ok, just means it will be too small and we'll rehash sooner than planned,
    783     ;; no big deal.
    784     (setf (nhash.vector hash) new-vector)))
     760    (setf (nhash.vector hash) new-vector)
     761    (setf (nhash.grow-threshold hash) grow-threshold)))
    785762
    786763;; This is called on a new vector that hasn't been installed yet, so no other thread is
     
    887864      (lock-free-rehash hash))))
    888865
    889 ;; TODO: might be better (faster, safer) to just create a new all-free vector?
     866(defun replace-nhash-vector (hash size flags)
     867  (let ((vector (%cons-nhash-vector size flags)))
     868    (setf (nhash.vector.hash vector) hash)
     869    (setf (nhash.vector hash) vector)))
     870
    890871(defun lock-free-clrhash (hash)
    891872  (when (nhash.read-only hash)
    892873    (signal-read-only-hash-table-error hash)) ;;continuable
    893874  (with-lock-context
    894     (without-interrupts
    895      (let ((lock (nhash.exclusion-lock hash)))
    896        (%lock-recursive-lock-object lock) ;; disallow rehashing.
    897        (loop
    898          with vector = (nhash.vector hash)
    899          for i fixnum from (%i+ $nhash.vector_overhead 1) below (uvsize vector) by 2
    900          as val = (%svref vector i)
    901          unless (or (eq val free-hash-marker) (eq val deleted-hash-value-marker))
    902          do (setf (%svref vector (%i- i 1)) deleted-hash-key-marker
    903                   (%svref vector i) deleted-hash-value-marker)
    904          finally (setf (nhash.vector.count vector) 0))
    905        (%unlock-recursive-lock-object lock))))
     875      (without-interrupts
     876        (let ((lock (nhash.exclusion-lock hash)))
     877          (%lock-recursive-lock-object lock)    ;; disallow rehashing (or other clrhashing)
     878          ;; Note that since we can't reuse deleted slots, deleting entries doesn't increase capacity.
     879          ;; As a heuristic, reuse existing vector if there is enough capacity left to grow again to
     880          ;; current size, otherwise make a fresh one.
     881          (if (< (lock-free-hash-table-count hash) (nhash.grow-threshold hash))
     882            (loop
     883              with vector = (nhash.vector hash)
     884              for i fixnum from (%i+ $nhash.vector_overhead 1) below (uvsize vector) by 2
     885              as val = (%svref vector i)
     886              unless (or (eq val free-hash-marker) (eq val deleted-hash-value-marker))
     887              do (setf (%svref vector (%i- i 1)) deleted-hash-key-marker
     888                       (%svref vector i) deleted-hash-value-marker)
     889              finally (setf (nhash.vector.count vector) 0))
     890            (multiple-value-bind (grow-threshold vector-size)
     891                                 (compute-hash-size (nhash.min-size hash) 0 (nhash.rehash-ratio hash))
     892              (setf (nhash.grow-threshold hash) 0) ;; prevent puthash from adding new entries
     893              (loop with vector = (nhash.vector hash) ;; mark entries as obsolete
     894                for i fixnum from (%i+ $nhash.vector_overhead 1) below (uvsize vector) by 2
     895                do (setf (%svref vector i) rehashing-value-marker))
     896              (let ((flags (logand $nhash_weak_flags_mask (nhash.vector.flags (nhash.vector hash)))))
     897                (when (> vector-size 1000)
     898                  ;; Install a tiny temp vector to let the old one get gc'd before consing a big new vector.
     899                  (replace-nhash-vector hash 1 0))
     900                (replace-nhash-vector hash vector-size flags))
     901              (setf (nhash.grow-threshold hash) grow-threshold)))
     902          (%unlock-recursive-lock-object lock))))
    906903  hash)
    907904
  • trunk/source/lib/hash.lisp

    r15606 r16340  
    252252        (vector (nhash.vector hash))
    253253        (private (if (nhash.owner hash) '*current-process*))
    254         (lock-free-p (logtest $nhash.lock-free (the fixnum (nhash.lock hash)))))
     254        (lock-free-p (hash-lock-free-p hash)))
     255
    255256    (flet ((convert (f)
    256257             (if (or (fixnump f) (symbolp f))
     
    260261       `(%cons-hash-table
    261262         nil nil nil ,(nhash.grow-threshold hash) ,(nhash.rehash-ratio hash) ,(nhash.rehash-size hash)
    262         nil nil ,private ,lock-free-p)
     263        nil nil ,private ,lock-free-p ,(nhash.min-size hash))
    263264       `(%initialize-hash-table ,hash ,(convert keytransF) ,(convert compareF) ',vector)))))
    264265
  • trunk/source/library/lispequ.lisp

    r15606 r16340  
    12451245    nhash.find-new                      ; function: find vector-index on put
    12461246    nhash.read-only                     ; boolean: true when read-only
     1247    nhash.min-size                      ; smallest size can shrink the table to.
    12471248    )
    12481249
  • trunk/source/lisp-kernel/constants.h

    r15842 r16340  
    116116  LispObj hash;                 /* backpointer to hash-table */
    117117  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
    118   LispObj count;                /* number of valid entries [not maintained if lock-free] */
     118  LispObj count;                /* number of valid entries */
    119119  LispObj cache_idx;            /* index of last cached pair */
    120120  LispObj cache_key;            /* value of last cached key */
  • trunk/source/xdump/hashenv.lisp

    r16085 r16340  
    4141  nhash.vector.deleted-count            ; if lock-free, hint to GC to delete marked keys.
    4242                                        ; else number of deleted entries
    43   nhash.vector.count                    ; number of valid entries [not maintained if lock-free]
    44   nhash.vector.cache-idx                ; index of last cached key/value pair
    45   nhash.vector.cache-key                ; cached key
    46   nhash.vector.cache-value              ; cached value
     43  nhash.vector.count                    ; number of valid entries
     44  nhash.vector.cache-idx                ; index of last cached key/value pair [not used if lock-free]
     45  nhash.vector.cache-key                ; cached key [not used if lock-free]
     46  nhash.vector.cache-value              ; cached value [not used if lock-free]
    4747  nhash.vector.size                     ; number of entries in table
    4848  nhash.vector.size-reciprocal          ; shifted reciprocal of nhash.vector.size
Note: See TracChangeset for help on using the changeset viewer.