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.

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 2c6263a..c9cdbf7 100644 (file)
--- 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 (file)
--- a/src/code/hash-table.lisp
+++ b/src/code/hash-table.lisp
@@ -87,18 +87,21 @@
 \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))
-              (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 (file)
--- 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 (file)
--- 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"