Changeset 10709


Ignore:
Timestamp:
Sep 12, 2008, 12:04:14 AM (11 years ago)
Author:
gz
Message:

Checkpoint. lock-free tables don't work yet, but changes to existing code seem ok

Location:
branches/gz
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • branches/gz/compiler/optimizers.lisp

    r10442 r10709  
    555555    (multiple-value-bind (true true-win) (nx-transform true env)
    556556      (multiple-value-bind (false false-win) (nx-transform false env)
     557        (loop
     558          (unless (and (consp test)
     559                       (memq (%car test) '(not null))
     560                       (consp (%cdr test))
     561                       (null (%cddr test)))
     562            (return))
     563          (psetq test (%cadr test)
     564                 test-win t
     565                 true false
     566                 false true))
    557567        (if (or (quoted-form-p test) (self-evaluating-p test))
    558568          (if (eval test)
  • branches/gz/level-0/l0-hash.lisp

    r10620 r10709  
    1919;;;;;;;;;;;;;
    2020;;
    21 ;; hash.lisp
    22 ;; New hash table implementation
    23 
    24 ;;;;;;;;;;;;;
    25 ;;
    26 ;; Things I didn't do
    27 ;;
    28 ;; Save the 32-bit hash code along with the key so that growing the table can
    29 ;; avoid calling the hashing function (at least until a GC happens during growing).
    30 ;;
    31 ;; Maybe use Knuth's better method for hashing:
    32 ;; find two primes N-2, N.  N is the table size.
    33 ;; First probe is at primary = (mod (funcall (nhash.keytransF h) key) N)
    34 ;; Secondary probes are spaced by (mod (funcall (nhash.keytransF h) key) N-2)
    35 ;; This does a bit better scrambling of the secondary probes, but costs another divide.
    36 ;;
    37 ;; Rethink how finalization is reported to the user.  Maybe have a finalization function which
    38 ;; is called with the hash table and the deleted key & value.
    39 
    40 
    41 ;;;;;;;;;;;;;
    42 ;;
    43 ;; Documentation
    44 ;;
    45 ;; MAKE-HASH-TABLE is extended to accept a :HASH-FUNCTION keyword arg which
    46 ;; defaults for the 4 Common Lisp defined :TEST's.  Also, any fbound symbol can
    47 ;; be used for the :TEST argument.  The HASH-FUNCTION is a function of one
    48 ;; argument, the key, which returns two values:
    49 ;;
    50 ;; 1) HASH-CODE
    51 ;; 2) ADDRESSP
    52 ;;
    53 ;; The HASH-CODE can be any object.  If it is a relocateable object (not a
    54 ;; fixnum, short float, or immediate) then ADDRESSP will default to :KEY
    55 ;; and it is an error if NIL is returned for ADDRESSP.
    56 ;;
    57 ;; If ADDRESSP is NIL, the hashing code assumes that no addresses were used
    58 ;; in computing the HASH-CODE.  If ADDRESSP is :KEY (which is the default
    59 ;; if the hash function returns only one value and it is relocateable) then
    60 ;; the hashing code assumes that only the KEY's address was used to compute
    61 ;; the HASH-CODE.  Otherwise, it is assumed that the address of a
    62 ;; component of the key was used to compute the HASH-CODE.
    63 ;;
    64 ;;
    65 ;;
    66 ;; Some (proposed) functions for using in user hashing functions:
    67 ;;
    68 ;; (HASH-CODE object)
    69 ;;
    70 ;; returns two values:
    71 ;;
    72 ;; 1) HASH-CODE
    73 ;; 2) ADDRESSP
    74 ;;
    75 ;; HASH-CODE is the object transformed into a fixnum by changing its tag
    76 ;; bits to a fixnum's tag.  ADDRESSP is true if the object was
    77 ;; relocateable.
    78 ;;
    79 ;;
    80 ;; (FIXNUM-ADD o1 o2)
    81 ;; Combines two objects additively and returns a fixnum.
    82 ;; If the two objects are fixnums, will be the same as (+ o1 o2) except
    83 ;; that the result can not be a bignum.
    84 ;;
    85 ;; (FIXNUM-MULTIPLY o1 o2)
    86 ;; Combines two objects multiplicatively and returns a fixnum.
    87 ;;
    88 ;; (FIXNUM-FLOOR dividend &optional divisor)
    89 ;; Same as Common Lisp's FLOOR function, but converts the objects into
    90 ;; fixnums before doing the divide and returns two fixnums: quotient &
    91 ;; remainder.
    92 ;;
    93 ;;;;;;;;;;;;;
    94 ;;
    95 ;; Implementation details.
    96 ;;
    97 ;; Hash table vectors have a header that the garbage collector knows about
    98 ;; followed by alternating keys and values.  Empty or deleted slots are
    99 ;; denoted by a key of $undefined.  Empty slots have a value of $undefined.
    100 ;; Deleted slots have a value of NIL.
    101 ;;
    102 ;;
     21;; See hash.lisp for documentation
    10322;; Five bits in the nhash.vector.flags fixnum interact with the garbage
    10423;; collector.  This description uses the symbols that represent bit numbers
     
    16483  (declaim (inline hash-mod))
    16584  (declaim (inline set-hash-key-conditional set-hash-value-conditional))
    166   (declaim (inline lock-free-gethash)))
    167 
     85  (declaim (inline hash-lock-free-p lock-free-gethash)))
     86
     87
     88
     89(defun %cons-hash-table (keytrans-function compare-function vector
     90                         threshold rehash-ratio rehash-size find find-new owner &optional lock-free-p)
     91  (%istruct
     92   'HASH-TABLE                          ; type
     93   nil                                  ; unused
     94   keytrans-function                    ; nhash.keytransF
     95   compare-function                     ; nhash.compareF
     96   nil                                  ; nhash.rehash-bits
     97   vector                               ; nhash.vector
     98   (if lock-free-p $nhash.lock-free 0)  ; nhash.lock
     99   nil                                  ; unused
     100   owner                                ; nhash.owner
     101   nil                                  ; unused
     102   nil                                  ; unused
     103   threshold                            ; nhash.grow-threshold
     104   rehash-ratio                         ; nhash.rehash-ratio
     105   rehash-size                          ; nhash.rehash-size
     106   0                                    ; nhash.puthash-count
     107   (if lock-free-p
     108     (make-lock)
     109     (unless owner (make-read-write-lock))) ; nhash.exclusion-lock
     110   nil                                  ; unused
     111   nil                                  ; unused
     112   nil                                  ; unused
     113   find                                 ; nhash.find
     114   find-new                             ; nhash.find-new
     115   nil                                  ; nhash.read-only
     116   ))
     117
     118(defun nhash.vector-size (vector)
     119  (nhash.vector.size vector))
     120
     121(defun hash-mod (hash entries vector)
     122  (fast-mod-3 hash entries (nhash.vector.size-reciprocal vector)))
     123
     124;; For lock-free hash tables
     125(defun set-hash-key-conditional (index vector old new)
     126  (%set-hash-table-vector-key-conditional (%i+ target::misc-data-offset
     127                                               (ash (the fixnum index) target::word-shift))
     128                                          vector
     129                                          old
     130                                          new))
     131
     132(defun set-hash-value-conditional (index vector old new)
     133  (store-gvector-conditional (%i+ index 1) vector old new))
     134
     135(defun hash-lock-free-p (hash)
     136  (logtest $nhash.lock-free (the fixnum (nhash.lock hash))))
     137 
     138;;; Is KEY something which can be EQL to something it's not EQ to ?
     139;;; (e.g., is it a number or macptr ?)
     140;;; This can be more general than necessary but shouldn't be less so.
     141(defun need-use-eql (key)
     142  (let* ((typecode (typecode key)))
     143    (declare (fixnum typecode))
     144    (or (= typecode target::subtag-macptr)
     145        #+(or ppc32-target x8632-target)
     146        (and (>= typecode target::min-numeric-subtag)
     147             (<= typecode target::max-numeric-subtag))
     148        #+64-bit-target
     149        (or (= typecode target::subtag-bignum)
     150            (= typecode target::subtag-double-float)
     151            (= typecode target::subtag-ratio)
     152            (= typecode target::subtag-complex)))))
     153
     154;;; Don't rehash at all, unless some key is address-based (directly or
     155;;; indirectly.)
     156(defun %needs-rehashing-p (vector)
     157  (let* ((flags (nhash.vector.flags vector)))
     158    (declare (fixnum flags))
     159    (if (logbitp $nhash_track_keys_bit flags)
     160      ;; GC is tracking key movement
     161      (logbitp $nhash_key_moved_bit flags)
     162      ;; GC is not tracking key movement
     163      (if (logbitp $nhash_component_address_bit flags)
     164         (not (eql (the fixnum (%get-gc-count)) (the fixnum (nhash.vector.gc-count vector))))))))
     165
     166(defun %set-does-not-need-rehashing (hash)
     167  (let* ((vector (nhash.vector hash))
     168         (flags (nhash.vector.flags vector)))
     169    (declare (fixnum flags))
     170    (setf (nhash.vector.gc-count vector) (%get-gc-count))
     171    (when (logbitp $nhash_track_keys_bit flags)
     172      (setf (nhash.vector.flags vector)
     173            (logand (lognot (ash 1 $nhash_key_moved_bit)) flags)))))
     174
     175
     176;;; Tempting though it may be to remove this, a hash table loaded from
     177;;; a fasl file likely needs to be rehashed, and the MAKE-LOAD-FORM
     178;;; for hash tables needs to be able to call this or something similar.
     179(defun %set-needs-rehashing (hash)
     180  (let* ((vector (nhash.vector hash))
     181         (flags (nhash.vector.flags vector)))
     182    (declare (fixnum flags))
     183    (setf (nhash.vector.gc-count vector) (the fixnum (1- (the fixnum (%get-gc-count)))))
     184    (when (logbitp $nhash_track_keys_bit flags)
     185      (setf (nhash.vector.flags vector) (logior (ash 1 $nhash_key_moved_bit) flags)))))
     186
     187#+32-bit-target
     188(defun mixup-hash-code (fixnum)
     189  (declare (fixnum fixnum))
     190  (the fixnum
     191    (+ fixnum
     192       (the fixnum (%ilsl (- 32 8)
     193                          (logand (1- (ash 1 (- 8 3))) fixnum))))))
     194
     195#+64-bit-target
     196(defun mixup-hash-code (fixnum)
     197  (declare (fixnum fixnum))
     198  (the fixnum
     199    (+ fixnum
     200       (the fixnum (%ilsl 50
     201                          (logand (1- (ash 1 (- 8 3))) fixnum))))))
     202
     203
     204(defun rotate-hash-code (fixnum)
     205  (declare (fixnum fixnum))
     206  (let* ((low-3 (logand 7 fixnum))
     207         (but-low-3 (%ilsr 3 fixnum))
     208         (low-3*64K (%ilsl 13 low-3))
     209         (low-3-in-high-3 (%ilsl (- 32 3 3) low-3)))
     210    (declare (fixnum low-3 but-low-3 low-3*64K low-3-in-high-3))
     211    (the fixnum (+ low-3-in-high-3
     212                   (the fixnum (logxor low-3*64K but-low-3))))))
     213
     214
     215
     216
     217(defconstant $nhash-track-keys-mask
     218  #.(- (ash 1 $nhash_track_keys_bit)))
     219
     220(defconstant $nhash-clear-key-bits-mask #xfffff)
    168221
    169222
     
    184237    +nil-hash+))
    185238             
    186 (defun %cons-hash-table (rehash-function keytrans-function compare-function vector
    187                                          threshold rehash-ratio rehash-size address-based find find-new owner &optional lock)
    188   (%istruct
    189    'HASH-TABLE                          ; type
    190    rehash-function                      ; nhash.rehashF
    191    keytrans-function                    ; nhash.keytransF
    192    compare-function                     ; nhash.compareF
    193    nil                                  ; nhash.rehash-bits
    194    vector                               ; nhash.vector
    195    0                                    ; nhash.lock
    196    0                                    ; nhash.count
    197    owner                                ; nhash.owner
    198    (get-fwdnum)                         ; nhash.fixnum
    199    (gc-count)                           ; nhash.gc-count
    200    threshold                            ; nhash.grow-threshold
    201    rehash-ratio                         ; nhash.rehash-ratio
    202    rehash-size                          ; nhash.rehash-size
    203    0                                    ; nhash.puthash-count
    204    (or lock
    205        (unless owner (make-read-write-lock))) ; nhash.exclusion-lock
    206    nil ;;(make-lock)                            ; nhash.rehash-lock
    207    nil                                  ; nhash.iterator
    208    address-based                        ; nhash.address-based
    209    find                                 ; nhash.find
    210    find-new                             ; nhash.find-new
    211    nil                                  ; hhash.read-only
    212    ))
    213 
    214 
    215  
    216 (defun nhash.vector-size (vector)
    217   (nhash.vector.size vector))
    218 
    219 (defun hash-mod (hash entries vector)
    220   (fast-mod-3 hash entries (nhash.vector.size-reciprocal vector)))
    221 
    222 ;; For lock-free hash tables
    223 (defun set-hash-key-conditional (index vector old new)
    224   (%set-hash-vector-key-conditional (%i+ target::misc-data-offset
    225                                          (ash (the fixnum index) target::word-shift))
    226                                     vector
    227                                     old
    228                                     new))
    229 
    230 (defun set-hash-value-conditional (index vector old new)
    231   (store-gvector-conditional (%i+ index 1) vector old new))
    232 
    233 ;;; Is KEY something which can be EQL to something it's not EQ to ?
    234 ;;; (e.g., is it a number or macptr ?)
    235 ;;; This can be more general than necessary but shouldn't be less so.
    236 (defun need-use-eql (key)
    237   (let* ((typecode (typecode key)))
    238     (declare (fixnum typecode))
    239     (or (= typecode target::subtag-macptr)
    240         #+(or ppc32-target x8632-target)
    241         (and (>= typecode target::min-numeric-subtag)
    242              (<= typecode target::max-numeric-subtag))
    243         #+64-bit-target
    244         (or (= typecode target::subtag-bignum)
    245             (= typecode target::subtag-double-float)
    246             (= typecode target::subtag-ratio)
    247             (= typecode target::subtag-complex)))))
    248 
    249 (defun %needs-rehashing-p (hash)
    250   (%vector-needs-rehashing-p (nhash.vector hash)))
    251 
    252 ;;; Don't rehash at all, unless some key is address-based (directly or
    253 ;;; indirectly.)
    254 (defun-inline %vector-needs-rehashing-p (hashv)
    255   (let ((flags (nhash.vector.flags hashv)))
    256     (declare (fixnum flags))
    257     (if (logbitp $nhash_track_keys_bit flags)
    258       ;; GC is tracking key movement
    259       (logbitp $nhash_key_moved_bit flags)
    260       ;; GC is not tracking key movement
    261       (if (logbitp $nhash_component_address_bit flags)
    262         ;; TODO:Why is this in the hash table rather than the vector?  Certainly is specific
    263         ;; to the vector.
    264         (not (eql (the fixnum (gc-count)) (the fixnum (nhash.gc-count (nhash.vector.hash hashv)))))))))
    265  
    266  
    267 
    268 (defun %set-does-not-need-rehashing (hash)
    269   (get-fwdnum hash)
    270   (gc-count hash)
    271   (let* ((vector (nhash.vector hash))
    272          (flags (nhash.vector.flags vector)))
    273     (declare (fixnum flags))
    274     (when (logbitp $nhash_track_keys_bit flags)
    275       (setf (nhash.vector.flags vector)
    276             (logand (lognot (ash 1 $nhash_key_moved_bit)) flags)))))
    277 
    278 
    279 ;;; Tempting though it may be to remove this, a hash table loaded from
    280 ;;; a fasl file likely needs to be rehashed, and the MAKE-LOAD-FORM
    281 ;;; for hash tables needs to be able to call this or something similar.
    282 (defun %set-needs-rehashing (hash)
    283   (setf (nhash.fixnum hash)   (the fixnum (1- (the fixnum (get-fwdnum))))
    284         (nhash.gc-count hash) (the fixnum (1- (the fixnum (gc-count)))))
    285   (let* ((vector (nhash.vector hash))
    286          (flags (nhash.vector.flags vector)))
    287     (declare (fixnum flags))
    288     (when (logbitp $nhash_track_keys_bit flags)
    289       (setf (nhash.vector.flags vector) (logior (ash 1 $nhash_key_moved_bit) flags)))))
    290 
    291 #+32-bit-target
    292 (defun mixup-hash-code (fixnum)
    293   (declare (fixnum fixnum))
    294   (the fixnum
    295     (+ fixnum
    296        (the fixnum (%ilsl (- 32 8)
    297                           (logand (1- (ash 1 (- 8 3))) fixnum))))))
    298 
    299 #+64-bit-target
    300 (defun mixup-hash-code (fixnum)
    301   (declare (fixnum fixnum))
    302   (the fixnum
    303     (+ fixnum
    304        (the fixnum (%ilsl 50
    305                           (logand (1- (ash 1 (- 8 3))) fixnum))))))
    306 
    307 
    308 (defun rotate-hash-code (fixnum)
    309   (declare (fixnum fixnum))
    310   (let* ((low-3 (logand 7 fixnum))
    311          (but-low-3 (%ilsr 3 fixnum))
    312          (low-3*64K (%ilsl 13 low-3))
    313          (low-3-in-high-3 (%ilsl (- 32 3 3) low-3)))
    314     (declare (fixnum low-3 but-low-3 low-3*64K low-3-in-high-3))
    315     (the fixnum (+ low-3-in-high-3
    316                    (the fixnum (logxor low-3*64K but-low-3))))))
    317 
    318 
    319 
    320 
    321 (defconstant $nhash-track-keys-mask
    322   #.(- (ash 1 $nhash_track_keys_bit)))
    323 
    324 (defconstant $nhash-clear-key-bits-mask #xfffff)
    325 
    326 
    327239;;; Hash on address, or at least on some persistent, immutable
    328240;;; attribute of the key.  If all keys are fixnums or immediates (or if
     
    440352    (when addressp
    441353      (when update-hash-flags
    442         (let ((flags (nhash.vector.flags vector)))
    443           (declare (fixnum flags))
    444           (if (eq :key addressp)
    445             ;; hash code depended on key's address
    446             (unless (logbitp $nhash_component_address_bit flags)
    447               (when (not (logbitp $nhash_track_keys_bit flags))
    448                 (setq flags (bitclr $nhash_key_moved_bit flags)))
    449               (setq flags (logior $nhash-track-keys-mask flags)))
    450             ;; hash code depended on component address
    451             (progn
    452               (setq flags (logand (lognot $nhash-track-keys-mask) flags))
    453               (setq flags (bitset $nhash_component_address_bit flags))))
    454           (setf (nhash.vector.flags vector) flags))))
     354        (flet ((new-flags (flags addressp)
     355                 (declare (fixnum flags))
     356                 (if (eq :key addressp)
     357                   ;; hash code depended on key's address
     358                   (if (logbitp $nhash_component_address_bit flags)
     359                     flags
     360                     (logior $nhash-track-keys-mask
     361                             (if (logbitp $nhash_track_keys_bit flags)
     362                               flags
     363                               (bitclr $nhash_key_moved_bit flags))))
     364                   ;; hash code depended on component address
     365                   (bitset $nhash_component_address_bit
     366                           (logand (lognot $nhash-track-keys-mask) flags)))))
     367          (declare (inline new-flags))
     368          (if (hash-lock-free-p hash)
     369              (loop
     370                (let* ((flags (nhash.vector.flags vector))
     371                       (new-flags (new-flags flags addressp)))
     372                  (when (or (eq flags new-flags)
     373                            (store-gvector-conditional nhash.vector.flags vector flags new-flags))
     374                    (return))))
     375            (setf (nhash.vector.flags vector) (new-flags (nhash.vector.flags vector) addressp))))))
    455376    (let* ((entries (nhash.vector-size vector)))
    456377      (declare (fixnum entries))
     
    475396(defun %normalize-hash-table-count (hash)
    476397  (let* ((vector (nhash.vector hash))
    477         (weak-deletions-count (nhash.vector.weak-deletions-count vector)))
     398        (weak-deletions-count (nhash.vector.weak-deletions-count vector)))
    478399    (declare (fixnum weak-deletions-count))
    479400    (unless (eql 0 weak-deletions-count)
    480401      (setf (nhash.vector.weak-deletions-count vector) 0)
    481       (let ((deleted-count (the fixnum
    482                              (+ (the fixnum (nhash.vector.deleted-count vector))
    483                                 weak-deletions-count)))
    484             (count (the fixnum (- (the fixnum (nhash.count hash)) weak-deletions-count))))
    485         (setf (nhash.vector.deleted-count vector) deleted-count
    486               (nhash.count hash) count)))))
     402      ;; lock-free hash tables don't maintain deleted-count, since would need to
     403      ;; lock and it's not worth it.
     404      (unless (hash-lock-free-p hash)
     405        (let ((deleted-count (the fixnum
     406                               (+ (the fixnum (nhash.vector.deleted-count vector))
     407                                  weak-deletions-count)))
     408              (count (the fixnum (- (the fixnum (nhash.vector.count vector)) weak-deletions-count))))
     409          (setf (nhash.vector.deleted-count vector) deleted-count
     410                (nhash.vector.count vector) count))))))
    487411
    488412
     
    513437       approaching zero as the threshold approaches 0. Density 1 means an
    514438       average of one entry per bucket."
     439  (declare (ignore address-based))
    515440  (unless (and test (or (functionp test) (symbolp test)))
    516441    (report-bad-arg test '(and (not null) (or symbol function))))
     
    553478    (when (and finalizeable (not weak))
    554479      (error "Only weak hash tables can be finalizeable."))
    555     (multiple-value-bind (size total-size)
     480    (multiple-value-bind (grow-threshold total-size)
    556481        (compute-hash-size (1- size) 1 rehash-threshold)
    557482      (let* ((flags (+ (if weak (ash 1 $nhash_weak_bit) 0)
     
    562487                       (if lock-free (ash 1 $nhash_keys_frozen_bit) 0)))
    563488             (hash (%cons-hash-table
    564                     #'%no-rehash hash-function test
     489                    hash-function test
    565490                    (%cons-nhash-vector total-size flags)
    566                     size rehash-threshold rehash-size address-based
     491                    grow-threshold rehash-threshold rehash-size
    567492                    find-function find-put-function
    568493                    (unless shared *current-process*)
    569                     (and lock-free (make-lock)))))
    570         (when lock-free
    571           (setf (nhash.lock hash) (logior (nhash.lock hash) $nhash.lock-free)))
     494                    lock-free)))
    572495        (setf (nhash.vector.hash (nhash.vector hash)) hash)
    573496        hash))))
     
    575498(defun compute-hash-size (size rehash-size rehash-ratio)
    576499  (let* ((new-size size))
     500    (declare (fixnum size new-size))
    577501    (setq new-size (max 30 (if (fixnump rehash-size)
    578                              (+ size rehash-size)
     502                             (%i+ size rehash-size)
    579503                             (ceiling (* size rehash-size)))))
    580504    (if (<= new-size size)
    581505      (setq new-size (1+ size)))        ; God save you if you make this happen
    582506   
    583     (values new-size
    584             (%hash-size (max (+ new-size 2) (ceiling (* new-size rehash-ratio)))))))
     507    (let ((vector-size (%hash-size (max (+ new-size 2) (ceiling (* new-size rehash-ratio))))))
     508      ;  (values (min (floor vector-size rehash-ratio) (%i- vector-size 2)) vector-size))
     509      (values new-size vector-size)
     510      )))
    585511
    586512;;;  Suggested size is a fixnum: number of pairs.  Return a fixnum >=
     
    599525
    600526
    601 (defvar *continue-from-readonly-hashtable-lock-error* nil)
     527(defvar *continue-from-readonly-hashtable-lock-error* t)
    602528
    603529(defun signal-read-only-hash-table-error (hash)
    604530  (cond (*continue-from-readonly-hashtable-lock-error*
    605          (cerror "Make the hash-table writable. DANGEROUS! CONTINUE ONLY IF YOU KNOW WHAT YOU'RE DOING!"
     531         (cerror "Make the hash-table writable. DANGEROUS! This could damage your lisp if another thread is acccessing this table. CONTINUE ONLY IF YOU KNOW WHAT YOU'RE DOING!"
    606532                 "Hash-table ~s is readonly" hash)
    607533         (assert-hash-table-writeable hash)
     
    642568  (the fixnum (ash (the fixnum (- index $nhash.vector_overhead)) -1)))
    643569
    644 
    645570(defun hash-table-count (hash)
    646571  "Return the number of entries in the given HASH-TABLE."
    647   (require-type hash 'hash-table)
     572  (setq hash (require-type hash 'hash-table))
     573  (when (hash-lock-free-p hash)
     574    ;; We don't try to maintain a running total, so just count.
     575    (return-from hash-table-count (lock-free-count-entries hash)))
    648576  (%normalize-hash-table-count hash)
    649   (the fixnum (nhash.count hash)))
     577  (the fixnum (nhash.vector.count (nhash.vector hash))))
    650578
    651579(defun hash-table-rehash-size (hash)
     
    661589   table that can hold however many entries HASH-TABLE can hold without
    662590   having to be grown."
    663   (%i+ (the fixnum (hash-table-count hash))
    664        (the fixnum (nhash.grow-threshold hash))
    665        (the fixnum (nhash.vector.deleted-count (nhash.vector hash)))))
     591  (let ((vector (nhash.vector hash)))
     592    (floor (nhash.vector.size vector) (nhash.rehash-ratio hash))))
    666593
    667594(defun hash-table-test (hash)
     
    680607      f)))
    681608
    682 ;; Finalization-list accessors are in "ccl:lib;hash" because SETF functions
    683 ;;  don't get dumped as "simple" %defuns.
    684 ;;
    685 
    686 (defun lock-free-rehash (hash)
     609;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     610;;
     611;; nearly-lock-free hash tables
     612;;
     613             ;; It's kinda risky to use lock-free hash tables with address-based
     614             ;; keys, because it will thrash in low-memory situations, but we don't
     615             ;; disallow it because there are situations where it won't be a problem.
     616
     617 (defun lock-free-rehash (hash)
    687618  (with-lock-context
    688       (without-interrupts
    689        (let ((lock (nhash.exclusion-lock hash)))
    690          (grab-lock lock)
    691          (%lock-gc-lock)
    692          (when (%needs-rehashing-p hash)
    693            (%rehash hash))
    694          (%unlock-gc-lock)
    695          (release-lock lock)))))
     619    (without-interrupts
     620     (let ((lock (nhash.exclusion-lock hash)))
     621       (grab-lock lock)
     622       ;; TODO: might also want to rehash if deleted entries are a large percentage
     623       ;; of all entries, more or less.
     624       (when (or (%i<= (nhash.grow-threshold hash) 0) ;; no room
     625                 (%needs-rehashing-p (nhash.vector hash)))    ;; or keys moved
     626         (%lock-free-rehash hash))
     627       (release-lock lock)))))
     628
     629(defun atomic-swap-gvector (index gvector value)
     630  ;; This is silly.  We're implementing atomic swap using store-conditional, but internally
     631  ;; store-conditional is probably implemented using some kind of an atomic swap!!
     632  (loop
     633    (let ((old-value (%svref gvector index)))
     634      (when (store-gvector-conditional index gvector old-value value)
     635        (return old-value)))))
     636
     637;; Interrupts are disabled and caller has the hash lock on the table, blocking other
     638;; threads attempting a rehash.
     639;; Other threads might be reading/writing/deleting individual entries, but they
     640;; will block if they see a value = free-hash-key-marker.
     641;; GC may run.
     642(defun %lock-free-rehash (hash)
     643  ;; Prevent puthash from adding new entries.  Note this doesn't keep it from undeleting
     644  ;; existing entries, so we might still lose, but this makes the odds much smaller.
     645  (setf (nhash.grow-threshold hash) 0)
     646  (let* ((old-vector (nhash.vector hash))
     647         (inherited-flags (logand $nhash_weak_flags_mask (nhash.vector.flags old-vector)))
     648         count new-vector grow-threshold vector-size)
     649    (tagbody
     650     RESTART
     651     (setq count (lock-free-count-entries hash))
     652     (multiple-value-setq (grow-threshold vector-size)
     653       (compute-hash-size count (nhash.rehash-size hash) (nhash.rehash-ratio hash)))
     654     (setq new-vector (%cons-nhash-vector vector-size inherited-flags))
     655     REHASH
     656     (loop for i from $nhash.vector_overhead below (uvsize old-vector) by 2
     657       do (let ((value (atomic-swap-gvector (%i+ i 1) old-vector free-hash-key-marker)))
     658            (when (eq value free-hash-key-marker) (error "Who else is doing this?"))
     659            (unless (eq value deleted-hash-key-marker)
     660              (let* ((key (%svref old-vector i))
     661                     (new-index (%growhash-probe new-vector hash key))
     662                     (new-vector-index (index->vector-index new-index)))
     663                (setf (%svref new-vector new-vector-index) key)
     664                (setf (%svref new-vector (%i+ new-vector-index 1)) value)
     665                (when (%i<= (decf grow-threshold) 0)
     666                  ;; Too many entries got undeleted while we were rehashing!
     667                  (go RESTART))))))
     668     (when (%needs-rehashing-p new-vector) ;; keys moved, but at least can use the same new-vector.
     669       (%init-misc free-hash-key-marker new-vector)
     670       (%init-nhash-vector new-vector inherited-flags)
     671       (go REHASH))
     672     (setf (nhash.vector.hash new-vector) hash)
     673     (setf (nhash.grow-threshold hash) grow-threshold)
     674     ;; At this point, another thread might decrement the threshold while they're looking at the old vector.
     675     ;; That's ok, just means it will be too small and we'll rehash sooner than planned, no big deal.
     676     (setf (nhash.vector.hash new-vector) hash))))
     677
    696678
    697679(defun lock-free-gethash (key hash default)
     
    699681  (loop
    700682    (let* ((vector (nhash.vector hash))
    701            ;; **TODO make this return nil if FREE, then won't have to refetch.
    702683           (vector-index (funcall (the function (nhash.find hash)) hash key)))
    703       (cond ((or (null vector-index)
    704                  (neq vector (nhash.vector hash))
    705                  (eq (%svref vector vector-index) free-hash-key-marker))
    706              ;; It's kinda risky to use lock-free hash tables with address-based
    707              ;; keys, because it will thrash in low-memory situations, but we don't
    708              ;; disallow it because there are situations where it won't be a problem.
    709              (unless (or (%needs-rehashing-p hash)
     684      (declare (fixnum vector-index))
     685      (cond ((or (eql vector-index -1)
     686                 (neq vector (nhash.vector hash)))
     687             (unless (or (%needs-rehashing-p vector)
     688                         ;; Need to punt if vector changed because no way to know
     689                         ;; whether nhash.find was using old or new vector.
    710690                         (neq vector (nhash.vector hash)))
    711691               (return-from lock-free-gethash (values default nil))))
     
    725705    (let* ((vector (nhash.vector hash))
    726706           (vector-index (funcall (the function (nhash.find hash)) hash key)))
    727       (cond ((or (null vector-index)
    728                  (neq vector (nhash.vector hash))
    729                  (eq (%svref vector vector-index) free-hash-key-marker))
    730              (unless (or (%needs-rehashing-p hash)
     707      (declare (fixnum vector-index))
     708      (cond ((or (eql vector-index -1)
     709                 (neq vector (nhash.vector hash)))
     710             (unless (or (%needs-rehashing-p vector)
     711                         ;; Need to punt if vector changed because no way to know
     712                         ;; whether nhash.find was using old or new vector.
    731713                         (neq vector (nhash.vector hash)))
    732714               (return-from lock-free-remhash nil)))
     
    734716                 (unless (or (eq old-value free-hash-key-marker)
    735717                             (neq vector (nhash.vector hash)))
    736                    (when (eq value deleted-hash-key-marker)
     718                   (when (eq old-value deleted-hash-key-marker)
    737719                     (return-from lock-free-remhash nil))
    738                    (when (set-hash-value-conditional index vector old-value deleted-hash-key-marker)
     720                   (when (set-hash-value-conditional vector-index vector old-value deleted-hash-key-marker)
    739721                     (return-from lock-free-remhash t))))))
    740722      ;; We're here because the table needs rehashing or it was getting rehashed while we
     
    766748  (loop
    767749    (let* ((vector (nhash.vector  hash))
    768            (vector-index (funcall (nhash.find-new hash) hash key))
    769            (rehashed (neq vector (nhash.vector hash))))
    770       (cond ((or rehashed
    771                  (null vector-index)
    772                  (eq (%svref vector vector-index) free-hash-key-marker))
    773              (unless (or rehashed
    774                          (%needs-rehashing-p hash)
    775                          (%i<= (nhash.grow-threshold hash) 0))
    776                (atomic-decf (nhash.grow-threshold hash))
    777                (when (set-hash-key-conditional index vector free-hash-key-marker key)
    778                  (when (set-hash-value-conditional index vector deleted-hash-key-marker value)
    779                    (return-from lock-free-puthash value)))))
    780             (t (let ((old-value (%svref vector (%i+ vector-index 1))))
    781                  (unless (or (eq old-value free-hash-key-marker)
    782                              (neq vector (nhash.vector hash)))
    783                    (when (set-hash-value-conditional index vector old-value value)
    784                      (return-from lock-free-puthash value)))))))
     750           (vector-index (funcall (nhash.find-new hash) hash key)))
     751      ;; Need to punt if vector changed because no way to know
     752      ;; whether nhash.find-new was using old or new vector.
     753      (when (eq vector (nhash.vector hash))
     754        (cond ((or (eql vector-index -1)
     755                   (eq (%svref vector vector-index) free-hash-key-marker))
     756               (unless (or (%needs-rehashing-p vector)
     757                           (%i<= (nhash.grow-threshold hash) 0))
     758                 ;; Note if the puthash fails, grow-threshold will end up too small. This
     759                 ;; just means we might rehash sooner than absolutely necessary, no real
     760                 ;; harm done (the most likely cause of failing is that somebody is already
     761                 ;; rehashing anyway).
     762                 ;; DON'T try to incf it back on failure -- that risks grow-threshold ending
     763                 ;; up too big (e.g. if somebody rehashes before the incf), which could be harmful.
     764                 (atomic-decf (nhash.grow-threshold hash))
     765                 (if (set-hash-key-conditional vector-index vector free-hash-key-marker key)
     766                   (when (set-hash-value-conditional vector-index vector deleted-hash-key-marker value)
     767                     (return-from lock-free-puthash value)))))
     768              (t (let ((old-value (%svref vector (%i+ vector-index 1))))
     769                   (unless (or (eq old-value free-hash-key-marker)
     770                               (neq vector (nhash.vector hash)))
     771                     (when (set-hash-value-conditional vector-index vector old-value value)
     772                       (return-from lock-free-puthash value))))))))
    785773    ;; We're here because the table needs rehashing or it was getting rehashed while we
    786774    ;; were searching, or no room for new entry, or somebody else claimed the key from
     
    790778
    791779
     780(defun lock-free-count-entries (hash)
     781  ;; Other threads could be adding/removing entries while we count, some of
     782  ;; which will be included in the count (i.e. will be treated as if they
     783  ;; happened after counting) and some won't (i.e. will be treated as if
     784  ;; they happened before counting), but not necessarily in correlation
     785  ;; with their temporal relationship.
     786  (loop
     787    with vector = (nhash.vector hash)
     788    for i fixnum from $nhash.vector_overhead below (uvsize vector) by 2
     789    count (and (neq (%svref vector i) free-hash-key-marker)
     790               (let ((value (%svref vector (%i+ i 1))))
     791                 (when (eq value free-hash-key-marker)
     792                   ;; This table is being rehashed.  Wait for it to be
     793                   ;; done and try again.
     794                   (lock-free-rehash hash)
     795                   (return-from lock-free-count-entries (lock-free-count-entries hash)))
     796                 (neq value deleted-hash-key-marker)))))
     797
     798;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    792799
    793800
     
    798805  (unless (typep hash 'hash-table)
    799806    (report-bad-arg hash 'hash-table))
    800   (when (logbitp $nhash.lock-free (nhash.lock hash))
     807  (when (hash-lock-free-p hash)
    801808    (return-from gethash (lock-free-gethash key hash default)))
    802809  (let* ((value nil)
    803          (vector-index nil)
    804          (vector-key nil)
    805810         (gc-locked nil)
    806811         (readonly nil)
    807          (foundp nil)
    808          (vector nil))
     812         (foundp nil))
    809813    (with-lock-context
    810814      (without-interrupts
     
    819823              (let* ((vector-index (funcall (nhash.find hash) hash key)))
    820824                (declare (fixnum vector-index))
    821                 ;; Referencing both key and value here - and referencing
    822                 ;; value first - is an attempt to compensate for the
    823                 ;; possibility that the GC deletes a weak-on-key pair.
    824                 (setq value (%svref vector (the fixnum (1+ vector-index)))
    825                       vector-key (%svref vector vector-index))
    826                 (cond ((setq foundp (and (not (eq vector-key free-hash-key-marker))
    827                                          (not (eq vector-key deleted-hash-key-marker))))
     825                (cond ((setq foundp (not (eql vector-index -1)))
     826                       ;; Referencing both key and value here - and referencing
     827                       ;; value first - is an attempt to compensate for the
     828                       ;; possibility that the GC deletes a weak-on-key pair.
     829                       (setq value (%svref vector (%i+ vector-index 1)))
    828830                       (when (nhash.owner hash)
    829                          (setf (nhash.vector.cache-key vector) vector-key
    830                                (nhash.vector.cache-value vector) value
    831                                (nhash.vector.cache-idx vector) (vector-index->index
    832                                                                 vector-index)))
     831                         (setf (nhash.vector.cache-key vector)
     832                               (%svref vector vector-index)
     833                               (nhash.vector.cache-value vector)
     834                               value
     835                               (nhash.vector.cache-idx vector)
     836                               (vector-index->index (the fixnum vector-index))))
    833837                       (return))
    834                       ((%needs-rehashing-p hash)
     838                      ((%needs-rehashing-p vector)
    835839                       (%lock-gc-lock)
    836840                       (setq gc-locked t)
     
    838842                         (let* ((lock (nhash.exclusion-lock hash)))
    839843                           (when lock (%promote-rwlock lock))))
    840                        (when (%needs-rehashing-p hash)
     844                       (when (%needs-rehashing-p vector)
    841845                         (%rehash hash)))
    842846                      (t (return)))))))
     
    852856  (unless (typep hash 'hash-table)
    853857    (setq hash (require-type hash 'hash-table)))
    854   (when (logbitp $nhash.lock-free (nhash.lock hash))
     858  (when (hash-lock-free-p hash)
    855859    (return-from remhash (lock-free-remhash key hash)))
    856860  (let* ((foundp nil))
     
    859863       (write-lock-hash-table hash)
    860864       (%lock-gc-lock)
    861        (when (%needs-rehashing-p hash)
    862          (%rehash hash))   
    863865       (let* ((vector (nhash.vector hash)))
     866         (when (%needs-rehashing-p vector)
     867           (%rehash hash))
    864868         (if (eq key (nhash.vector.cache-key vector))
    865869           (progn
     
    870874               (setf (%svref vector (the fixnum (1+ vidx))) nil))
    871875             (incf (the fixnum (nhash.vector.deleted-count vector)))
    872              (decf (the fixnum (nhash.count hash)))
     876             (decf (the fixnum (nhash.vector.count vector)))
    873877             (setq foundp t))
    874            (let* ((vector-index (funcall (nhash.find hash) hash key))
    875                   (vector-key (%svref vector vector-index)))
     878           (let* ((vector-index (funcall (nhash.find hash) hash key)))
    876879             (declare (fixnum vector-index))
    877              (when (setq foundp (and (not (eq vector-key free-hash-key-marker))
    878                                      (not (eq vector-key deleted-hash-key-marker))))
     880             (unless (eql vector-index -1)
    879881               ;; always clear the cache cause I'm too lazy to call the
    880882               ;; comparison function and don't want to keep a possibly
     
    884886               ;; Update the count
    885887               (incf (the fixnum (nhash.vector.deleted-count vector)))
    886                (decf (the fixnum (nhash.count hash)))
    887                ;; Remove a cons from the free-alist if the table is finalizeable
    888                (when (logbitp $nhash_finalizeable_bit (nhash.vector.flags vector))
    889                  (pop (the list (svref nhash.vector.free-alist vector))))
     888               (decf (the fixnum (nhash.vector.count vector)))
    890889               ;; Delete the value from the table.
    891890               (setf (%svref vector vector-index) deleted-hash-key-marker
    892                      (%svref vector (the fixnum (1+ vector-index))) nil))))
     891                     (%svref vector (the fixnum (1+ vector-index))) nil)
     892               (setq foundp t))))
    893893         (when (and foundp
    894                     (zerop (the fixnum (nhash.count hash))))
     894                    (zerop (the fixnum (nhash.vector.count vector))))
    895895           (do* ((i $nhash.vector_overhead (1+ i))
    896896                 (n (uvsize vector)))
     
    915915  (unless (typep hash 'hash-table)
    916916    (report-bad-arg hash 'hash-table))
    917   (when (logbitp $nhash.lock-free (nhash.lock hash))
     917  (when (hash-lock-free-p hash)
    918918    (return-from clrhash (lock-free-clrhash hash)))
    919919  (with-lock-context
     
    929929         (incf index))
    930930       (incf (the fixnum (nhash.grow-threshold hash))
    931              (the fixnum (+ (the fixnum (nhash.count hash))
     931             (the fixnum (+ (the fixnum (nhash.vector.count vector))
    932932                            (the fixnum (nhash.vector.deleted-count vector)))))
    933        (setf (nhash.count hash) 0
     933       (setf (nhash.vector.count vector) 0
    934934             (nhash.vector.cache-key vector) free-hash-key-marker
    935935             (nhash.vector.cache-value vector) nil
     
    948948  (unless (typep hash 'hash-table)
    949949    (report-bad-arg hash 'hash-table))
    950   (when (logbitp $nhash.lock-free (nhash.lock hash))
     950  (when (hash-lock-free-p hash)
    951951    (return-from puthash (lock-free-puthash key hash value)))
    952952  (if (eq key free-hash-key-marker)
     
    959959        AGAIN
    960960          (%lock-gc-lock)
    961           (when (%needs-rehashing-p hash)
    962             (%rehash hash))
    963           (let ((vector (nhash.vector  hash)))     
     961          (let ((vector (nhash.vector hash)))
     962            (when (%needs-rehashing-p vector)
     963              (%rehash hash))
    964964            (when (eq key (nhash.vector.cache-key vector))
    965965              (let* ((idx (nhash.vector.cache-idx vector)))
     
    976976                     (%set-hash-table-vector-key vector vector-index key)
    977977                     (setf (%svref vector (the fixnum (1+ vector-index))) value)
    978                      (setf (nhash.count hash) (the fixnum (1+ (the fixnum (nhash.count hash)))))
     978                     (incf (the fixnum (nhash.vector.count vector)))
    979979                     ;; Adjust deleted-count
    980980                     (when (> 0 (the fixnum
    981981                                  (decf (the fixnum
    982982                                          (nhash.vector.deleted-count vector)))))
    983                        (let ((weak-deletions (nhash.vector.weak-deletions-count vector)))
    984                          (declare (fixnum weak-deletions))
    985                          (setf (nhash.vector.weak-deletions-count vector) 0)
    986                          (incf (the fixnum (nhash.vector.deleted-count vector)) weak-deletions)
    987                          (decf (the fixnum (nhash.count hash)) weak-deletions))))
     983                       (%normalize-hash-table-count hash)))
    988984                    ((eq old-value free-hash-key-marker)
    989985                     (when (eql 0 (nhash.grow-threshold hash))
    990986                       (%unlock-gc-lock)
    991                        (grow-hash-table hash)
     987                       (%grow-hash-table hash)
    992988                       (go AGAIN))
    993989                     (%set-hash-table-vector-key vector vector-index key)
    994990                     (setf (%svref vector (the fixnum (1+ vector-index))) value)
    995991                     (decf (the fixnum (nhash.grow-threshold hash)))
    996                      (incf (the fixnum (nhash.count hash))))
     992                     (incf (the fixnum (nhash.vector.count vector))))
    997993                    (t
    998994                     ;; Key was already there, update value.
     
    10071003
    10081004(defun count-entries (hash)
    1009   (let* ((vector (nhash.vector hash))
    1010          (size (uvsize vector))
    1011          (idx $nhash.vector_overhead)
    1012          (count 0))
    1013     (loop
    1014       (when (neq (%svref vector idx) free-hash-key-marker)
    1015         (incf count))
    1016       (when (>= (setq idx (+ idx 2)) size)
    1017         (return count)))))
     1005  (if (hash-lock-free-p hash)
     1006    (lock-free-count-entries hash)
     1007    (let* ((vector (nhash.vector hash))
     1008           (size (uvsize vector))
     1009           (idx $nhash.vector_overhead)
     1010           (count 0))
     1011      (loop
     1012        (when (neq (%svref vector idx) free-hash-key-marker)
     1013          (incf count))
     1014        (when (>= (setq idx (+ idx 2)) size)
     1015          (return count))))))
    10181016
    10191017
     
    10341032    (%normalize-hash-table-count hash)
    10351033    (let* ((old-vector (nhash.vector hash))
    1036            (old-size (nhash.count hash))
    1037            (old-total-size (nhash.vector-size old-vector))
     1034           (old-size (nhash.vector.count old-vector))
     1035           (old-total-size (nhash.vector.size old-vector))
    10381036           (flags 0)
    10391037           (flags-sans-weak 0)
    1040            (weak-flags)
    1041            rehashF)
     1038           (weak-flags 0))
    10421039      (declare (fixnum old-total-size flags flags-sans-weak weak-flags))   
    1043       ; well we knew lock was 0 when we called this - is it still 0?
    10441040      (when (> (nhash.vector.deleted-count old-vector) 0)
    10451041        ;; There are enough deleted entries. Rehash to get rid of them
     
    10531049        (progn
    10541050          (unwind-protect
    1055             (let ((fwdnum (get-fwdnum))
    1056                   (gc-count (gc-count))
     1051            (let ((gc-count (%get-gc-count))
    10571052                  vector)
    10581053              (setq flags (nhash.vector.flags old-vector)
    10591054                    flags-sans-weak (logand flags (logxor -1 $nhash_weak_flags_mask))
    1060                     weak-flags (logand flags $nhash_weak_flags_mask)
    1061                     rehashF (nhash.rehashF hash))         
    1062               (setf (nhash.lock hash) (%ilogior (nhash.lock hash) $nhash.lock-while-growing) ; dont need
    1063                     (nhash.rehashF hash) #'%am-growing
    1064                     (nhash.vector.flags old-vector) flags-sans-weak)      ; disable GC weak stuff
     1055                    weak-flags (logand flags $nhash_weak_flags_mask))
     1056              (setf (nhash.vector.flags old-vector) flags-sans-weak)      ; disable GC weak stuff
    10651057              (%normalize-hash-table-count hash)
     1058              (when (> (nhash.vector.deleted-count old-vector) 0)
     1059                (return-from grow-hash-table (%rehash hash)))
    10661060              (setq vector (%cons-nhash-vector total-size 0))
    10671061              (do* ((index 0 (1+ index))
     
    10831077                     (nhash.vector.free-alist vector)
    10841078                     (nhash.vector.free-alist old-vector)
     1079                     (nhash.vector.count vector) old-size
    10851080                     (nhash.vector.flags vector)
    10861081                     (logior weak-flags (the fixnum (nhash.vector.flags vector))))
     
    10901085                     (nhash.vector.cache-key vector) free-hash-key-marker
    10911086                     (nhash.vector.cache-value vector) nil
    1092                      (nhash.fixnum hash) fwdnum
    1093                      (nhash.gc-count hash) gc-count
    1094                      (nhash.grow-threshold hash) (- size (nhash.count hash)))
    1095                (when (eq #'%am-growing (nhash.rehashF hash))
    1096                  ;; if not changed to %maybe-rehash then contains no address based keys
    1097                  (setf (nhash.rehashf hash) #'%no-rehash))
    1098                (setq rehashF nil)       ; tell clean-up form we finished the loop
    1099                (when (neq old-size (nhash.count hash))
    1100                  (cerror "xx" "Somebody messed with count while growing")
    1101                  (return-from grow-hash-table (grow-hash-table hash )))
    1102                (when (minusp (nhash.grow-threshold hash))
    1103                  (cerror "nn" "negative grow-threshold ~S ~s ~s ~s"
    1104                          (nhash.grow-threshold hash) size total-size old-size))
     1087                     (nhash.vector.gc-count vector) gc-count
     1088                     (nhash.grow-threshold hash) (- size old-size))
     1089               (setq weak-flags nil)       ; tell clean-up form we finished the loop
    11051090               ;; If the old vector's in some static heap, zero it
    11061091               ;; so that less garbage is retained.
    1107                (%init-misc 0 old-vector)))           
    1108             (when rehashF
    1109               (setf (nhash.rehashF hash) rehashF
    1110                     (nhash.vector.flags old-vector)
     1092               (%init-misc 0 old-vector)))
     1093            (when weak-flags
     1094              (setf (nhash.vector.flags old-vector)
    11111095                    (logior weak-flags (the fixnum (nhash.vector.flags old-vector)))))))))))
    11121096
    11131097
    1114 
    1115 ;;; values of nhash.rehashF
    1116 ;;; %no-rehash - do nothing
    1117 ;;; %maybe-rehash - if doesnt need rehashing - if is rehashing 0 else nil
    1118 ;                 if locked 0
    1119 ;                 else rehash, return t
    1120 ;;; %am-rehashing - 0
    1121 ;;; %am-growing   - calls %maybe-rehash
    1122 
    1123 ;;; compute-hash-code funcalls it if addressp and maybe-rehash-p
    1124 ;;;                  sets to maybe-rehash if addressp and update-maybe-rehash (ie from puthash)
    1125 ;;; grow-hash-table sets to %am-growing when doing so, resets to original value when done
    1126 ;;; rehash sets to %am-rehashing, then to original when done
    1127 
    1128 (defun %no-rehash (hash)
    1129   (declare (%noforcestk)
    1130            (optimize (speed 3) (safety 0))
    1131            (ignore hash))
    1132   nil)
    1133 
    1134 (defun %maybe-rehash (hash)
    1135   (declare (optimize (speed 3) (safety 0)))
    1136   (cond ((not (%needs-rehashing-p hash))
    1137          nil)
    1138         (t (loop
    1139              (%rehash hash)
    1140              (unless (%needs-rehashing-p hash)
    1141                (return))
    1142              ;(incf n3)
    1143              )
    1144            t)))
    1145 
    1146 (defun %am-rehashing (hash)
    1147   (declare (optimize (speed 3) (safety 0))
    1148            (ignore hash))
    1149   0)
    1150 
    1151 (defun %am-growing (hash)
    1152   (declare (optimize (speed 3) (safety 0)))
    1153   (%maybe-rehash hash))
    11541098
    11551099(defun general-hash-find (hash key)
     
    11661110
    11671111
    1168 (defun %hash-probe (hash key update-hash-flags)
     1112(defun %hash-probe (hash key for-put-p)
    11691113  (declare (optimize (speed 3) (space 0)))
    11701114  (multiple-value-bind (hash-code index entries)
    1171                        (compute-hash-code hash key update-hash-flags)
     1115                       (compute-hash-code hash key for-put-p)
    11721116    (locally (declare (fixnum hash-code index entries))
    11731117      (let* ((compareF (nhash.compareF hash))
     
    11851129                                table-key (%svref vector vector-index))
    11861130                          (cond ((eq table-key free-hash-key-marker)
    1187                                  (return-it (or first-deleted-index
    1188                                                 vector-index)))
     1131                                 (return-it (if for-put-p
     1132                                              (or first-deleted-index
     1133                                                  vector-index)
     1134                                              -1)))
    11891135                                ((eq table-key deleted-hash-key-marker)
    11901136                                 (when (null first-deleted-index)
     
    12041150                                  (decf index entries))
    12051151                                (when (eql index initial-index)
    1206                                   (unless first-deleted-index
    1207                                     (error "No deleted entries in table"))
    1208                                   (return-it first-deleted-index))
     1152                                  (return-it (if for-put-p
     1153                                               (or first-deleted-index
     1154                                                   (error "Bug: no deleted entries in table"))
     1155                                               -1)))
    12091156                                (test-it ,predicate))))))
    12101157              (if (fixnump comparef)
     
    12351182         (table-key (%svref vector vector-index)))
    12361183    (declare (fixnum hash-code  entries vector-index))
    1237     (if (or (eq key table-key)
    1238             (eq table-key free-hash-key-marker))
     1184    (if (eq table-key key)
    12391185      vector-index
    1240       (let* ((secondary-hash (%svref secondary-keys-*-2
    1241                                      (logand 7 hash-code)))
    1242              (initial-index vector-index)             
    1243              (first-deleted-index (if (eq table-key deleted-hash-key-marker)
    1244                                     vector-index))
    1245              (count (+ entries entries))
    1246              (length (+ count $nhash.vector_overhead)))
    1247         (declare (fixnum secondary-hash initial-index count length))
    1248         (loop
    1249           (incf vector-index secondary-hash)
    1250           (when (>= vector-index length)
    1251             (decf vector-index count))
    1252           (setq table-key (%svref vector vector-index))
    1253           (when (= vector-index initial-index)
    1254             (return first-deleted-index))
    1255           (if (eq table-key key)
    1256             (return vector-index)
    1257             (if (eq table-key free-hash-key-marker)
    1258               (return (or first-deleted-index vector-index))
    1259               (if (and (null first-deleted-index)
    1260                        (eq table-key deleted-hash-key-marker))
    1261                 (setq first-deleted-index vector-index)))))))))
     1186      (if (eq table-key free-hash-key-marker)
     1187        -1
     1188        (let* ((secondary-hash (%svref secondary-keys-*-2
     1189                                       (logand 7 hash-code)))
     1190               (initial-index vector-index)             
     1191               (count (+ entries entries))
     1192               (length (+ count $nhash.vector_overhead)))
     1193          (declare (fixnum secondary-hash initial-index count length))
     1194          (loop
     1195            (incf vector-index secondary-hash)
     1196            (when (>= vector-index length)
     1197              (decf vector-index count))
     1198            (setq table-key (%svref vector vector-index))
     1199            (when (= vector-index initial-index)
     1200              (return -1))
     1201            (if (eq table-key key)
     1202              (return vector-index)
     1203              (when (eq table-key free-hash-key-marker)
     1204                (return -1)))))))))
    12621205
    12631206;;; As above, but note whether the key is in some way address-based
     
    13061249          (setq table-key (%svref vector vector-index))
    13071250          (when (= vector-index initial-index)
    1308             (return first-deleted-index))
     1251            (or first-deleted-index
     1252                (error "Bug: no deleted entries in table")))
    13091253          (if (eq table-key key)
    13101254            (return vector-index)
     
    13241268           (table-key (%svref vector vector-index)))
    13251269      (declare (fixnum hash-code entries vector-index))
    1326       (if (or (eql key table-key)
    1327               (eq table-key free-hash-key-marker))
     1270      (if (eql key table-key)
    13281271        vector-index
    1329         (let* ((secondary-hash (%svref secondary-keys-*-2
    1330                                        (logand 7 hash-code)))
    1331                (initial-index vector-index)
    1332                (first-deleted-index (if (eq table-key deleted-hash-key-marker)
    1333                                       vector-index))
    1334                (count (+ entries entries))
    1335                (length (+ count $nhash.vector_overhead)))
    1336           (declare (fixnum secondary-hash initial-index count length))
    1337           (loop
    1338             (incf vector-index secondary-hash)
    1339             (when (>= vector-index length)
    1340               (decf vector-index count))
    1341             (setq table-key (%svref vector vector-index))
    1342             (when (= vector-index initial-index)
    1343               (return first-deleted-index))
    1344           (if (eql table-key key)
    1345             (return vector-index)
    1346             (if (eq table-key free-hash-key-marker)
    1347               (return (or first-deleted-index vector-index))
    1348               (if (and (null first-deleted-index)
    1349                        (eq table-key deleted-hash-key-marker))
    1350                 (setq first-deleted-index vector-index))))))))
     1272        (if (eq table-key free-hash-key-marker)
     1273          -1
     1274          (let* ((secondary-hash (%svref secondary-keys-*-2
     1275                                         (logand 7 hash-code)))
     1276                 (initial-index vector-index)
     1277                 (count (+ entries entries))
     1278                 (length (+ count $nhash.vector_overhead)))
     1279            (declare (fixnum secondary-hash initial-index count length))
     1280            (loop
     1281              (incf vector-index secondary-hash)
     1282              (when (>= vector-index length)
     1283                (decf vector-index count))
     1284              (setq table-key (%svref vector vector-index))
     1285              (when (= vector-index initial-index)
     1286                (return -1))
     1287              (if (eql table-key key)
     1288                (return vector-index)
     1289                (when (eq table-key free-hash-key-marker)
     1290                  (return -1))))))))
    13511291    (eq-hash-find hash key)))
    13521292
     
    13881328    (eq-hash-find-for-put hash key)))
    13891329
    1390 ;;; Rehash.  Caller should have exclusive access to the hash table
    1391 ;;; and have disabled interrupts.
    1392 (defun %rehash (hash)
    1393   (let* ((vector (nhash.vector hash))
    1394          (flags (nhash.vector.flags vector))         )
    1395     (setf (nhash.vector.flags vector)
    1396           (logand flags $nhash-clear-key-bits-mask))
    1397     (do-rehash hash)))
    1398 
    1399 
    14001330(defun %make-rehash-bits (hash &optional (size (nhash.vector-size (nhash.vector hash))))
    14011331  (declare (fixnum size))
     
    14071337    (fill (the simple-bit-vector rehash-bits) 0)))
    14081338
    1409 (defun do-rehash (hash)
     1339;;; Rehash.  Caller should have exclusive access to the hash table
     1340;;; and have disabled interrupts.
     1341(defun %rehash (hash)
    14101342  (let* ((vector (nhash.vector hash))
     1343         (flags (nhash.vector.flags vector))
    14111344         (vector-index (- $nhash.vector_overhead 2))
    14121345         (size (nhash.vector-size vector))
    14131346         (rehash-bits (%make-rehash-bits hash size))
    14141347         (index -1))
    1415     (declare (fixnum size index vector-index))   
     1348    (declare (fixnum size index vector-index))
     1349    (setf (nhash.vector.flags vector)
     1350          (logand flags $nhash-clear-key-bits-mask))
    14161351    (setf (nhash.vector.cache-key vector) free-hash-key-marker
    14171352          (nhash.vector.cache-value vector) nil)
     
    14331368                      (setf (nhash.vector.weak-deletions-count vector) 0)
    14341369                      (incf (nhash.vector.deleted-count vector) wdc)
    1435                       (decf (nhash.count hash) wdc)))
     1370                      (decf (nhash.vector.count vector) wdc)))
    14361371                  (incf (nhash.grow-threshold hash))
    14371372                  ;; Change deleted to free
     
    14671402                                  (setf (nhash.vector.weak-deletions-count vector) 0)
    14681403                                  (incf (nhash.vector.deleted-count vector) wdc)
    1469                                   (decf (nhash.count hash) wdc)))
     1404                                  (decf (nhash.vector.count vector) wdc)))
    14701405                              (incf (nhash.grow-threshold hash))))
    14711406                          (return))
     
    14731408                          (cerror "Delete one of the entries." "Duplicate key: ~s in ~s ~s ~s ~s ~s"
    14741409                                  key hash value newvalue index found-index)                       
    1475                           (decf (nhash.count hash))
     1410                          (decf (nhash.vector.count vector))
    14761411                          (incf (nhash.grow-threshold hash))
    14771412                          (return))
     
    18001735
    18011736
    1802 (defun get-fwdnum (&optional hash)
    1803   (let* ((res (%get-fwdnum)))
    1804     (if hash
    1805       (setf (nhash.fixnum hash) res))
    1806     res))
    1807 
    1808 (defun gc-count (&optional hash)
    1809    (let ((res (%get-gc-count)))
    1810     (if hash
    1811       (setf (nhash.gc-count hash) res)
    1812       res)))
    1813 
    1814 
    18151737(defun %cons-nhash-vector (size &optional (flags 0))
    18161738  (declare (fixnum size))
    18171739  (let* ((vector (%alloc-misc (+ (+ size size) $nhash.vector_overhead) target::subtag-hash-vector free-hash-key-marker)))
     1740    (%init-nhash-vector vector flags)
     1741    vector))
     1742
     1743(defun %init-nhash-vector (vector &optional (flags 0))
     1744  (let ((size (vector-index->index (uvsize vector))))
     1745    (declare (fixnum size))
    18181746    (setf (nhash.vector.link vector) 0
    18191747          (nhash.vector.flags vector) flags
     1748          (nhash.vector.gc-count vector) (%get-gc-count)
    18201749          (nhash.vector.free-alist vector) nil
    18211750          (nhash.vector.finalization-alist vector) nil
     
    18231752          (nhash.vector.hash vector) nil
    18241753          (nhash.vector.deleted-count vector) 0
     1754          (nhash.vector.count vector) 0
    18251755          (nhash.vector.cache-key vector) free-hash-key-marker
    18261756          (nhash.vector.cache-value vector) nil
    18271757          (nhash.vector.cache-idx vector) nil
    18281758          (nhash.vector.size vector) size
    1829           (nhash.vector.size-reciprocal vector) (floor (ash 1 (- target::nbits-in-word target::fixnumshift)) size))
    1830     vector))
     1759          (nhash.vector.size-reciprocal vector) (floor (ash 1 (- target::nbits-in-word target::fixnumshift)) size))))
    18311760
    18321761(defun assert-hash-table-readonly (hash)
     
    18781807            (setf (nhash.owner hash) *current-process*)))
    18791808      (progn
    1880         (write-lock-hash-table hash)
    1881         (setf (nhash.exclusion-lock hash) nil
    1882               (nhash.owner hash) *current-process*)
     1809        (unless (hash-lock-free-p hash)
     1810          (write-lock-hash-table hash)
     1811          (setf (nhash.exclusion-lock hash) nil))
     1812        (setf (nhash.owner hash) *current-process*)
    18831813        t))))
    18841814
    18851815 
    1886  
    1887 
    1888 
    1889 (defun enumerate-hash-keys (hash out)
    1890   (unless (typep hash 'hash-table)
    1891     (report-bad-arg hash 'hash-table))
    1892   (with-lock-context
    1893     (without-interrupts
    1894      (let* ((readonly (eq (read-lock-hash-table hash) :readonly)))
    1895        (do* ((in (nhash.vector hash))
    1896              (in-idx $nhash.vector_overhead (+ in-idx 2))
    1897              (insize (uvsize in))
    1898              (outsize (length out))
    1899              (out-idx 0))
    1900             ((or (= in-idx insize)
    1901                  (= out-idx outsize))
    1902              (unlock-hash-table hash readonly)
    1903              out-idx)
    1904          (declare (fixnum in-idx insize out-idx outsize))
    1905          (let* ((val (%svref in in-idx)))
    1906            (unless (or (eq val free-hash-key-marker)
    1907                        (eq val deleted-hash-key-marker))
    1908              (setf (%svref out out-idx) val)
    1909              (incf out-idx))))))))
     1816;; ** TODO: for lock-free hash tables, we don't need to copy to map,
     1817;; we could map over the actual hash table vector, because it's
     1818;; always valid.
     1819(defun lock-free-enumerate-hash-keys-and-values (hash keys values)
     1820  (do* ((in (nhash.vector hash))
     1821        (in-idx $nhash.vector_overhead (+ in-idx 2))
     1822        (insize (uvsize in))
     1823        (outsize (length (or keys values)))
     1824        (out-idx 0))
     1825       ((or (= in-idx insize)
     1826            (= out-idx outsize))
     1827        out-idx)
     1828    (declare (fixnum in-idx insize out-idx outsize))
     1829    (let* ((key (%svref in in-idx)))
     1830      (unless (eq key free-hash-key-marker)
     1831        (let ((val (%svref in (%i+ in-idx 1))))
     1832          (when (eq val free-hash-key-marker)
     1833            ;; This table is being rehashed.  Wait to finish and try again
     1834            (lock-free-rehash hash)
     1835            (return-from lock-free-enumerate-hash-keys-and-values
     1836                         (lock-free-enumerate-hash-keys-and-values hash keys values)))
     1837          (unless (eq val deleted-hash-key-marker)
     1838            (when keys (setf (%svref keys out-idx) key))
     1839            (when values (setf (%svref values out-idx) val))
     1840            (incf out-idx)))))))
    19101841
    19111842(defun enumerate-hash-keys-and-values (hash keys values)
    19121843  (unless (typep hash 'hash-table)
    19131844    (report-bad-arg hash 'hash-table))
     1845  (when (hash-lock-free-p hash)
     1846    (return-from enumerate-hash-keys-and-values
     1847                 (lock-free-enumerate-hash-keys-and-values hash keys values)))
    19141848  (with-lock-context
    1915     (without-interrupts
    1916      (let* ((readonly (eq (read-lock-hash-table hash) :readonly)))
    1917        (do* ((in (nhash.vector hash))
    1918              (in-idx $nhash.vector_overhead (+ in-idx 2))
    1919              (insize (uvsize in))
    1920              (outsize (length keys))
    1921              (out-idx 0))
    1922             ((or (= in-idx insize)
    1923                  (= out-idx outsize))
    1924              (unlock-hash-table hash readonly)
    1925              out-idx)
    1926          (declare (fixnum in-idx insize out-idx outsize))
    1927          (let* ((key (%svref in in-idx)))
    1928            (unless (or (eq key free-hash-key-marker)
    1929                        (eq key deleted-hash-key-marker))
    1930              (setf (%svref keys out-idx) key)
    1931              (setf (%svref values out-idx) (%svref in (the fixnum (1+ in-idx))))
    1932              (incf out-idx))))))))
     1849      (without-interrupts
     1850       (let* ((readonly (eq (read-lock-hash-table hash) :readonly)))
     1851         (do* ((in (nhash.vector hash))
     1852               (in-idx $nhash.vector_overhead (+ in-idx 2))
     1853               (insize (uvsize in))
     1854               (outsize (length (or keys values)))
     1855               (out-idx 0))
     1856              ((or (= in-idx insize)
     1857                   (= out-idx outsize))
     1858               (unlock-hash-table hash readonly)
     1859               out-idx)
     1860           (declare (fixnum in-idx insize out-idx outsize))
     1861           (let* ((key (%svref in in-idx)))
     1862             (unless (or (eq key free-hash-key-marker)
     1863                         (eq key deleted-hash-key-marker))
     1864               (when keys
     1865                 (setf (%svref keys out-idx) key))
     1866               (when values
     1867                 (setf (%svref values out-idx) (%svref in (%i+ in-idx 1))))
     1868               (incf out-idx))))))))
     1869 
     1870(defun enumerate-hash-keys (hash out)
     1871  (enumerate-hash-keys-and-values hash out nil))
  • branches/gz/lib/hash.lisp

    r10619 r10709  
    9898;; about followed by alternating keys and values.  Empty slots have a
    9999;; key of (%UNBOUND-MARKER), deleted slots are denoted by a key of
    100 ;; (%SLOT-UNBOUND-MARKER).
     100;; (%SLOT-UNBOUND-MARKER), except in the case of "lock-free" hash
     101;; tables, which see below.
    101102;;
    102103;; Four bits in the nhash.vector.flags fixnum interact with the garbage
     
    108109;; The 32 bits of the fixnum at nhash.vector.flags look like:
    109110;;
    110 ;;     TK0C0000 00000000 WVF00000 00000000
     111;;     TTTTKEC0 00000000 000WVFZ0 00000000
    111112;;
    112113;;
     
    139140;;                               the nhash.vector.finalization-alist using cons cells
    140141;;                               from nhash.vector.free-alist
     142;; $nhash_keys_frozen_bit       "Z" in diagram above.
     143;;                               If set, GC will remove weak entries by setting the
     144;;                               value to (%slot-unbound-marker), leaving key unchanged.
    141145
    142146(in-package "CCL")
     
    164168
    165169
     170#+vaporware
    166171;;; Of course, the lisp version of this would be too slow ...
    167172(defun hash-table-finalization-list (hash-table)
     
    175180      (error "~S is not a finalizeable hash table" hash-table))))
    176181
     182#+vaporware
    177183(defun (setf hash-table-finalization-list) (value hash-table)
    178184  (unless (hash-table-p hash-table)
     
    242248  (declare (ignore env))
    243249  (%normalize-hash-table-count hash)
    244   (let ((rehashF (function-name (nhash.rehashF hash)))
    245         (keytransF (nhash.keytransF hash))
     250  (let ((keytransF (nhash.keytransF hash))
    246251        (compareF (nhash.compareF hash))
    247252        (vector (nhash.vector hash))
    248253        (private (if (nhash.owner hash) '*current-process*))
    249         (count (nhash.count hash)))
     254        (lock-free-p (logtest $nhash.lock-free (the fixnum (nhash.lock hash)))))
    250255    (flet ((convert (f)
    251256             (if (or (fixnump f) (symbolp f))
     
    254259      (values
    255260       `(%cons-hash-table
    256          nil nil nil nil ,(nhash.grow-threshold hash) ,(nhash.rehash-ratio hash) ,(nhash.rehash-size hash) ,(nhash.address-based hash) nil nil ,private)
    257        `(%initialize-hash-table ,hash ',rehashF ,(convert keytransF) ,(convert compareF)
    258                                 ',vector ,count)))))
     261         nil nil nil ,(nhash.grow-threshold hash) ,(nhash.rehash-ratio hash) ,(nhash.rehash-size hash)
     262        nil nil ,private ,lock-free-p)
     263       `(%initialize-hash-table ,hash ,(convert keytransF) ,(convert compareF) ',vector)))))
    259264
    260265(defun needs-rehashing (hash)
    261266  (%set-needs-rehashing hash))
    262267
    263 (defun %initialize-hash-table (hash rehashF keytransF compareF vector count)
    264   (setf (nhash.rehashF hash) (symbol-function rehashF)
    265         (nhash.keytransF hash) keytransF
    266         (nhash.compareF hash) compareF
    267         (nhash.vector hash) vector
    268         (nhash.count hash) count)
     268(defun %initialize-hash-table (hash keytransF compareF vector)
     269  (setf (nhash.keytransF hash) keytransF
     270        (nhash.compareF hash) compareF)
    269271  (setf (nhash.find hash)
    270272        (case comparef
     
    277279          (-1 #'eql-hash-find-for-put)
    278280          (t #'general-hash-find-for-put)))
     281  (setf (nhash.vector hash) vector)
    279282  (%set-needs-rehashing hash))
    280283
     
    291294   (let* ((lock (nhash.exclusion-lock hash-table)))
    292295     (if lock
    293        (write-lock-rwlock lock)
    294296       (progn
    295          (unless (eq (nhash.owner hash-table) *current-process*)
    296            (error "Current process doesn't own hash-table ~s" hash-table))))
    297      (push hash-table *fcomp-locked-hash-tables*))))
     297         (if (hash-lock-free-p hash-table)
     298           ;; For lock-free hash tables, this only makes sure nobody is
     299           ;; rehashing the table.  It doesn't necessarily stop readers
     300           ;; or writers (unless they need to rehash).
     301           (grab-lock lock)
     302           (write-lock-rwlock lock))
     303         (push hash-table *fcomp-locked-hash-tables*))
     304       (unless (eq (nhash.owner hash-table) *current-process*)
     305         (error "Current process doesn't own hash-table ~s" hash-table))))))
    298306
    299307(defun fasl-unlock-hash-tables ()
    300308  (dolist (h *fcomp-locked-hash-tables*)
    301309    (let* ((lock (nhash.exclusion-lock h)))
    302       (if lock (unlock-rwlock lock)))))
     310      (if (hash-lock-free-p h)
     311        (release-lock lock)
     312        (unlock-rwlock lock)))))
    303313
    304314
  • branches/gz/library/lispequ.lisp

    r10427 r10709  
    12441244(def-accessors (hash-table) %svref
    12451245    nil                                 ; 'HASH-TABLE
    1246     nhash.rehashF                       ; function: rehashes if necessary
     1246    nhash.unused-1                      ;
    12471247    nhash.keytransF                     ; transform key into (values primary addressp)
    12481248    nhash.compareF                      ; comparison function: 0 -> eq, -1 ->eql, else function
    12491249    nhash.rehash-bits                   ; bitset (array (unsigned-byte 32)) for rehash
    12501250    nhash.vector                        ; N <key,value> pairs; n relatively prime to & larger than all secondary keys
    1251     nhash.lock                          ; fixnum: bits for grow and rehash
    1252     nhash.count                         ; Number of entries
     1251    nhash.lock                          ; flag: non-zero if lock-free
     1252    nhash.unused-2                      ;
    12531253    nhash.owner                         ; tcr of "owning" thread, else NIL.
    1254     nhash.fixnum                        ; fwdnum kernel-global
    1255     nhash.gc-count                      ; gc-count kernel-global
     1254    nhash.unused-3                      ;
     1255    nhash.unused-4                      ;
    12561256    nhash.grow-threshold                ; Max # entries before grow
    12571257    nhash.rehash-ratio                  ; inverted rehash-threshold
     
    12591259    nhash.puthash-count                 ; number of times table has been rehashed or grown
    12601260    nhash.exclusion-lock                ; read-write lock for access
    1261     nhash.rehash-lock                   ; exclusive lock for rehash
    1262     nhash.iterator                      ; current hash-table iterator
    1263     nhash.address-based                 ; hashes based on address
     1261    nhash.unused-5                      ;
     1262    nhash.unused-6                      ;
     1263    nhash.unused-7                      ; # entries a table this size can hold
    12641264    nhash.find                          ; function: find vector-index
    12651265    nhash.find-new                      ; function: find vector-index on put
  • branches/gz/lisp-kernel/gc-common.c

    r10173 r10709  
    218218  Boolean
    219219    weak_on_value = ((hashp->flags & nhash_weak_value_mask) != 0);
     220  Boolean
     221    keys_frozen = ((hashp->flags & nhash_keys_frozen_mask) != 0);
    220222  bitvector markbits = GCmarkbits;
    221223  int tag;
     
    232234      if ((dnode < GCndnodes_in_area) &&
    233235          ! ref_bit(markbits, dnode)) {
    234         pairp[0] = slot_unbound;
    235         pairp[1] = lisp_nil;
     236        if (keys_frozen) {
     237          if (pairp[1] != unbound) {
     238            pairp[1] = slot_unbound;
     239          }
     240        }
     241        else {
     242          pairp[0] = slot_unbound;
     243          pairp[1] = lisp_nil;
     244        }
    236245        hashp->weak_deletions_count += (1<<fixnumshift);
    237246      }
  • branches/gz/lisp-kernel/ppc-constants32.h

    r10010 r10709  
    325325  LispObj link;                 /* If weak */
    326326  LispObj flags;                /* a fixnum; see below */
     327  LispObj gc_count;             /* gc-count kernel global */
    327328  LispObj free_alist;           /* preallocated conses for finalization_alist */
    328329  LispObj finalization_alist;   /* key/value alist for finalization */
    329330  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
    330331  LispObj hash;                 /* backpointer to hash-table */
    331   LispObj deleted_count;        /* number of deleted entries */
     332  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
     333  LispObj count;                /* number of valid entries [not maintained if lock-free] */
    332334  LispObj cache_idx;            /* index of last cached pair */
    333335  LispObj cache_key;            /* value of last cached key */
     
    356358#define nhash_finalizable_mask fixnum_bitmask(10)
    357359
     360/* keys frozen, i.e. don't clobber keys, only values */
     361#define nhash_keys_frozen_mask fixnum_bitmask(9)
    358362
    359363/* Lfun bits */
  • branches/gz/lisp-kernel/ppc-constants64.h

    r10010 r10709  
    304304  LispObj link;                 /* If weak */
    305305  LispObj flags;                /* a fixnum; see below */
     306  LispObj gc_count;             /* gc-count kernel global */
    306307  LispObj free_alist;           /* preallocated conses for finalization_alist */
    307308  LispObj finalization_alist;   /* key/value alist for finalization */
    308309  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
    309310  LispObj hash;                 /* backpointer to hash-table */
    310   LispObj deleted_count;        /* number of deleted entries */
     311  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
     312  LispObj count;                /* number of valid entries [not maintained if lock-free] */
    311313  LispObj cache_idx;            /* index of last cached pair */
    312314  LispObj cache_key;            /* value of last cached key */
     
    335337#define nhash_finalizable_mask fixnum_bitmask(10)
    336338
     339/* keys frozen, i.e. don't clobber keys, only values */
     340#define nhash_keys_frozen_mask fixnum_bitmask(9)
    337341
    338342/* Lfun bits */
     
    343347#define lfbits_optinit_mask fixnum_bitmask(14)
    344348#define lfbits_rest_mask fixnum_bitmask(15)
     349
    345350#define lfbits_aok_mask fixnum_bitmask(16)
    346351#define lfbits_lap_mask fixnum_bitmask(23)
  • branches/gz/lisp-kernel/x86-constants32.h

    r10585 r10709  
    287287  LispObj link;                 /* If weak */
    288288  LispObj flags;                /* a fixnum; see below */
     289  LispObj gc_count;             /* gc-count kernel global */
    289290  LispObj free_alist;           /* preallocated conses for finalization_alist */
    290291  LispObj finalization_alist;   /* key/value alist for finalization */
    291292  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
    292293  LispObj hash;                 /* backpointer to hash-table */
    293   LispObj deleted_count;        /* number of deleted entries */
     294  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
     295  LispObj count;                /* number of valid entries [not maintained if lock-free] */
    294296  LispObj cache_idx;            /* index of last cached pair */
    295297  LispObj cache_key;            /* value of last cached key */
     
    318320#define nhash_finalizable_mask fixnum_bitmask(10)
    319321
     322/* keys frozen, i.e. don't clobber keys, only values */
     323#define nhash_keys_frozen_mask fixnum_bitmask(9)
    320324
    321325/* Lfun bits */
  • branches/gz/lisp-kernel/x86-constants64.h

    r10597 r10709  
    384384  LispObj link;                 /* If weak */
    385385  LispObj flags;                /* a fixnum; see below */
     386  LispObj gc_count;             /* gc-count kernel global */
    386387  LispObj free_alist;           /* preallocated conses for finalization_alist */
    387388  LispObj finalization_alist;   /* key/value alist for finalization */
    388389  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
    389390  LispObj hash;                 /* backpointer to hash-table */
    390   LispObj deleted_count;        /* number of deleted entries */
     391  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
     392  LispObj count;                /* number of valid entries [not maintained if lock-free] */
    391393  LispObj cache_idx;            /* index of last cached pair */
    392394  LispObj cache_key;            /* value of last cached key */
     
    415417#define nhash_finalizable_mask fixnum_bitmask(10)
    416418
     419/* keys frozen, i.e. don't clobber keys, only values */
     420#define nhash_keys_frozen_mask fixnum_bitmask(9)
    417421
    418422/* Lfun bits */
  • branches/gz/xdump/hashenv.lisp

    r10613 r10709  
    2525
    2626
    27 ;;; undistinguished values of nhash.lock
    2827(defconstant $nhash.lock-free #x80000)
    29 
    30 ;; The ones below don't seem to be used.
    31 (defconstant $nhash.lock-while-growing #x10000)
    32 (defconstant $nhash.lock-while-rehashing #x20000)
    33 (defconstant $nhash.lock-grow-or-rehash #x30000)
    34 (defconstant $nhash.lock-map-count-mask #xffff)
    35 (defconstant $nhash.lock-not-while-rehashing #x-20001)
    36 (defconstant $nhash.lock-grow-or-rehash #x30000)
    37 
    38 
    3928
    4029; The hash.vector cell contains a vector with some longwords of overhead
    4130; followed by alternating keys and values.
    42 ; A key of $undefined denotes an empty or deleted value
    43 ; The value will be $undefined for empty values, or NIL for deleted values.
    4431;; If you change anything here, also update the kernel def in XXX-constantsNN.h
    4532(def-accessors () %svref
    4633  nhash.vector.link                     ; GC link for weak vectors
    4734  nhash.vector.flags                    ; a fixnum of flags
     35  nhash.vector.gc-count                 ; gc-count kernel global
    4836  nhash.vector.free-alist               ; empty alist entries for finalization
    4937  nhash.vector.finalization-alist       ; deleted out key/value pairs put here
    5038  nhash.vector.weak-deletions-count     ; incremented when the GC deletes an element
    5139  nhash.vector.hash                     ; back-pointer
    52   nhash.vector.deleted-count            ; number of deleted entries
     40  nhash.vector.deleted-count            ; number of deleted entries [not maintained if lock-free]
     41  nhash.vector.count                    ; number of valid entries [not maintained if lock-free]
    5342  nhash.vector.cache-idx                ; index of last cached key/value pair
    5443  nhash.vector.cache-key                ; cached key
     
    6150; number of longwords of overhead in nhash.vector.
    6251; Must be a multiple of 2 or INDEX parameters in LAP code will not be tagged as fixnums.
    63 (defconstant $nhash.vector_overhead 12)
     52(defconstant $nhash.vector_overhead 14)
    6453
    6554(defconstant $nhash_weak_bit 12)        ; weak hash table
Note: See TracChangeset for help on using the changeset viewer.