X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-hash-table.lisp;h=090606a6509c19ef21c1b06c447380b6f5a9543f;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;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..090606a 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 @@ -524,22 +520,22 @@ multiple threads accessing the same hash-table without locking." &body body) (declare (type (member :read :write) operation)) (with-unique-names (body-fun) - `(with-concurrent-access-check ,hash-table ,operation - (flet ((,body-fun () + `(flet ((,body-fun () + (with-concurrent-access-check ,hash-table ,operation (locally (declare (inline ,@inline)) - ,@body))) - (if (hash-table-weakness ,hash-table) - (sb!thread::with-recursive-system-spinlock - ((hash-table-spinlock ,hash-table) :without-gcing t) - (,body-fun)) - (with-pinned-objects ,pin - (if ,synchronized - ;; We use a "system" spinlock here because it is very - ;; slightly faster, as it doesn't re-enable interrupts. - (sb!thread::with-recursive-system-spinlock - ((hash-table-spinlock ,hash-table)) - (,body-fun)) - (,body-fun)))))))) + ,@body)))) + (if (hash-table-weakness ,hash-table) + (sb!thread::with-recursive-system-spinlock + ((hash-table-spinlock ,hash-table) :without-gcing t) + (,body-fun)) + (with-pinned-objects ,pin + (if ,synchronized + ;; We use a "system" spinlock here because it is very + ;; slightly faster, as it doesn't re-enable interrupts. + (sb!thread::with-recursive-system-spinlock + ((hash-table-spinlock ,hash-table)) + (,body-fun)) + (,body-fun))))))) (defun gethash (key hash-table &optional default) #!+sb-doc @@ -568,7 +564,7 @@ if there is no such entry. Entries can be added using SETF." ;; redo the lookup if the GC epoch counter has changed. ;; -- JES, 2007-09-30 `(if (and (not ,foundp) - (not (eql start-epoch sb!kernel::*gc-epoch*))) + (not (eq start-epoch sb!kernel::*gc-epoch*))) (go start) (return-from %gethash3 (values ,value ,foundp)))) (overflow () @@ -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