X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Ftarget-hash-table.lisp;h=9ee1e920605358c2107e76e5c987937e4fbc51cd;hb=fe7845b051cd4f7d32f1230d1f1bb2c14f557e48;hp=bdb5514ea50c2d8ebe5081ddfa2e19fa4f66d7b6;hpb=4cb16425e2ffce3f70ad6ca10f0cde4f1545fa9d;p=sbcl.git diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index bdb5514..9ee1e92 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -108,10 +108,6 @@ (t (eq-hash key)))) -(defun ceil-power-of-two (num) - (declare (type index num)) - (ash 1 (integer-length num))) - (declaim (inline index-for-hashing)) (defun index-for-hashing (hash length) (declare (type hash hash length)) @@ -234,8 +230,8 @@ ;; 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 (ceil-power-of-two (max scaled-size - (1+ +min-hash-table-size+)))) + (length (power-of-two-ceiling (max scaled-size + (1+ +min-hash-table-size+)))) (index-vector (make-array length :element-type '(unsigned-byte #.sb!vm:n-word-bits) @@ -326,7 +322,7 @@ multiple threads accessing the same hash-table without locking." (old-hash-vector (hash-table-hash-vector table)) (old-size (length old-next-vector)) (new-size - (ceil-power-of-two + (power-of-two-ceiling (let ((rehash-size (hash-table-rehash-size table))) (etypecase rehash-size (fixnum @@ -820,40 +816,41 @@ there was such an entry, or NIL if not." (declare (type hash-table hash-table) (values (member t nil))) (with-hash-table-locks (hash-table :inline (%remhash) :pin (key)) - ;; For now, just clear the cache - (setf (hash-table-cache hash-table) nil) + ;; For now, just clear the cache + (setf (hash-table-cache hash-table) nil) (%remhash key hash-table))) (defun clrhash (hash-table) #!+sb-doc "This removes all the entries from HASH-TABLE and returns the hash table itself." - (with-hash-table-locks (hash-table) - (let* ((kv-vector (hash-table-table hash-table)) - (next-vector (hash-table-next-vector hash-table)) - (hash-vector (hash-table-hash-vector hash-table)) - (size (length next-vector)) - (index-vector (hash-table-index-vector hash-table))) - ;; Disable GC tricks. - (set-header-data kv-vector sb!vm:vector-normal-subtype) - ;; Mark all slots as empty by setting all keys and values to magic - ;; tag. - (aver (eq (aref kv-vector 0) hash-table)) - (fill kv-vector +empty-ht-slot+ :start 2) - ;; Set up the free list, all free. - (do ((i 1 (1+ i))) - ((>= i (1- size))) - (setf (aref next-vector i) (1+ i))) - (setf (aref next-vector (1- size)) 0) - (setf (hash-table-next-free-kv hash-table) 1) - ;; Clear the index-vector. - (fill index-vector 0) - ;; Clear the hash-vector. - (when hash-vector - (fill hash-vector +magic-hash-vector-value+))) - (setf (hash-table-cache hash-table) nil) - (setf (hash-table-number-entries hash-table) 0) - hash-table)) + (when (plusp (hash-table-number-entries hash-table)) + (with-hash-table-locks (hash-table) + (let* ((kv-vector (hash-table-table hash-table)) + (next-vector (hash-table-next-vector hash-table)) + (hash-vector (hash-table-hash-vector hash-table)) + (size (length next-vector)) + (index-vector (hash-table-index-vector hash-table))) + ;; Disable GC tricks. + (set-header-data kv-vector sb!vm:vector-normal-subtype) + ;; Mark all slots as empty by setting all keys and values to magic + ;; tag. + (aver (eq (aref kv-vector 0) hash-table)) + (fill kv-vector +empty-ht-slot+ :start 2) + ;; Set up the free list, all free. + (do ((i 1 (1+ i))) + ((>= i (1- size))) + (setf (aref next-vector i) (1+ i))) + (setf (aref next-vector (1- size)) 0) + (setf (hash-table-next-free-kv hash-table) 1) + ;; Clear the index-vector. + (fill index-vector 0) + ;; Clear the hash-vector. + (when hash-vector + (fill hash-vector +magic-hash-vector-value+))) + (setf (hash-table-cache hash-table) nil) + (setf (hash-table-number-entries hash-table) 0))) + hash-table) ;;;; MAPHASH