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