X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-hash-table.lisp;h=cb9c502eb24c43219975aa99376a06e57b75dc2b;hb=42b8c7570a2faa21529fadeef84a0caea186aa8c;hp=4db23f4ee384905fa762ca417ab38e8db85770a8;hpb=3924eb24605ed3ff0951155d271a7fea15656e7d;p=sbcl.git diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 4db23f4..cb9c502 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -140,7 +140,18 @@ ;; boxing. (rehash-threshold (float rehash-threshold 1.0)) (size+1 (1+ size)) ; The first element is not usable. - (scaled-size (round (/ (float size+1) rehash-threshold))) + ;; KLUDGE: The most natural way of expressing the below is + ;; (round (/ (float size+1) rehash-threshold)), and indeed + ;; it was expressed like that until 0.7.0. However, + ;; MAKE-HASH-TABLE is called very early in cold-init, and + ;; the SPARC has no primitive instructions for rounding, + ;; but only for truncating; therefore, we fudge this issue + ;; a little. The other uses of truncate, below, similarly + ;; used to be round. -- CSR, 2002-10-01 + ;; + ;; Note that this has not yet been audited for + ;; correctness. It just seems to work. -- CSR, 2002-11-02 + (scaled-size (truncate (/ (float size+1) rehash-threshold))) (length (almost-primify (max scaled-size (1+ +min-hash-table-size+)))) (index-vector (make-array length @@ -165,6 +176,14 @@ :hash-vector (unless (eq test 'eq) (make-array size+1 :element-type '(unsigned-byte 32) + ;; 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 :initial-element #x80000000))))) (declare (type index size+1 scaled-size length)) ;; Set up the free list, all free. These lists are 0 terminated. @@ -179,7 +198,7 @@ (defun hash-table-count (hash-table) #!+sb-doc - "Returns the number of entries in the given HASH-TABLE." + "Return the number of entries in the given HASH-TABLE." (declare (type hash-table hash-table) (values index)) (hash-table-number-entries hash-table)) @@ -224,7 +243,7 @@ (fixnum (+ rehash-size old-size)) (float - (the index (round (* rehash-size old-size))))))) + (the index (truncate (* rehash-size old-size))))))) (new-kv-vector (make-array (* 2 new-size) :initial-element +empty-ht-slot+)) (new-next-vector (make-array new-size @@ -236,7 +255,7 @@ :initial-element #x80000000))) (old-index-vector (hash-table-index-vector table)) (new-length (almost-primify - (round (/ (float new-size) + (truncate (/ (float new-size) (hash-table-rehash-threshold table))))) (new-index-vector (make-array new-length :element-type '(unsigned-byte 32) @@ -504,8 +523,8 @@ (defun remhash (key hash-table) #!+sb-doc - "Remove the entry in HASH-TABLE associated with KEY. Returns T if there - was such an entry, and NIL if not." + "Remove the entry in HASH-TABLE associated with KEY. Return T if there + was such an entry, or NIL if not." (declare (type hash-table hash-table) (values (member t nil))) (without-gcing @@ -642,15 +661,13 @@ ;;; not only parts of the system which are defined after DEFUN MAPHASH. ;;; 2. It could be conditional on compilation policy, so that ;;; it could be compiled as a full call instead of an inline -;;; expansion when SPACE>SPEED. (Not only would this save space, -;;; it might actually be faster when a call is made from byte-compiled -;;; code.) +;;; expansion when SPACE>SPEED. (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." - (let ((fun (%coerce-callable-to-function function-designator)) + (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))) @@ -667,7 +684,7 @@ ;;; Return a list of keyword args and values to use for MAKE-HASH-TABLE ;;; when reconstructing HASH-TABLE. -(defun hash-table-ctor-args (hash-table) +(defun %hash-table-ctor-args (hash-table) (when (hash-table-weak-p hash-table) ;; FIXME: This might actually work with no trouble, but as of ;; sbcl-0.6.12.10 when this code was written, weak hash tables @@ -680,7 +697,7 @@ :rehash-threshold ',(hash-table-rehash-threshold hash-table))) ;;; Return an association list representing the same data as HASH-TABLE. -(defun hash-table-alist (hash-table) +(defun %hash-table-alist (hash-table) (let ((result nil)) (maphash (lambda (key value) (push (cons key value) result)) @@ -691,7 +708,7 @@ ;;; so that we can use this for the *PRINT-READABLY* case in ;;; PRINT-OBJECT (HASH-TABLE T) without having to worry about LET ;;; forms and readable gensyms and stuff. -(defun stuff-hash-table (hash-table alist) +(defun %stuff-hash-table (hash-table alist) (dolist (x alist) (setf (gethash (car x) hash-table) (cdr x))) hash-table) @@ -710,11 +727,11 @@ (with-standard-io-syntax (format stream "#.~W" - `(stuff-hash-table (make-hash-table ,@(hash-table-ctor-args - hash-table)) - ',(hash-table-alist hash-table))))))) + `(%stuff-hash-table (make-hash-table ,@(%hash-table-ctor-args + hash-table)) + ',(%hash-table-alist hash-table))))))) (def!method make-load-form ((hash-table hash-table) &optional environment) (declare (ignore environment)) - (values `(make-hash-table ,@(hash-table-ctor-args hash-table)) - `(stuff-hash-table ,hash-table ',(hash-table-alist hash-table)))) + (values `(make-hash-table ,@(%hash-table-ctor-args hash-table)) + `(%stuff-hash-table ,hash-table ',(%hash-table-alist hash-table))))