;; 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
: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.
(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))
(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
: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)
(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
;;; 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)))
;;; 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
: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))
;;; 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)
(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))))
projects / sbcl.git / blobdiff