1.0.6.30: clean up FD-SOUT a little bit
[sbcl.git] / 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 buckets that need
50   ;; to be rehashed because their hashing is EQ based and the key has
51   ;; been moved by the garbage collector.
52   (needing-rehash 0 :type index)
53   ;; Index into the Next vector chaining together free slots in the KV
54   ;; vector.
55   (next-free-kv 0 :type index)
56   ;; A cache that is either nil or is an index into the hash table
57   ;; that should be checked first
58   (cache nil :type (or null index))
59   ;; The index vector. This may be larger than the hash size to help
60   ;; reduce collisions.
61   (index-vector (missing-arg)
62                 :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*)))
63   ;; This table parallels the KV vector, and is used to chain together
64   ;; the hash buckets, the free list, and the values needing rehash, a
65   ;; slot will only ever be in one of these lists.
66   (next-vector (missing-arg)
67                :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*)))
68   ;; This table parallels the KV table, and can be used to store the
69   ;; hash associated with the key, saving recalculation. Could be
70   ;; useful for EQL, and EQUAL hash tables. This table is not needed
71   ;; for EQ hash tables, and when present the value of
72   ;; +MAGIC-HASH-VECTOR-VALUE+ represents EQ-based hashing on the
73   ;; respective key.
74   (hash-vector nil :type (or null (simple-array (unsigned-byte
75                                                  #.sb!vm:n-word-bits) (*))))
76   ;; This lock is acquired by %PUTHASH, REMHASH, CLRHASH and GETHASH.
77   (spinlock (sb!thread::make-spinlock)))
78
79 ;; as explained by pmai on openprojects #lisp IRC 2002-07-30: #x80000000
80 ;; is bigger than any possible nonEQ hash value, and thus indicates an
81 ;; empty slot; and EQ hash tables don't use HASH-TABLE-HASH-VECTOR.
82 ;; The previous sentence was written when SBCL was 32-bit only. The value
83 ;; now depends on the word size. It is propagated to C in genesis because
84 ;; the generational garbage collector needs to know it.
85 (defconstant +magic-hash-vector-value+ (ash 1 (1- sb!vm:n-word-bits)))
86
87 \f
88 (defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body)
89   #!+sb-doc
90   "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
91
92 Provides a method of manually looping over the elements of a hash-table.
93 FUNCTION is bound to a generator-macro that, within the scope of the
94 invocation, returns one or three values. The first value tells whether any
95 objects remain in the hash table. When the first value is non-NIL, the second
96 and third values are the key and the value of the next object."
97   ;; This essentially duplicates MAPHASH, so any changes here should
98   ;; be reflected there as well.
99   (let ((n-function (gensym "WITH-HASH-TABLE-ITERATOR-")))
100     `(let ((,n-function
101             (let* ((table ,hash-table)
102                    (length (length (hash-table-next-vector table)))
103                    (index 1))
104               (declare (type index/2 index))
105               (labels
106                   ((,function ()
107                      ;; (We grab the table again on each iteration just in
108                      ;; case it was rehashed by a PUTHASH.)
109                      (let ((kv-vector (hash-table-table table)))
110                        (do ()
111                            ((>= index length) (values nil))
112                          (let ((key (aref kv-vector (* 2 index)))
113                                (value (aref kv-vector (1+ (* 2 index)))))
114                            (incf index)
115                            (unless (and (eq key +empty-ht-slot+)
116                                         (eq value +empty-ht-slot+))
117                              (return (values t key value))))))))
118                 #',function))))
119       (macrolet ((,function () '(funcall ,n-function)))
120         ,@body))))