src/code/maphash.lisp

   1 ;;;; The implementations of MAPHASH and WITH-HASH-TABLE-ITERATOR,
   2 ;;;; which should remain roughly in sync.
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   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.
  12
  13 (in-package "SB!IMPL")
  14
  15 ;;; an internal tag for marking empty slots, which needs to be defined
  16 ;;; no later than the compiler-macro for MAPHASH.
  17 ;;;
  18 ;;; Note that scav_vector() and scav_hash_table_entries() both
  19 ;;; have to be aware of the type of object this is.
  20 (define-symbol-macro +empty-ht-slot+ (make-unbound-marker))
  21 (defmacro empty-ht-slot-p (x) `(unbound-marker-p ,x))
  22
  23 (define-compiler-macro maphash (&whole form function-designator hash-table
  24                                 &environment env)
  25   (when (sb!c:policy env (> space speed))
  26     (return-from maphash form))
  27   (with-unique-names (fun table size i kv-vector key value)
  28     `(let* ((,fun (%coerce-callable-to-fun ,function-designator))
  29             (,table ,hash-table)
  30             (,size (* 2 (length (hash-table-next-vector ,table)))))
  31        ;; Regarding this TRULY-THE: in the theoretical edge case of the largest
  32        ;; possible NEXT-VECTOR, it is not really true that the I+2 is an index.
  33        ;; However, for all intents and purposes, it is an INDEX because if not,
  34        ;; the table's vectors would consume literally all addressable memory.
  35        ;; And it can't overflow a fixnum even in theory, since ARRAY-DIMENSION-LIMIT
  36        ;; is smaller than most-positive-fixnum by enough to allow adding 2.
  37        ;; And it doesn't matter anyway - the compiler uses unsigned word
  38        ;; arithmetic here on account of (* 2 length) exceeding a fixnum.
  39        (do ((,i 3 (truly-the index (+ ,i 2))))
  40            ((>= ,i ,size))
  41         ;; We are running without locking or WITHOUT-GCING. For a weak
  42         ;; :VALUE hash table it's possible that the GC hit after KEY
  43         ;; was read and now the entry is gone. So check if either the
  44         ;; key or the value is empty.
  45          (let* ((,kv-vector (hash-table-table ,table))
  46                 (,value (aref ,kv-vector ,i)))
  47            (unless (empty-ht-slot-p ,value)
  48              (let ((,key
  49                     ;; I is bounded below by 3, and bounded above by INDEX max,
  50                     ;; so (1- I) isn't checked for being an INDEX, but would
  51                     ;; nonetheless be checked against the array bound despite
  52                     ;; being obviously valid; so we force elision of the test.
  53                     (locally (declare (optimize (sb!c::insert-array-bounds-checks 0)))
  54                       (aref ,kv-vector (1- ,i)))))
  55                (unless (empty-ht-slot-p ,key)
  56                  (funcall ,fun ,key ,value)))))))))
  57
  58 (defun maphash (function-designator hash-table)
  59   "For each entry in HASH-TABLE, call the designated two-argument function on
  60 the key and value of the entry. Return NIL.
  61
  62 Consequences are undefined if HASH-TABLE is mutated during the call to
  63 MAPHASH, except for changing or removing elements corresponding to the
  64 current key. The applies to all threads, not just the current one --
  65 even for synchronized hash-tables. If the table may be mutated by
  66 another thread during iteration, use eg. SB-EXT:WITH-LOCKED-HASH-TABLE
  67 to protect the MAPHASH call."
  68   (maphash function-designator hash-table)) ; via compiler-macro
  69
  70 (defmacro with-hash-table-iterator ((name hash-table) &body body)
  71   "WITH-HASH-TABLE-ITERATOR ((name hash-table) &body body)
  72
  73 Provides a method of manually looping over the elements of a hash-table. NAME
  74 is bound to a generator-macro that, within the scope of the invocation,
  75 returns one or three values. The first value tells whether any objects remain
  76 in the hash table. When the first value is non-NIL, the second and third
  77 values are the key and the value of the next object.
  78
  79 Consequences are undefined if HASH-TABLE is mutated during execution of BODY,
  80 except for changing or removing elements corresponding to the current key. The
  81 applies to all threads, not just the current one -- even for synchronized
  82 hash-tables. If the table may be mutated by another thread during iteration,
  83 use eg. SB-EXT:WITH-LOCKED-HASH-TABLE to protect the WITH-HASH-TABLE-ITERATOR
  84 for."
  85   (let ((function (gensymify* name "-FUN")))
  86     `(let ((,function
  87             (let* ((table ,hash-table)
  88                    (size (* 2 (length (hash-table-next-vector table))))
  89                    (index 3))
  90               (declare (fixnum index))
  91               (labels
  92                   ((,name ()
  93                      ;; (We grab the table again on each iteration just in
  94                      ;; case it was rehashed by a PUTHASH.)
  95                      (let ((kv-vector (hash-table-table table)))
  96                        (loop
  97                         (when (>= index size) (return nil))
  98                         (let ((i index))
  99                           (incf (truly-the index index) 2)
 100                           (let ((value (aref kv-vector i)))
 101                             (unless (empty-ht-slot-p value)
 102                               (let ((key
 103                                      (locally
 104                                       (declare (optimize (sb!c::insert-array-bounds-checks 0)))
 105                                       (aref kv-vector (1- i)))))
 106                                 (unless (empty-ht-slot-p key)
 107                                   (return (values t key value)))))))))))
 108                 #',name))))
 109        (macrolet ((,name () '(funcall ,function)))
 110          ,@body))))