X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhash-table.lisp;h=22740e516dbd8b69d4e2d82f29b8a9aec372b625;hb=119d1c157e519573074720b7897a9fa918329ac5;hp=76a29780f333656097fabbd8b6dffc84904c5b90;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index 76a2978..22740e5 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -12,65 +12,40 @@ (in-package "SB!IMPL") -;;; an internal tag for marking empty slots -;;; -;;; CMU CL 18b used :EMPTY for this purpose, which was somewhat nasty -;;; since it's easily accessible to the user, so that e.g. -;;; (DEFVAR *HT* (MAKE-HASH-TABLE)) -;;; (SETF (GETHASH :EMPTY *HT*) :EMPTY) -;;; (MAPHASH (LAMBDA (K V) (FORMAT T "~&~S ~S~%" K V))) -;;; gives no output -- oops! -;;; -;;; Note that as of version 0.6.6 there's a dependence in the gencgc.c -;;; code on this value being a symbol. (This is only one of many nasty -;;; dependencies between that code and this, alas.) -(defconstant +empty-ht-slot+ '%empty-ht-slot%) -;;; KLUDGE: Using a private symbol still leaves us vulnerable to users -;;; getting nonconforming behavior by messing around with -;;; DO-ALL-SYMBOLS. That seems like a fairly obscure problem, so for -;;; now we just don't worry about it. If for some reason it becomes -;;; worrisome and the magic value needs replacement: -;;; * The replacement value needs to be LOADable with EQL preserved, -;;; so that macroexpansion for WITH-HASH-TABLE-ITERATOR will work -;;; when compiled into a file and loaded back into SBCL. -;;; (Thus, just uninterning %EMPTY-HT-SLOT% doesn't work.) -;;; * The replacement value needs to be acceptable to the -;;; low-level gencgc.lisp hash table scavenging code. -;;; * The change will break binary compatibility, since comparisons -;;; against the value used at the time of compilation are wired -;;; into FASL files. -;;; -- WHN 20000622 - ;;; HASH-TABLE is implemented as a STRUCTURE-OBJECT. (sb!xc:defstruct (hash-table (:constructor %make-hash-table)) - ;; The type of hash table this is. Only used for printing and as part of - ;; the exported interface. - (test (required-argument) :type symbol :read-only t) - ;; The function used to compare two keys. Returns T if they are the same - ;; and NIL if not. - (test-fun (required-argument) :type function :read-only t) - ;; The function used to compute the hashing of a key. Returns two values: - ;; the index hashing and T if that might change with the next GC. - (hash-fun (required-argument) :type function :read-only t) - ;; 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 multiple it by that. - (rehash-size (required-argument) :type (or index (single-float (1.0))) - :read-only t) - ;; How full the hash table has to get before we rehash. - (rehash-threshold (required-argument) :type (single-float (0.0) 1.0) - :read-only t) - ;; The number of entries before a rehash, just the one less than the + ;; The type of hash table this is. Only used for printing and as + ;; part of the exported interface. + (test (missing-arg) :type symbol :read-only t) + ;; The function used to compare two keys. Returns T if they are the + ;; same and NIL if not. + (test-fun (missing-arg) :type function :read-only t) + ;; The function used to compute the hashing of a key. Returns two + ;; 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, + ;; 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 + (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 ;; kv-vector. - (rehash-trigger (required-argument) :type index) + (rehash-trigger (missing-arg) :type index) ;; The current number of entries in the table. (number-entries 0 :type index) ;; The Key-Value pair vector. - (table (required-argument) :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)) + (table (missing-arg) :type simple-vector) + ;; 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 buckets that need ;; to be rehashed because their hashing is EQ based and the key has ;; been moved by the garbage collector. @@ -78,48 +53,68 @@ ;; 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 (required-argument) - :type (simple-array (unsigned-byte 32) (*))) + (index-vector (missing-arg) + :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*))) ;; 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 (required-argument) :type (simple-array (unsigned-byte 32) (*))) + (next-vector (missing-arg) + :type (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*))) ;; 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 #x8000000 - ;; represents EQ-based hashing on the respective Key. - (hash-vector nil :type (or null (simple-array (unsigned-byte 32) (*))))) + ;; 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 (unsigned-byte + #.sb!vm:n-word-bits) (*)))) + ;; This lock is acquired by %PUTHASH, REMHASH, CLRHASH and GETHASH. + (spinlock (sb!thread::make-spinlock))) + +;; 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 ((function 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." + +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." + ;; This essentially duplicates MAPHASH, so any changes here should + ;; be reflected there as well. (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)))) + (let* ((table ,hash-table) + (length (length (hash-table-next-vector table))) + (index 1)) + (declare (type index/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)))) + ,@body))))