src/code/hash-table.lisp

   1 ;;;; the needed-on-the-cross-compilation-host part of HASH-TABLE
   2 ;;;; implementation
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!IMPL")
  14
  15 ;;; HASH-TABLE is implemented as a STRUCTURE-OBJECT.
  16 (sb!xc:defstruct (hash-table (:constructor %make-hash-table))
  17   ;; The type of hash table this is. Only used for printing and as
  18   ;; part of the exported interface.
  19   (test (missing-arg) :type symbol :read-only t)
  20   ;; The function used to compare two keys. Returns T if they are the
  21   ;; same and NIL if not.
  22   (test-fun (missing-arg) :type function :read-only t)
  23   ;; The function used to compute the hashing of a key. Returns two
  24   ;; values: the index hashing and T if that might change with the
  25   ;; next GC.
  26   (hash-fun (missing-arg) :type function :read-only t)
  27   ;; how much to grow the hash table by when it fills up. If an index,
  28   ;; then add that amount. If a floating point number, then multiply
  29   ;; it by that.
  30   (rehash-size (missing-arg) :type (or index (single-float (1.0)))
  31                :read-only t)
  32   ;; how full the hash table has to get before we rehash
  33   (rehash-threshold (missing-arg) :type (single-float (0.0) 1.0) :read-only t)
  34   ;; The number of entries before a rehash, just one less than the
  35   ;; size of the next-vector, hash-vector, and half the size of the
  36   ;; kv-vector.
  37   (rehash-trigger (missing-arg) :type index)
  38   ;; The current number of entries in the table.
  39   (number-entries 0 :type index)
  40   ;; The Key-Value pair vector.
  41   (table (missing-arg) :type simple-vector)
  42   ;; This slot is used to link weak hash tables during GC. When the GC
  43   ;; isn't running it is always NIL.
  44   (next-weak-hash-table nil :type null)
  45   ;; Non-NIL if this is some kind of weak hash table. For details see
  46   ;; the docstring of MAKE-HASH-TABLE.
  47   (weakness nil :type (member nil :key :value :key-or-value :key-and-value)
  48             :read-only t)
  49   ;; Index into the Next vector chaining together free slots in the KV
  50   ;; vector.
  51   (next-free-kv 0 :type index)
  52   ;; A cache that is either nil or is an index into the hash table
  53   ;; that should be checked first
  54   (cache nil :type (or null index))
  55   ;; The index vector. This may be larger than the hash size to help
  56   ;; reduce collisions.
  57   (index-vector (missing-arg)
  58                 :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*)))
  59   ;; This table parallels the KV vector, and is used to chain together
  60   ;; the hash buckets and the free list. A slot will only ever be in
  61   ;; one of these lists.
  62   (next-vector (missing-arg)
  63                :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*)))
  64   ;; This table parallels the KV table, and can be used to store the
  65   ;; hash associated with the key, saving recalculation. Could be
  66   ;; useful for EQL, and EQUAL hash tables. This table is not needed
  67   ;; for EQ hash tables, and when present the value of
  68   ;; +MAGIC-HASH-VECTOR-VALUE+ represents EQ-based hashing on the
  69   ;; respective key.
  70   (hash-vector nil :type (or null (simple-array (unsigned-byte
  71                                                  #.sb!vm:n-word-bits) (*))))
  72   ;; Used for locking GETHASH/(SETF GETHASH)/REMHASH
  73   (spinlock (sb!thread::make-spinlock :name "hash-table lock")
  74             :type sb!thread::spinlock :read-only t)
  75   ;; The GC will set this to T if it moves an EQ-based key. This used
  76   ;; to be signaled by a bit in the header of the kv vector, but that
  77   ;; implementation caused some concurrency issues when we stopped
  78   ;; inhibiting GC during hash-table lookup.
  79   (needs-rehash-p nil :type (member nil t))
  80   ;; Has user requested synchronization?
  81   (synchronized-p nil :type (member nil t) :read-only t)
  82   ;; For detecting concurrent accesses.
  83   #!+sb-hash-table-debug
  84   (concurrent-access-error t :type (member nil t))
  85   #!+sb-hash-table-debug
  86   (accessing-thread nil))
  87
  88 ;; as explained by pmai on openprojects #lisp IRC 2002-07-30: #x80000000
  89 ;; is bigger than any possible nonEQ hash value, and thus indicates an
  90 ;; empty slot; and EQ hash tables don't use HASH-TABLE-HASH-VECTOR.
  91 ;; The previous sentence was written when SBCL was 32-bit only. The value
  92 ;; now depends on the word size. It is propagated to C in genesis because
  93 ;; the generational garbage collector needs to know it.
  94 (defconstant +magic-hash-vector-value+ (ash 1 (1- sb!vm:n-word-bits)))
  95
  96 (defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body)
  97   #!+sb-doc
  98   "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
  99
 100 Provides a method of manually looping over the elements of a hash-table.
 101 FUNCTION is bound to a generator-macro that, within the scope of the
 102 invocation, returns one or three values. The first value tells whether any
 103 objects remain in the hash table. When the first value is non-NIL, the second
 104 and third values are the key and the value of the next object.
 105
 106 Consequences are undefined if HASH-TABLE is mutated during execution
 107 of BODY, except for changing or removing elements corresponding to the
 108 current key. The applies to all threads, not just the curren one --
 109 even for synchronized hash-tables. If the table may be mutated by
 110 another thread during iteration, use eg. SB-EXT:WITH-LOCKED-HASH-TABLE
 111 to protect the WITH-HASH-TABLE-ITERATOR for."
 112   ;; This essentially duplicates MAPHASH, so any changes here should
 113   ;; be reflected there as well.
 114   (let ((n-function (gensym "WITH-HASH-TABLE-ITERATOR-")))
 115     `(let ((,n-function
 116             (let* ((table ,hash-table)
 117                    (length (length (hash-table-next-vector table)))
 118                    (index 1))
 119               (declare (type index/2 index))
 120               (labels
 121                   ((,function ()
 122                      ;; (We grab the table again on each iteration just in
 123                      ;; case it was rehashed by a PUTHASH.)
 124                      (let ((kv-vector (hash-table-table table)))
 125                        (do ()
 126                            ((>= index length) (values nil))
 127                          (let ((key (aref kv-vector (* 2 index)))
 128                                (value (aref kv-vector (1+ (* 2 index)))))
 129                            (incf index)
 130                            (unless (or (eq key +empty-ht-slot+)
 131                                         (eq value +empty-ht-slot+))
 132                              (return (values t key value))))))))
 133                 #',function))))
 134       (macrolet ((,function () '(funcall ,n-function)))
 135         ,@body))))
 136
 137 (defmacro-mundanely with-locked-hash-table ((hash-table) &body body)
 138   #!+sb-doc
 139   "Limits concurrent accesses to HASH-TABLE for the duration of BODY.
 140 If HASH-TABLE is synchronized, BODY will execute with exclusive
 141 ownership of the table. If HASH-TABLE is not synchronized, BODY will
 142 execute with other WITH-LOCKED-HASH-TABLE bodies excluded -- exclusion
 143 of hash-table accesses not surrounded by WITH-LOCKED-HASH-TABLE is
 144 unspecified."
 145   ;; Needless to say, this also excludes some internal bits, but
 146   ;; getting there is too much detail when "unspecified" says what
 147   ;; is important -- unpredictable, but harmless.
 148   `(sb!thread::with-recursive-spinlock ((hash-table-spinlock ,hash-table))
 149      ,@body))