X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhash-table.lisp;h=c7afa7ecf2deef1c3a10d2967311e1961a55a64b;hb=82cd148d729c241e79c8df04b700beec1b7c55de;hp=8a79e0ea84ae5065b80fd79f1e1bf6d10eaff9f5;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index 8a79e0e..c7afa7e 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -24,12 +24,12 @@ ;; values: the index hashing and T if that might change with the ;; next GC. (hash-fun (missing-arg) :type function :read-only t) - ;; how much to grow the hash table by when it fills up. If an index, + ;; How much to grow the hash table by when it fills up. If an index, ;; then add that amount. If a floating point number, then multiply ;; it by that. (rehash-size (missing-arg) :type (or index (single-float (1.0))) - :read-only t) - ;; how full the hash table has to get before we rehash + :read-only t) + ;; How full the hash table has to get before we rehash (rehash-threshold (missing-arg) :type (single-float (0.0) 1.0) :read-only t) ;; The number of entries before a rehash, just one less than the ;; size of the next-vector, hash-vector, and half the size of the @@ -39,62 +39,115 @@ (number-entries 0 :type index) ;; The Key-Value pair vector. (table (missing-arg) :type simple-vector) - ;; True if this is a weak hash table, meaning that key->value - ;; mappings will disappear if there are no other references to the - ;; key. Note: this only matters if the hash function indicates that - ;; the hashing is EQ based. - (weak-p nil :type (member t nil)) - ;; Index into the next-vector, chaining together buckets that need - ;; to be rehashed because their hashing is EQ based and the key has - ;; been moved by the garbage collector. - (needing-rehash 0 :type index) + ;; This slot is used to link weak hash tables during GC. When the GC + ;; isn't running it is always NIL. + (next-weak-hash-table nil :type null) + ;; Non-NIL if this is some kind of weak hash table. For details see + ;; the docstring of MAKE-HASH-TABLE. + (weakness nil :type (member nil :key :value :key-or-value :key-and-value) + :read-only t) ;; Index into the Next vector chaining together free slots in the KV ;; vector. (next-free-kv 0 :type index) + ;; A cache that is either nil or is an index into the hash table + ;; that should be checked first + (cache nil :type (or null index)) ;; The index vector. This may be larger than the hash size to help ;; reduce collisions. - (index-vector (missing-arg) - :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*))) + (index-vector (missing-arg) :type (simple-array sb!vm:word (*))) ;; This table parallels the KV vector, and is used to chain together - ;; the hash buckets, the free list, and the values needing rehash, a - ;; slot will only ever be in one of these lists. - (next-vector (missing-arg) - :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*))) + ;; the hash buckets and the free list. A slot will only ever be in + ;; one of these lists. + (next-vector (missing-arg) :type (simple-array sb!vm:word (*))) ;; This table parallels the KV table, and can be used to store the ;; hash associated with the key, saving recalculation. Could be ;; useful for EQL, and EQUAL hash tables. This table is not needed - ;; for EQ hash tables, and when present the value of #x80000000 - ;; represents EQ-based hashing on the respective key. - (hash-vector nil :type (or null (simple-array (unsigned-byte - #.sb!vm:n-word-bits) (*))))) - -(defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body) + ;; for EQ hash tables, and when present the value of + ;; +MAGIC-HASH-VECTOR-VALUE+ represents EQ-based hashing on the + ;; respective key. + (hash-vector nil :type (or null (simple-array sb!vm:word (*)))) + ;; Used for locking GETHASH/(SETF GETHASH)/REMHASH + (lock (sb!thread:make-mutex :name "hash-table lock") + :type sb!thread:mutex :read-only t) + ;; The GC will set this to T if it moves an EQ-based key. This used + ;; to be signaled by a bit in the header of the kv vector, but that + ;; implementation caused some concurrency issues when we stopped + ;; inhibiting GC during hash-table lookup. + (needs-rehash-p nil :type (member nil t)) + ;; Has user requested synchronization? + (synchronized-p nil :type (member nil t) :read-only t) + ;; For detecting concurrent accesses. + #!+sb-hash-table-debug + (signal-concurrent-access t :type (member nil t)) + #!+sb-hash-table-debug + (reading-thread nil) + #!+sb-hash-table-debug + (writing-thread nil)) + +;; as explained by pmai on openprojects #lisp IRC 2002-07-30: #x80000000 +;; is bigger than any possible nonEQ hash value, and thus indicates an +;; empty slot; and EQ hash tables don't use HASH-TABLE-HASH-VECTOR. +;; The previous sentence was written when SBCL was 32-bit only. The value +;; now depends on the word size. It is propagated to C in genesis because +;; the generational garbage collector needs to know it. +(defconstant +magic-hash-vector-value+ (ash 1 (1- sb!vm:n-word-bits))) + +(defmacro-mundanely with-hash-table-iterator ((name hash-table) &body body) #!+sb-doc - "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body) - provides a method of manually looping over the elements of a hash-table. - FUNCTION is bound to a generator-macro that, within the scope of the - invocation, returns one or three values. The first value tells whether - any objects remain in the hash table. When the first value is non-NIL, - the second and third values are the key and the value of the next object." - (let ((n-function (gensym "WITH-HASH-TABLE-ITERATOR-"))) - `(let ((,n-function - (let* ((table ,hash-table) - (length (length (hash-table-next-vector table))) - (index 1)) - (declare (type (mod #.(floor most-positive-fixnum 2)) index)) - (labels - ((,function () - ;; (We grab the table again on each iteration just in - ;; case it was rehashed by a PUTHASH.) - (let ((kv-vector (hash-table-table table))) - (do () - ((>= index length) (values nil)) - (let ((key (aref kv-vector (* 2 index))) - (value (aref kv-vector (1+ (* 2 index))))) - (incf index) - (unless (and (eq key +empty-ht-slot+) - (eq value +empty-ht-slot+)) - (return (values t key value)))))))) - #',function)))) - (macrolet ((,function () '(funcall ,n-function))) - ,@body)))) + "WITH-HASH-TABLE-ITERATOR ((name hash-table) &body body) + +Provides a method of manually looping over the elements of a hash-table. NAME +is bound to a generator-macro that, within the scope of the invocation, +returns one or three values. The first value tells whether any objects remain +in the hash table. When the first value is non-NIL, the second and third +values are the key and the value of the next object. + +Consequences are undefined if HASH-TABLE is mutated during execution of BODY, +except for changing or removing elements corresponding to the current key. The +applies to all threads, not just the current one -- even for synchronized +hash-tables. If the table may be mutated by another thread during iteration, +use eg. SB-EXT:WITH-LOCKED-HASH-TABLE to protect the WITH-HASH-TABLE-ITERATOR +for." + ;; This essentially duplicates MAPHASH, so any changes here should + ;; be reflected there as well. + (let ((function (make-symbol (concatenate 'string (symbol-name name) "-FUN")))) + `(let ((,function + (let* ((table ,hash-table) + (length (length (hash-table-next-vector table))) + (index 1)) + (declare (type index/2 index)) + (labels + ((,name () + ;; (We grab the table again on each iteration just in + ;; case it was rehashed by a PUTHASH.) + (let ((kv-vector (hash-table-table table))) + (do () + ((>= index length) (values nil)) + (let ((key (aref kv-vector (* 2 index))) + (value (aref kv-vector (1+ (* 2 index))))) + (incf index) + (unless (or (eq key +empty-ht-slot+) + (eq value +empty-ht-slot+)) + (return (values t key value)))))))) + #',name)))) + (macrolet ((,name () '(funcall ,function))) + ,@body)))) + +(defmacro-mundanely with-locked-hash-table ((hash-table) &body body) + #!+sb-doc + "Limits concurrent accesses to HASH-TABLE for the duration of BODY. +If HASH-TABLE is synchronized, BODY will execute with exclusive +ownership of the table. If HASH-TABLE is not synchronized, BODY will +execute with other WITH-LOCKED-HASH-TABLE bodies excluded -- exclusion +of hash-table accesses not surrounded by WITH-LOCKED-HASH-TABLE is +unspecified." + ;; Needless to say, this also excludes some internal bits, but + ;; getting there is too much detail when "unspecified" says what + ;; is important -- unpredictable, but harmless. + `(sb!thread::with-recursive-lock ((hash-table-lock ,hash-table)) + ,@body)) + +(defmacro-mundanely with-locked-system-table ((hash-table) &body body) + `(sb!thread::with-recursive-system-lock + ((hash-table-lock ,hash-table)) + ,@body))