* Hash table code does lots of AREFs using indexes (* 2 i) and (1+ (* 2 i)),
where I obviously has to be less then (floor array-dimension-limit 2),
for which both calculations are known to fit into a fixnum.
* Define such a type (aka INDEX/2) and use it where appropriate. We
were already doing this in WITH-HASH-TABLE-ITERATOR, but not
elsewhere.
;;; bound because ANSI specifies it as an exclusive bound.)
(def!type index () `(integer 0 (,sb!xc:array-dimension-limit)))
;;; bound because ANSI specifies it as an exclusive bound.)
(def!type index () `(integer 0 (,sb!xc:array-dimension-limit)))
+;;; like INDEX, but only up to half the maximum. Used by hash-table
+;;; code that does plenty to (aref v (* 2 i)) and (aref v (1+ (* 2 i))).
+(def!type index/2 () `(integer 0 (,(floor sb!xc:array-dimension-limit 2))))
+
;;; like INDEX, but augmented with -1 (useful when using the index
;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with
;;; an implementation which terminates the loop by testing for the
;;; like INDEX, but augmented with -1 (useful when using the index
;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with
;;; an implementation which terminates the loop by testing for the
\f
(defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body)
#!+sb-doc
\f
(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."
+ "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."
+ ;; 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))
(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))
+ (declare (type index/2 index))
(labels
((,function ()
;; (We grab the table again on each iteration just in
(labels
((,function ()
;; (We grab the table again on each iteration just in
;; the chains are first to last.
(do ((i (1- new-size) (1- i)))
((zerop i))
;; the chains are first to last.
(do ((i (1- new-size) (1- i)))
((zerop i))
+ (declare (type index/2 i))
(let ((key (aref new-kv-vector (* 2 i)))
(value (aref new-kv-vector (1+ (* 2 i)))))
(cond ((and (eq key +empty-ht-slot+)
(let ((key (aref new-kv-vector (* 2 i)))
(value (aref new-kv-vector (1+ (* 2 i)))))
(cond ((and (eq key +empty-ht-slot+)
(setf (aref index-vector i) 0))
(do ((i (1- size) (1- i)))
((zerop i))
(setf (aref index-vector i) 0))
(do ((i (1- size) (1- i)))
((zerop i))
+ (declare (type index/2 i))
(let ((key (aref kv-vector (* 2 i)))
(value (aref kv-vector (1+ (* 2 i)))))
(cond ((and (eq key +empty-ht-slot+)
(let ((key (aref kv-vector (* 2 i)))
(value (aref kv-vector (1+ (* 2 i)))))
(cond ((and (eq key +empty-ht-slot+)
(length (length index-vector)))
(do ((next (hash-table-needing-rehash table)))
((zerop next))
(length (length index-vector)))
(do ((next (hash-table-needing-rehash table)))
((zerop next))
- (declare (type index next))
+ (declare (type index/2 next))
(let* ((key (aref kv-vector (* 2 next)))
(hashing (pointer-hash key))
(index (rem hashing length))
(let* ((key (aref kv-vector (* 2 next)))
(hashing (pointer-hash key))
(index (rem hashing length))
(if (or eq-based (not hash-vector))
(do ((next next (aref next-vector next)))
((zerop next) (values default nil))
(if (or eq-based (not hash-vector))
(do ((next next (aref next-vector next)))
((zerop next) (values default nil))
- (declare (type index next))
+ (declare (type index/2 next))
(when (eq key (aref table (* 2 next)))
(setf (hash-table-cache hash-table) (* 2 next))
(return (values (aref table (1+ (* 2 next))) t))))
(do ((next next (aref next-vector next)))
((zerop next) (values default nil))
(when (eq key (aref table (* 2 next)))
(setf (hash-table-cache hash-table) (* 2 next))
(return (values (aref table (1+ (* 2 next))) t))))
(do ((next next (aref next-vector next)))
((zerop next) (values default nil))
- (declare (type index next))
+ (declare (type index/2 next))
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key (aref table (* 2 next))))
;; Found.
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key (aref table (* 2 next))))
;; Found.
(next-vector (hash-table-next-vector hash-table))
(hash-vector (hash-table-hash-vector hash-table))
(test-fun (hash-table-test-fun hash-table)))
(next-vector (hash-table-next-vector hash-table))
(hash-vector (hash-table-hash-vector hash-table))
(test-fun (hash-table-test-fun hash-table)))
- (declare (type index index))
+ (declare (type index index next))
(when (hash-table-weakness hash-table)
(set-header-data kv-vector sb!vm:vector-valid-hashing-subtype))
(cond ((or eq-based (not hash-vector))
(when (hash-table-weakness hash-table)
(set-header-data kv-vector sb!vm:vector-valid-hashing-subtype))
(cond ((or eq-based (not hash-vector))
;; Search next-vector chain for a matching key.
(do ((next next (aref next-vector next)))
((zerop next))
;; Search next-vector chain for a matching key.
(do ((next next (aref next-vector next)))
((zerop next))
- (declare (type index next))
+ (declare (type index/2 next))
(when (eq key (aref kv-vector (* 2 next)))
;; Found, just replace the value.
(setf (hash-table-cache hash-table) (* 2 next))
(when (eq key (aref kv-vector (* 2 next)))
;; Found, just replace the value.
(setf (hash-table-cache hash-table) (* 2 next))
;; Search next-vector chain for a matching key.
(do ((next next (aref next-vector next)))
((zerop next))
;; Search next-vector chain for a matching key.
(do ((next next (aref next-vector next)))
((zerop next))
- (declare (type index next))
+ (declare (type index/2 next))
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key
(aref kv-vector (* 2 next))))
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key
(aref kv-vector (* 2 next))))
;; Pop a KV slot off the free list
(let ((free-kv-slot (hash-table-next-free-kv hash-table)))
;; Pop a KV slot off the free list
(let ((free-kv-slot (hash-table-next-free-kv hash-table)))
+ (declare (type index/2 free-kv-slot))
;; Double-check for overflow.
(aver (not (zerop free-kv-slot)))
(setf (hash-table-next-free-kv hash-table)
;; Double-check for overflow.
(aver (not (zerop free-kv-slot)))
(setf (hash-table-next-free-kv hash-table)
(next-vector (hash-table-next-vector hash-table))
(hash-vector (hash-table-hash-vector hash-table))
(test-fun (hash-table-test-fun hash-table)))
(next-vector (hash-table-next-vector hash-table))
(hash-vector (hash-table-hash-vector hash-table))
(test-fun (hash-table-test-fun hash-table)))
- (declare (type index index next))
+ (declare (type index index)
+ (type index/2 next))
(flet ((clear-slot (chain-vector prior-slot-location slot-location)
(flet ((clear-slot (chain-vector prior-slot-location slot-location)
+ (declare (type index/2 slot-location))
;; Mark slot as empty.
(setf (aref table (* 2 slot-location)) +empty-ht-slot+
(aref table (1+ (* 2 slot-location))) +empty-ht-slot+)
;; Mark slot as empty.
(setf (aref table (* 2 slot-location)) +empty-ht-slot+
(aref table (1+ (* 2 slot-location))) +empty-ht-slot+)
(do ((prior next next)
(next (aref next-vector next) (aref next-vector next)))
((zerop next) nil)
(do ((prior next next)
(next (aref next-vector next) (aref next-vector next)))
((zerop next) nil)
- (declare (type index next))
+ (declare (type index/2 next))
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key (aref table (* 2 next))))
(return-from remhash
(when (and (= hashing (aref hash-vector next))
(funcall test-fun key (aref table (* 2 next))))
(return-from remhash
(declaim (inline maphash))
(defun maphash (function-designator hash-table)
#!+sb-doc
(declaim (inline maphash))
(defun maphash (function-designator hash-table)
#!+sb-doc
- "For each entry in HASH-TABLE, call the designated two-argument function
- on the key and value of the entry. Return NIL."
+ "For each entry in HASH-TABLE, call the designated two-argument function on
+the key and value of the entry. Return NIL."
+ ;; This essentially duplicates WITH-HASH-TABLE-ITERATOR, so
+ ;; any changes here should be reflected there as well.
(let ((fun (%coerce-callable-to-fun function-designator))
(size (length (hash-table-next-vector hash-table))))
(declare (type function fun))
(do ((i 1 (1+ i)))
((>= i size))
(let ((fun (%coerce-callable-to-fun function-designator))
(size (length (hash-table-next-vector hash-table))))
(declare (type function fun))
(do ((i 1 (1+ i)))
((>= i size))
- (declare (type index i))
+ (declare (type index/2 i))
(let* ((kv-vector (hash-table-table hash-table))
(key (aref kv-vector (* 2 i)))
(value (aref kv-vector (1+ (* 2 i)))))
(let* ((kv-vector (hash-table-table hash-table))
(key (aref kv-vector (* 2 i)))
(value (aref kv-vector (1+ (* 2 i)))))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)