From 279283bc1724b60ef9ebbf31ab4837061989be18 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 31 Mar 2007 10:12:15 +0000 Subject: [PATCH] 1.0.4.11: trivial hash-table cleanup / optimization * 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. --- src/code/early-extensions.lisp | 4 ++++ src/code/hash-table.lisp | 17 ++++++++++------- src/code/target-hash-table.lisp | 29 ++++++++++++++++++----------- version.lisp-expr | 2 +- 4 files changed, 33 insertions(+), 19 deletions(-) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 2c6263a..c9cdbf7 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -30,6 +30,10 @@ ;;; 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 diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index 9f2a6b4..8ad97f3 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -87,18 +87,21 @@ (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)) - (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 diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 8947388..8865c5a 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -323,6 +323,7 @@ ;; 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+) @@ -395,6 +396,7 @@ (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+) @@ -433,7 +435,7 @@ (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)) @@ -495,13 +497,13 @@ (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)) - (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. @@ -549,7 +551,7 @@ (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)) @@ -560,7 +562,7 @@ ;; 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)) @@ -570,7 +572,7 @@ ;; 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)))) @@ -581,6 +583,7 @@ ;; 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) @@ -633,8 +636,10 @@ (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) + (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+) @@ -671,7 +676,7 @@ (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 @@ -721,14 +726,16 @@ (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)) - (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))))) diff --git a/version.lisp-expr b/version.lisp-expr index 1faf736..8b845f7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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".) -"1.0.4.10" +"1.0.4.11" -- 1.7.10.4