X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-hash-table.lisp;h=51d6537cd521c01d0922ab9dfc3b8e465cc895d5;hb=68ea71d0f020f2726e3c56c1ec491d0af734b3a4;hp=b0cf137929cd4d960d1029e36a2da7f0004c2116;hpb=54e97796e29cb89892dd30c8cb8c5e9d0a870f94;p=sbcl.git diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index b0cf137..51d6537 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -21,15 +21,19 @@ (defmacro with-spinlock-and-without-gcing ((spinlock) &body body) #!-sb-thread (declare (ignore spinlock)) - `(unwind-protect - (let ((*gc-inhibit* t)) - #!+sb-thread - (sb!thread::get-spinlock ,spinlock) - ,@body) - #!+sb-thread - (sb!thread::release-spinlock ,spinlock) - ;; the test is racy, but it can err only on the overeager side - (sb!kernel::maybe-handle-pending-gc))) + (with-unique-names (old-gc-inhibit) + `(let ((,old-gc-inhibit *gc-inhibit*) + (*gc-inhibit* t)) + (unwind-protect + (progn + #!+sb-thread + (sb!thread::get-spinlock ,spinlock) + ,@body) + #!+sb-thread + (sb!thread::release-spinlock ,spinlock) + (let ((*gc-inhibit* ,old-gc-inhibit)) + ;; the test is racy, but it can err only on the overeager side + (sb!kernel::maybe-handle-pending-gc)))))) (eval-when (:compile-toplevel :load-toplevel :execute) (defconstant max-hash sb!xc:most-positive-fixnum)) @@ -195,10 +199,12 @@ :weak-p weak-p :index-vector index-vector :next-vector next-vector - :hash-vector (unless (eq test 'eq) - (make-array size+1 - :element-type '(unsigned-byte #.sb!vm:n-word-bits) - :initial-element +magic-hash-vector-value+)) + :hash-vector + (unless (eq test 'eq) + (make-array size+1 + :element-type '(unsigned-byte + #.sb!vm:n-word-bits) + :initial-element +magic-hash-vector-value+)) :spinlock (sb!thread::make-spinlock)))) (declare (type index size+1 scaled-size length)) ;; Set up the free list, all free. These lists are 0 terminated. @@ -261,20 +267,23 @@ (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 - :element-type '(unsigned-byte #.sb!vm:n-word-bits) - :initial-element 0)) - (new-hash-vector (when old-hash-vector - (make-array new-size - :element-type '(unsigned-byte #.sb!vm:n-word-bits) - :initial-element +magic-hash-vector-value+))) + (new-next-vector + (make-array new-size + :element-type '(unsigned-byte #.sb!vm:n-word-bits) + :initial-element 0)) + (new-hash-vector + (when old-hash-vector + (make-array new-size + :element-type '(unsigned-byte #.sb!vm:n-word-bits) + :initial-element +magic-hash-vector-value+))) (old-index-vector (hash-table-index-vector table)) (new-length (almost-primify (truncate (/ (float new-size) (hash-table-rehash-threshold table))))) - (new-index-vector (make-array new-length - :element-type '(unsigned-byte #.sb!vm:n-word-bits) - :initial-element 0))) + (new-index-vector + (make-array new-length + :element-type '(unsigned-byte #.sb!vm:n-word-bits) + :initial-element 0))) (declare (type index new-size new-length old-size)) ;; Disable GC tricks on the OLD-KV-VECTOR. @@ -311,7 +320,8 @@ (hash-table-next-free-kv table)) (setf (hash-table-next-free-kv table) i)) ((and new-hash-vector - (not (= (aref new-hash-vector i) +magic-hash-vector-value+))) + (not (= (aref new-hash-vector i) + +magic-hash-vector-value+))) ;; Can use the existing hash value (not EQ based) (let* ((hashing (aref new-hash-vector i)) (index (rem hashing new-length)) @@ -339,11 +349,11 @@ (setf (hash-table-next-vector table) new-next-vector) (setf (hash-table-hash-vector table) new-hash-vector) ;; Shrink the old vectors to 0 size to help the conservative GC. - (shrink-vector old-kv-vector 0) - (shrink-vector old-index-vector 0) - (shrink-vector old-next-vector 0) + (%shrink-vector old-kv-vector 0) + (%shrink-vector old-index-vector 0) + (%shrink-vector old-next-vector 0) (when old-hash-vector - (shrink-vector old-hash-vector 0)) + (%shrink-vector old-hash-vector 0)) (setf (hash-table-rehash-trigger table) new-size)) (values)) @@ -378,7 +388,8 @@ ;; Slot is empty, push it onto free list. (setf (aref next-vector i) (hash-table-next-free-kv table)) (setf (hash-table-next-free-kv table) i)) - ((and hash-vector (not (= (aref hash-vector i) +magic-hash-vector-value+))) + ((and hash-vector (not (= (aref hash-vector i) + +magic-hash-vector-value+))) ;; Can use the existing hash value (not EQ based) (let* ((hashing (aref hash-vector i)) (index (rem hashing length)) @@ -507,7 +518,8 @@ (kv-vector (hash-table-table hash-table))) ;; Check the cache - (if (and cache (< cache (length kv-vector)) (eq (aref kv-vector cache) key)) + (if (and cache (< cache (length kv-vector)) + (eq (aref kv-vector cache) key)) ;; If cached, just store here (setf (aref kv-vector (1+ cache)) value) @@ -527,7 +539,8 @@ (cond ((or eq-based (not hash-vector)) (when eq-based - (set-header-data kv-vector sb!vm:vector-valid-hashing-subtype)) + (set-header-data kv-vector + sb!vm:vector-valid-hashing-subtype)) ;; Search next-vector chain for a matching key. (do ((next next (aref next-vector next))) @@ -646,7 +659,8 @@ (declare (type index next)) (when (and (= hashing (aref hash-vector next)) (funcall test-fun key (aref table (* 2 next)))) - (return-from remhash (clear-slot next-vector prior next))))))))))) + (return-from remhash + (clear-slot next-vector prior next))))))))))) (defun clrhash (hash-table) #!+sb-doc