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