From 30d61cc04481c081fd97c42561475bfe11209b59 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Wed, 4 Feb 2009 14:10:22 +0000 Subject: [PATCH] 1.0.25.8: fix sxhash bug ... brought to light by 1.0.20.27. Declare hashes to be of type HASH (not INDEX). Note that INDEX still is used to mean different things: - a valid index: (integer 0 (array-dimension-limit)) - a "bound" such as the :START arguments: (integer 0 array-dimension-limit) - a "dimension" as in (make-array 10): (integer 0 array-dimension-limit) which leads to all kinds of nastiness with array near the limit. --- package-data-list.lisp-expr | 1 + src/code/early-extensions.lisp | 6 ++++++ src/code/target-package.lisp | 12 +++++++----- src/code/target-sxhash.lisp | 12 ++---------- src/compiler/fndb.lisp | 6 ++---- src/compiler/generic/vm-fndb.lisp | 8 ++++---- version.lisp-expr | 2 +- 7 files changed, 23 insertions(+), 24 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 80e79f3..b23613e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -994,6 +994,7 @@ possibly temporariliy, because it might be used internally." "STRUCTURE-INITARG-NOT-KEYWORD" "CONSTANT-MODIFIED" ;; ..and DEFTYPEs.. + "MAX-HASH" "HASH" "INDEX" "LOAD/STORE-INDEX" "SIGNED-BYTE-WITH-A-BITE-OUT" "UNSIGNED-BYTE-WITH-A-BITE-OUT" diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 341c69b..0612180 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -16,6 +16,12 @@ ;;; something not EQ to anything we might legitimately READ (defparameter *eof-object* (make-symbol "EOF-OBJECT")) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant max-hash sb!xc:most-positive-fixnum)) + +(def!type hash () + `(integer 0 ,max-hash)) + ;;; a type used for indexing into arrays, and for related quantities ;;; like lengths of lists ;;; diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 9c10525..4fa7582 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -469,10 +469,10 @@ error if any of PACKAGES is not a valid package designator." `(let* ((,vec (package-hashtable-table ,table)) (,hash (package-hashtable-hash ,table)) (,len (length ,vec)) - (,h2 (1+ (the index (rem (the index ,sxhash) + (,h2 (1+ (the index (rem (the hash ,sxhash) (the index (- ,len 2))))))) (declare (type index ,len ,h2)) - (prog ((,index-var (rem (the index ,sxhash) ,len)) + (prog ((,index-var (rem (the hash ,sxhash) ,len)) ,symbol-var ,ehash) (declare (type (or index null) ,index-var)) LOOP @@ -503,7 +503,8 @@ error if any of PACKAGES is not a valid package designator." (let* ((length (length string)) (hash (%sxhash-simple-string string)) (ehash (entry-hash length hash))) - (declare (type index length hash)) + (declare (type index length) + (type hash hash)) (with-symbol (index symbol table string length hash ehash) (setf (aref (package-hashtable-hash table) index) 1) (setf (aref (package-hashtable-table table) index) nil) @@ -763,7 +764,7 @@ implementation it is ~S." *default-package-use-list*) (type index length)) (let* ((hash (%sxhash-simple-substring string length)) (ehash (entry-hash length hash))) - (declare (type index hash ehash)) + (declare (type hash hash ehash)) (with-symbol (found symbol (package-internal-symbols package) string length hash ehash) (when found @@ -802,7 +803,8 @@ implementation it is ~S." *default-package-use-list*) (let* ((length (length string)) (hash (%sxhash-simple-string string)) (ehash (entry-hash length hash))) - (declare (type index length hash)) + (declare (type index length) + (type hash hash)) (with-symbol (found symbol (package-external-symbols package) string length hash ehash) (values symbol found)))) diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index fe8fc8a..28bbf84 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -11,12 +11,6 @@ (in-package "SB!IMPL") -(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant max-hash sb!xc:most-positive-fixnum)) - -(deftype hash () - `(integer 0 ,max-hash)) - (defun pointer-hash (key) (pointer-hash key)) @@ -148,10 +142,8 @@ ;;;; the SXHASH function ;; simple cases -(declaim (ftype (sfunction (integer) (integer 0 #.sb!xc:most-positive-fixnum)) - sxhash-bignum)) -(declaim (ftype (sfunction (t) (integer 0 #.sb!xc:most-positive-fixnum)) - sxhash-instance)) +(declaim (ftype (sfunction (integer) hash) sxhash-bignum)) +(declaim (ftype (sfunction (t) hash) sxhash-instance)) (defun sxhash (x) ;; profiling SXHASH is hard, but we might as well try to make it go diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 4f04dd3..e666a3d 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -813,10 +813,8 @@ (foldable flushable)) (defknown hash-table-size (hash-table) index (flushable)) (defknown hash-table-test (hash-table) symbol (foldable flushable)) -(defknown sxhash (t) (integer 0 #.sb!xc:most-positive-fixnum) - (#-sb-xc-host foldable flushable)) -(defknown psxhash (t &optional t) (integer 0 #.sb!xc:most-positive-fixnum) - (#-sb-xc-host foldable flushable)) +(defknown sxhash (t) hash (#-sb-xc-host foldable flushable)) +(defknown psxhash (t &optional t) hash (#-sb-xc-host foldable flushable)) ;;;; from the "Arrays" chapter diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 2c88571..9a788f9 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -76,16 +76,16 @@ (or index null) (foldable flushable)) -(defknown %sxhash-simple-string (simple-string) index +(defknown %sxhash-simple-string (simple-string) hash (foldable flushable)) -(defknown %sxhash-simple-substring (simple-string index) index +(defknown %sxhash-simple-substring (simple-string index) hash (foldable flushable)) -(defknown symbol-hash (symbol) (integer 0 #.sb!xc:most-positive-fixnum) +(defknown symbol-hash (symbol) hash (flushable movable)) -(defknown %set-symbol-hash (symbol (integer 0 #.sb!xc:most-positive-fixnum)) +(defknown %set-symbol-hash (symbol hash) t (unsafe)) (defknown vector-length (vector) index (flushable)) diff --git a/version.lisp-expr b/version.lisp-expr index c35cd1c..01d5805 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.25.7" +"1.0.25.8" -- 1.7.10.4