- (cond ((zerop next)
- nil)
- ((if (or eq-based (not hash-vector))
- (eq key (aref table (* 2 next)))
- (and (= hashing (aref hash-vector next))
- (funcall test-fun key (aref table (* 2 next)))))
-
- ;; FIXME: Substantially the same block of code seems to
- ;; appear in all three cases. (In the first case, it
- ;; appear bare; in the other two cases, it's wrapped in
- ;; DO.) It should be defined in a separate (possibly
- ;; inline) DEFUN or FLET.
-
- ;; Mark slot as empty.
- (setf (aref table (* 2 next)) +empty-ht-slot+
- (aref table (1+ (* 2 next))) +empty-ht-slot+)
- ;; Update the index-vector pointer.
- (setf (aref index-vector index) (aref next-vector next))
- ;; Push KV slot onto free chain.
- (setf (aref next-vector next)
- (hash-table-next-free-kv hash-table))
- (setf (hash-table-next-free-kv hash-table) next)
- (when hash-vector
- (setf (aref hash-vector next) #x80000000))
- (decf (hash-table-number-entries hash-table))
- t)
- ;; Search next-vector chain for a matching key.
- ((or eq-based (not hash-vector))
- ;; EQ based
- (do ((prior next next)
- (next (aref next-vector next) (aref next-vector next)))
- ((zerop next) nil)
- (declare (type index next))
- (when (eq key (aref table (* 2 next)))
- ;; Mark slot as empty.
- (setf (aref table (* 2 next)) +empty-ht-slot+
- (aref table (1+ (* 2 next))) +empty-ht-slot+)
- ;; Update the prior pointer in the chain to skip this.
- (setf (aref next-vector prior) (aref next-vector next))
- ;; Push KV slot onto free chain.
- (setf (aref next-vector next)
- (hash-table-next-free-kv hash-table))
- (setf (hash-table-next-free-kv hash-table) next)
- (when hash-vector
- (setf (aref hash-vector next) #x80000000))
- (decf (hash-table-number-entries hash-table))
- (return t))))
- (t
- ;; not EQ based
- (do ((prior next next)
- (next (aref next-vector next) (aref next-vector next)))
- ((zerop next) nil)
- (declare (type index next))
- (when (and (= hashing (aref hash-vector next))
- (funcall test-fun key (aref table (* 2 next))))
- ;; Mark slot as empty.
- (setf (aref table (* 2 next)) +empty-ht-slot+)
- (setf (aref table (1+ (* 2 next))) +empty-ht-slot+)
- ;; Update the prior pointer in the chain to skip this.
- (setf (aref next-vector prior) (aref next-vector next))
- ;; Push KV slot onto free chain.
- (setf (aref next-vector next)
- (hash-table-next-free-kv hash-table))
- (setf (hash-table-next-free-kv hash-table) next)
- (when hash-vector
- (setf (aref hash-vector next) #x80000000))
- (decf (hash-table-number-entries hash-table))
- (return t)))))))))
+ (flet ((clear-slot (chain-vector prior-slot-location slot-location)
+ ;; Mark slot as empty.
+ (setf (aref table (* 2 slot-location)) +empty-ht-slot+
+ (aref table (1+ (* 2 slot-location))) +empty-ht-slot+)
+ ;; Update the prior pointer in the chain to skip this.
+ (setf (aref chain-vector prior-slot-location)
+ (aref next-vector slot-location))
+ ;; Push KV slot onto free chain.
+ (setf (aref next-vector slot-location)
+ (hash-table-next-free-kv hash-table))
+ (setf (hash-table-next-free-kv hash-table) slot-location)
+ (when hash-vector
+ (setf (aref hash-vector slot-location) +magic-hash-vector-value+))
+ (decf (hash-table-number-entries hash-table))
+ t))
+ (cond ((zerop next)
+ nil)
+ ((if (or eq-based (not hash-vector))
+ (eq key (aref table (* 2 next)))
+ (and (= hashing (aref hash-vector next))
+ (funcall test-fun key (aref table (* 2 next)))))
+ (clear-slot index-vector index next))
+ ;; Search next-vector chain for a matching key.
+ ((or eq-based (not hash-vector))
+ ;; EQ based
+ (do ((prior next next)
+ (next (aref next-vector next) (aref next-vector next)))
+ ((zerop next) nil)
+ (declare (type index next))
+ (when (eq key (aref table (* 2 next)))
+ (return-from remhash (clear-slot next-vector prior next)))))
+ (t
+ ;; not EQ based
+ (do ((prior next next)
+ (next (aref next-vector next) (aref next-vector next)))
+ ((zerop next) nil)
+ (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)))))))))))