1 ;;;; that part of the implementation of HASH-TABLE which lives solely
2 ;;;; on the target system, not on the cross-compilation host
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
13 (in-package "SB!IMPL")
20 (eval-when (:compile-toplevel :load-toplevel :execute)
21 (defconstant max-hash most-positive-fixnum))
24 `(integer 0 ,max-hash))
26 #!-sb-fluid (declaim (inline pointer-hash))
27 (defun pointer-hash (key)
28 (declare (values hash))
29 (truly-the hash (%primitive sb!c:make-fixnum key)))
31 #!-sb-fluid (declaim (inline eq-hash))
33 (declare (values hash (member t nil)))
34 (values (pointer-hash key)
35 (oddp (get-lisp-obj-address key))))
37 #!-sb-fluid (declaim (inline equal-hash))
38 (defun equal-hash (key)
39 (declare (values hash (member t nil)))
40 (values (sxhash key) nil))
42 #!-sb-fluid (declaim (inline eql-hash))
44 (declare (values hash (member t nil)))
49 (defun equalp-hash (key)
50 (declare (values hash (member t nil)))
51 (values (psxhash key) nil))
53 (defun almost-primify (num)
54 (declare (type index num))
56 "Return an almost prime number greater than or equal to NUM."
65 ;;;; user-defined hash table tests
67 (defvar *hash-table-tests* nil)
69 (defun define-hash-table-test (name test-fun hash-fun)
71 "Define a new kind of hash table test."
72 (declare (type symbol name)
73 (type function test-fun hash-fun))
74 (setf *hash-table-tests*
75 (cons (list name test-fun hash-fun)
76 (remove name *hash-table-tests* :test #'eq :key #'car)))
79 ;;;; construction and simple accessors
81 (defconstant +min-hash-table-size+ 16)
83 (defun make-hash-table (&key (test 'eql)
84 (size +min-hash-table-size+)
89 "Create and return a new hash table. The keywords are as follows:
90 :TEST -- Indicates what kind of test to use.
91 :SIZE -- A hint as to how many elements will be put in this hash
93 :REHASH-SIZE -- Indicates how to expand the table when it fills up.
94 If an integer, add space for that many elements. If a floating
95 point number (which must be greater than 1.0), multiply the size
97 :REHASH-THRESHOLD -- Indicates how dense the table can become before
98 forcing a rehash. Can be any positive number <=1, with density
99 approaching zero as the threshold approaches 0. Density 1 means an
100 average of one entry per bucket.
101 :WEAK-P -- (This is an extension from CMU CL, not currently supported
102 in SBCL 0.6.6, but perhaps supported in a future version.) If T,
103 don't keep entries if the key would otherwise be garbage."
104 (declare (type (or function symbol) test))
105 (declare (type unsigned-byte size))
107 (error "stub: unsupported WEAK-P option"))
108 (multiple-value-bind (test test-fun hash-fun)
109 (cond ((or (eq test #'eq) (eq test 'eq))
110 (values 'eq #'eq #'eq-hash))
111 ((or (eq test #'eql) (eq test 'eql))
112 (values 'eql #'eql #'eql-hash))
113 ((or (eq test #'equal) (eq test 'equal))
114 (values 'equal #'equal #'equal-hash))
115 ((or (eq test #'equalp) (eq test 'equalp))
116 (values 'equalp #'equalp #'equalp-hash))
118 ;; FIXME: I'd like to remove *HASH-TABLE-TESTS* stuff.
119 ;; Failing that, I'd like to rename it to
120 ;; *USER-HASH-TABLE-TESTS*.
121 (dolist (info *hash-table-tests*
122 (error "unknown :TEST for MAKE-HASH-TABLE: ~S"
124 (destructuring-bind (test-name test-fun hash-fun) info
125 (when (or (eq test test-name) (eq test test-fun))
126 (return (values test-name test-fun hash-fun)))))))
127 (let* ((size (max +min-hash-table-size+
129 ;; SIZE is just a hint, so if the user asks
130 ;; for a SIZE which'd be too big for us to
131 ;; easily implement, we bump it down.
132 (floor array-dimension-limit 16))))
133 (rehash-size (if (integerp rehash-size)
135 (float rehash-size 1.0)))
136 ;; FIXME: Original REHASH-THRESHOLD default should be 1.0,
137 ;; not 1, to make it easier for the compiler to avoid
139 (rehash-threshold (float rehash-threshold 1.0))
140 (size+1 (1+ size)) ; The first element is not usable.
141 (scaled-size (round (/ (float size+1) rehash-threshold)))
142 (length (almost-primify (max scaled-size
143 (1+ +min-hash-table-size+))))
144 (index-vector (make-array length
145 :element-type '(unsigned-byte 32)
147 ;; needs to be the same length as the KV vector
148 (next-vector (make-array size+1
149 :element-type '(unsigned-byte 32)))
150 (kv-vector (make-array (* 2 size+1)
151 :initial-element +empty-ht-slot+))
152 (table (%make-hash-table
156 :rehash-size rehash-size
157 :rehash-threshold rehash-threshold
161 :index-vector index-vector
162 :next-vector next-vector
163 :hash-vector (unless (eq test 'eq)
165 :element-type '(unsigned-byte 32)
166 :initial-element #x80000000)))))
167 (declare (type index size+1 scaled-size length))
168 ;; Set up the free list, all free. These lists are 0 terminated.
171 (setf (aref next-vector i) (1+ i)))
172 (setf (aref next-vector size) 0)
173 (setf (hash-table-next-free-kv table) 1)
174 (setf (hash-table-needing-rehash table) 0)
175 (setf (aref kv-vector 0) table)
178 (defun hash-table-count (hash-table)
180 "Returns the number of entries in the given HASH-TABLE."
181 (declare (type hash-table hash-table)
183 (hash-table-number-entries hash-table))
186 (setf (fdocumentation 'hash-table-rehash-size 'function)
187 "Return the rehash-size HASH-TABLE was created with.")
190 (setf (fdocumentation 'hash-table-rehash-threshold 'function)
191 "Return the rehash-threshold HASH-TABLE was created with.")
193 (defun hash-table-size (hash-table)
195 "Return a size that can be used with MAKE-HASH-TABLE to create a hash
196 table that can hold however many entries HASH-TABLE can hold without
198 (hash-table-rehash-trigger hash-table))
201 (setf (fdocumentation 'hash-table-test 'function)
202 "Return the test HASH-TABLE was created with.")
205 (setf (fdocumentation 'hash-table-weak-p 'function)
206 "Return T if HASH-TABLE will not keep entries for keys that would
207 otherwise be garbage, and NIL if it will.")
209 ;;;; accessing functions
211 ;;; Make new vectors for the table, extending the table based on the
213 (defun rehash (table)
214 (declare (type hash-table table))
215 (let* ((old-kv-vector (hash-table-table table))
216 (old-next-vector (hash-table-next-vector table))
217 (old-hash-vector (hash-table-hash-vector table))
218 (old-size (length old-next-vector))
220 (let ((rehash-size (hash-table-rehash-size table)))
221 (etypecase rehash-size
223 (+ rehash-size old-size))
225 (the index (round (* rehash-size old-size)))))))
226 (new-kv-vector (make-array (* 2 new-size)
227 :initial-element +empty-ht-slot+))
228 (new-next-vector (make-array new-size
229 :element-type '(unsigned-byte 32)
231 (new-hash-vector (when old-hash-vector
233 :element-type '(unsigned-byte 32)
234 :initial-element #x80000000)))
235 (old-index-vector (hash-table-index-vector table))
236 (new-length (almost-primify
237 (round (/ (float new-size)
238 (hash-table-rehash-threshold table)))))
239 (new-index-vector (make-array new-length
240 :element-type '(unsigned-byte 32)
241 :initial-element 0)))
242 (declare (type index new-size new-length old-size))
244 ;; Disable GC tricks on the OLD-KV-VECTOR.
245 (set-header-data old-kv-vector sb!vm:vector-normal-subtype)
247 ;; Copy over the kv-vector. The element positions should not move
248 ;; in case there are active scans.
249 (dotimes (i (* old-size 2))
250 (declare (type index i))
251 (setf (aref new-kv-vector i) (aref old-kv-vector i)))
253 ;; Copy over the hash-vector.
254 (when old-hash-vector
255 (dotimes (i old-size)
256 (setf (aref new-hash-vector i) (aref old-hash-vector i))))
258 (setf (hash-table-next-free-kv table) 0)
259 (setf (hash-table-needing-rehash table) 0)
260 ;; Rehash all the entries; last to first so that after the pushes
261 ;; the chains are first to last.
262 (do ((i (1- new-size) (1- i)))
264 (let ((key (aref new-kv-vector (* 2 i)))
265 (value (aref new-kv-vector (1+ (* 2 i)))))
266 (cond ((and (eq key +empty-ht-slot+)
267 (eq value +empty-ht-slot+))
268 ;; Slot is empty, push it onto the free list.
269 (setf (aref new-next-vector i)
270 (hash-table-next-free-kv table))
271 (setf (hash-table-next-free-kv table) i))
272 ((and new-hash-vector
273 (not (= (aref new-hash-vector i) #x80000000)))
274 ;; Can use the existing hash value (not EQ based)
275 (let* ((hashing (aref new-hash-vector i))
276 (index (rem hashing new-length))
277 (next (aref new-index-vector index)))
278 (declare (type index index)
280 ;; Push this slot into the next chain.
281 (setf (aref new-next-vector i) next)
282 (setf (aref new-index-vector index) i)))
286 (set-header-data new-kv-vector
287 sb!vm:vector-valid-hashing-subtype)
288 (let* ((hashing (pointer-hash key))
289 (index (rem hashing new-length))
290 (next (aref new-index-vector index)))
291 (declare (type index index)
293 ;; Push this slot onto the next chain.
294 (setf (aref new-next-vector i) next)
295 (setf (aref new-index-vector index) i))))))
296 (setf (hash-table-table table) new-kv-vector)
297 (setf (hash-table-index-vector table) new-index-vector)
298 (setf (hash-table-next-vector table) new-next-vector)
299 (setf (hash-table-hash-vector table) new-hash-vector)
300 ;; Shrink the old vectors to 0 size to help the conservative GC.
301 (shrink-vector old-kv-vector 0)
302 (shrink-vector old-index-vector 0)
303 (shrink-vector old-next-vector 0)
304 (when old-hash-vector
305 (shrink-vector old-hash-vector 0))
306 (setf (hash-table-rehash-trigger table) new-size))
309 ;;; Use the same size as before, re-using the vectors.
310 (defun rehash-without-growing (table)
311 (declare (type hash-table table))
312 (let* ((kv-vector (hash-table-table table))
313 (next-vector (hash-table-next-vector table))
314 (hash-vector (hash-table-hash-vector table))
315 (size (length next-vector))
316 (index-vector (hash-table-index-vector table))
317 (length (length index-vector)))
318 (declare (type index size length)
319 (type (simple-array (unsigned-byte 32) (*))))
321 ;; Disable GC tricks, they will be re-enabled during the re-hash
323 (set-header-data kv-vector sb!vm:vector-normal-subtype)
325 ;; Rehash all the entries.
326 (setf (hash-table-next-free-kv table) 0)
327 (setf (hash-table-needing-rehash table) 0)
329 (setf (aref next-vector i) 0))
331 (setf (aref index-vector i) 0))
332 (do ((i (1- size) (1- i)))
334 (let ((key (aref kv-vector (* 2 i)))
335 (value (aref kv-vector (1+ (* 2 i)))))
336 (cond ((and (eq key +empty-ht-slot+)
337 (eq value +empty-ht-slot+))
338 ;; Slot is empty, push it onto free list.
339 (setf (aref next-vector i) (hash-table-next-free-kv table))
340 (setf (hash-table-next-free-kv table) i))
341 ((and hash-vector (not (= (aref hash-vector i) #x80000000)))
342 ;; Can use the existing hash value (not EQ based)
343 (let* ((hashing (aref hash-vector i))
344 (index (rem hashing length))
345 (next (aref index-vector index)))
346 (declare (type index index))
347 ;; Push this slot into the next chain.
348 (setf (aref next-vector i) next)
349 (setf (aref index-vector index) i)))
353 (set-header-data kv-vector sb!vm:vector-valid-hashing-subtype)
354 (let* ((hashing (pointer-hash key))
355 (index (rem hashing length))
356 (next (aref index-vector index)))
357 (declare (type index index)
359 ;; Push this slot into the next chain.
360 (setf (aref next-vector i) next)
361 (setf (aref index-vector index) i)))))))
364 (defun flush-needing-rehash (table)
365 (let* ((kv-vector (hash-table-table table))
366 (index-vector (hash-table-index-vector table))
367 (next-vector (hash-table-next-vector table))
368 (length (length index-vector)))
369 (do ((next (hash-table-needing-rehash table)))
371 (declare (type index next))
372 (let* ((key (aref kv-vector (* 2 next)))
373 (hashing (pointer-hash key))
374 (index (rem hashing length))
375 (temp (aref next-vector next)))
376 (setf (aref next-vector next) (aref index-vector index))
377 (setf (aref index-vector index) next)
379 (setf (hash-table-needing-rehash table) 0)
382 (defun gethash (key hash-table &optional default)
384 "Finds the entry in HASH-TABLE whose key is KEY and returns the associated
385 value and T as multiple values, or returns DEFAULT and NIL if there is no
386 such entry. Entries can be added using SETF."
387 (declare (type hash-table hash-table)
388 (values t (member t nil)))
390 (cond ((= (get-header-data (hash-table-table hash-table))
391 sb!vm:vector-must-rehash-subtype)
392 (rehash-without-growing hash-table))
393 ((not (zerop (hash-table-needing-rehash hash-table)))
394 (flush-needing-rehash hash-table)))
395 ;; Search for key in the hash table.
396 (multiple-value-bind (hashing eq-based)
397 (funcall (hash-table-hash-fun hash-table) key)
398 (declare (type hash hashing))
399 (let* ((index-vector (hash-table-index-vector hash-table))
400 (length (length index-vector))
401 (index (rem hashing length))
402 (next (aref index-vector index))
403 (table (hash-table-table hash-table))
404 (next-vector (hash-table-next-vector hash-table))
405 (hash-vector (hash-table-hash-vector hash-table))
406 (test-fun (hash-table-test-fun hash-table)))
407 (declare (type index index))
408 ;; Search next-vector chain for a matching key.
409 (if (or eq-based (not hash-vector))
410 (do ((next next (aref next-vector next)))
411 ((zerop next) (values default nil))
412 (declare (type index next))
413 (when (eq key (aref table (* 2 next)))
414 (return (values (aref table (1+ (* 2 next))) t))))
415 (do ((next next (aref next-vector next)))
416 ((zerop next) (values default nil))
417 (declare (type index next))
418 (when (and (= hashing (aref hash-vector next))
419 (funcall test-fun key (aref table (* 2 next))))
421 (return (values (aref table (1+ (* 2 next))) t)))))))))
423 ;;; so people can call #'(SETF GETHASH)
424 (defun (setf gethash) (new-value key table &optional default)
425 (declare (ignore default))
426 (%puthash key table new-value))
428 (defun %puthash (key hash-table value)
429 (declare (type hash-table hash-table))
430 (assert (hash-table-index-vector hash-table))
432 ;; We need to rehash here so that a current key can be found if it
433 ;; exists. Check that there is room for one more entry. May not be
434 ;; needed if the key is already present.
435 (cond ((zerop (hash-table-next-free-kv hash-table))
437 ((= (get-header-data (hash-table-table hash-table))
438 sb!vm:vector-must-rehash-subtype)
439 (rehash-without-growing hash-table))
440 ((not (zerop (hash-table-needing-rehash hash-table)))
441 (flush-needing-rehash hash-table)))
443 ;; Search for key in the hash table.
444 (multiple-value-bind (hashing eq-based)
445 (funcall (hash-table-hash-fun hash-table) key)
446 (declare (type hash hashing))
447 (let* ((index-vector (hash-table-index-vector hash-table))
448 (length (length index-vector))
449 (index (rem hashing length))
450 (next (aref index-vector index))
451 (kv-vector (hash-table-table hash-table))
452 (next-vector (hash-table-next-vector hash-table))
453 (hash-vector (hash-table-hash-vector hash-table))
454 (test-fun (hash-table-test-fun hash-table)))
455 (declare (type index index))
457 (cond ((or eq-based (not hash-vector))
459 (set-header-data kv-vector sb!vm:vector-valid-hashing-subtype))
461 ;; Search next-vector chain for a matching key.
462 (do ((next next (aref next-vector next)))
464 (declare (type index next))
465 (when (eq key (aref kv-vector (* 2 next)))
466 ;; Found, just replace the value.
467 (setf (aref kv-vector (1+ (* 2 next))) value)
468 (return-from %puthash value))))
470 ;; Search next-vector chain for a matching key.
471 (do ((next next (aref next-vector next)))
473 (declare (type index next))
474 (when (and (= hashing (aref hash-vector next))
475 (funcall test-fun key
476 (aref kv-vector (* 2 next))))
477 ;; Found, just replace the value.
478 (setf (aref kv-vector (1+ (* 2 next))) value)
479 (return-from %puthash value)))))
481 ;; Pop a KV slot off the free list
482 (let ((free-kv-slot (hash-table-next-free-kv hash-table)))
483 ;; Double-check for overflow.
484 (assert (not (zerop free-kv-slot)))
485 (setf (hash-table-next-free-kv hash-table)
486 (aref next-vector free-kv-slot))
487 (incf (hash-table-number-entries hash-table))
489 (setf (aref kv-vector (* 2 free-kv-slot)) key)
490 (setf (aref kv-vector (1+ (* 2 free-kv-slot))) value)
492 ;; Setup the hash-vector if necessary.
495 (setf (aref hash-vector free-kv-slot) hashing)
496 (assert (= (aref hash-vector free-kv-slot) #x80000000))))
498 ;; Push this slot into the next chain.
499 (setf (aref next-vector free-kv-slot) next)
500 (setf (aref index-vector index) free-kv-slot)))))
503 (defun remhash (key hash-table)
505 "Remove the entry in HASH-TABLE associated with KEY. Returns T if there
506 was such an entry, and NIL if not."
507 (declare (type hash-table hash-table)
508 (values (member t nil)))
510 ;; We need to rehash here so that a current key can be found if it
512 (cond ((= (get-header-data (hash-table-table hash-table))
513 sb!vm:vector-must-rehash-subtype)
514 (rehash-without-growing hash-table))
515 ((not (zerop (hash-table-needing-rehash hash-table)))
516 (flush-needing-rehash hash-table)))
518 ;; Search for key in the hash table.
519 (multiple-value-bind (hashing eq-based)
520 (funcall (hash-table-hash-fun hash-table) key)
521 (declare (type hash hashing))
522 (let* ((index-vector (hash-table-index-vector hash-table))
523 (length (length index-vector))
524 (index (rem hashing length))
525 (next (aref index-vector index))
526 (table (hash-table-table hash-table))
527 (next-vector (hash-table-next-vector hash-table))
528 (hash-vector (hash-table-hash-vector hash-table))
529 (test-fun (hash-table-test-fun hash-table)))
530 (declare (type index index next))
533 ((if (or eq-based (not hash-vector))
534 (eq key (aref table (* 2 next)))
535 (and (= hashing (aref hash-vector next))
536 (funcall test-fun key (aref table (* 2 next)))))
538 ;; FIXME: Substantially the same block of code seems to
539 ;; appear in all three cases. (In the first case, it
540 ;; appear bare; in the other two cases, it's wrapped in
541 ;; DO.) It should be defined in a separate (possibly
542 ;; inline) DEFUN or FLET.
544 ;; Mark slot as empty.
545 (setf (aref table (* 2 next)) +empty-ht-slot+
546 (aref table (1+ (* 2 next))) +empty-ht-slot+)
547 ;; Update the index-vector pointer.
548 (setf (aref index-vector index) (aref next-vector next))
549 ;; Push KV slot onto free chain.
550 (setf (aref next-vector next)
551 (hash-table-next-free-kv hash-table))
552 (setf (hash-table-next-free-kv hash-table) next)
554 (setf (aref hash-vector next) #x80000000))
555 (decf (hash-table-number-entries hash-table))
557 ;; Search next-vector chain for a matching key.
558 ((or eq-based (not hash-vector))
560 (do ((prior next next)
561 (next (aref next-vector next) (aref next-vector next)))
563 (declare (type index next))
564 (when (eq key (aref table (* 2 next)))
565 ;; Mark slot as empty.
566 (setf (aref table (* 2 next)) +empty-ht-slot+
567 (aref table (1+ (* 2 next))) +empty-ht-slot+)
568 ;; Update the prior pointer in the chain to skip this.
569 (setf (aref next-vector prior) (aref next-vector next))
570 ;; Push KV slot onto free chain.
571 (setf (aref next-vector next)
572 (hash-table-next-free-kv hash-table))
573 (setf (hash-table-next-free-kv hash-table) next)
575 (setf (aref hash-vector next) #x80000000))
576 (decf (hash-table-number-entries hash-table))
580 (do ((prior next next)
581 (next (aref next-vector next) (aref next-vector next)))
583 (declare (type index next))
584 (when (and (= hashing (aref hash-vector next))
585 (funcall test-fun key (aref table (* 2 next))))
586 ;; Mark slot as empty.
587 (setf (aref table (* 2 next)) +empty-ht-slot+)
588 (setf (aref table (1+ (* 2 next))) +empty-ht-slot+)
589 ;; Update the prior pointer in the chain to skip this.
590 (setf (aref next-vector prior) (aref next-vector next))
591 ;; Push KV slot onto free chain.
592 (setf (aref next-vector next)
593 (hash-table-next-free-kv hash-table))
594 (setf (hash-table-next-free-kv hash-table) next)
596 (setf (aref hash-vector next) #x80000000))
597 (decf (hash-table-number-entries hash-table))
600 (defun clrhash (hash-table)
602 "This removes all the entries from HASH-TABLE and returns the hash table
604 (let* ((kv-vector (hash-table-table hash-table))
605 (kv-length (length kv-vector))
606 (next-vector (hash-table-next-vector hash-table))
607 (hash-vector (hash-table-hash-vector hash-table))
608 (size (length next-vector))
609 (index-vector (hash-table-index-vector hash-table))
610 (length (length index-vector)))
611 ;; Disable GC tricks.
612 (set-header-data kv-vector sb!vm:vector-normal-subtype)
613 ;; Mark all slots as empty by setting all keys and values to magic
617 (setf (aref kv-vector i) +empty-ht-slot+))
618 (assert (eq (aref kv-vector 0) hash-table))
619 ;; Set up the free list, all free.
622 (setf (aref next-vector i) (1+ i)))
623 (setf (aref next-vector (1- size)) 0)
624 (setf (hash-table-next-free-kv hash-table) 1)
625 (setf (hash-table-needing-rehash hash-table) 0)
626 ;; Clear the index-vector.
628 (setf (aref index-vector i) 0))
629 ;; Clear the hash-vector.
632 (setf (aref hash-vector i) #x80000000))))
633 (setf (hash-table-number-entries hash-table) 0)
638 ;;; FIXME: This should be made into a compiler transform for two reasons:
639 ;;; 1. It would then be available for compiling the entire system,
640 ;;; not only parts of the system which are defined after DEFUN MAPHASH.
641 ;;; 2. It could be conditional on compilation policy, so that
642 ;;; it could be compiled as a full call instead of an inline
643 ;;; expansion when SPACE>SPEED. (Not only would this save space,
644 ;;; it might actually be faster when a call is made from byte-compiled
646 (declaim (inline maphash))
647 (defun maphash (function-designator hash-table)
649 "For each entry in HASH-TABLE, call the designated function on the key
650 and value of the entry. Return NIL."
651 (let ((fun (coerce function-designator 'function))
652 (size (length (hash-table-next-vector hash-table))))
653 (declare (type function fun))
656 (declare (type index i))
657 (let* ((kv-vector (hash-table-table hash-table))
658 (key (aref kv-vector (* 2 i)))
659 (value (aref kv-vector (1+ (* 2 i)))))
660 (unless (and (eq key +empty-ht-slot+)
661 (eq value +empty-ht-slot+))
662 (funcall fun key value))))))
664 ;;;; methods on HASH-TABLE
666 (def!method print-object ((ht hash-table) stream)
667 (declare (type stream stream))
668 (print-unreadable-object (ht stream :type t :identity t)
672 (hash-table-number-entries ht))))
674 (def!method make-load-form ((hash-table hash-table) &optional environment)
675 (declare (ignorable environment))
678 :test ',(hash-table-test hash-table)
679 :size ',(hash-table-size hash-table)
680 :rehash-size ',(hash-table-rehash-size hash-table)
681 :rehash-threshold ',(hash-table-rehash-threshold hash-table))
683 (maphash (lambda (key value)
684 (push (cons key value) alist))
687 ;; FIXME: It'd probably be more efficient here to write the
688 ;; hash table values as a SIMPLE-VECTOR rather than an alist.
689 ;; (Someone dumping a huge hash table might well thank us..)
690 `(stuff-hash-table ,hash-table ',alist)
693 (defun stuff-hash-table (table alist)
695 (setf (gethash (car x) table) (cdr x))))