Commit 1479483c authored by Gabor Melis's avatar Gabor Melis
Browse files

0.9.16.32: weak hash tables 

  The implementation is based on cmucl's weak hash table code.

  * scav_vector defers scavenging of weak hash tables until ...

  * ... newspace scavenging at which time the deferred weak hash
    tables are scavenged according to their WEAKNESS type (this
    happens after each scan of newspace)

  * finally just before weak pointers are scanned (i.e. with the
    purpose of breaking them) the weak hash tables are scanned (i.e.
    the appropriate entries are removed) too.
parent 93db5c1b

NEWS

+1 −0
Original line number Diff line number Diff line 
;;;; -*- coding: utf-8; -*-

changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16:

  * feature: weak hash tables, see MAKE-HASH-TABLE documentation

  * incompatible change: External-format support for FFI calls.  The

    SB-ALIEN:C-STRING no longer implies an ASCII

    external-format. Instead the string is subject to external-format

package-data-list.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -665,7 +665,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." 
               ;; weak pointers and finalization

               "CANCEL-FINALIZATION"

               "FINALIZE"

               "HASH-TABLE-WEAK-P" "MAKE-WEAK-POINTER"

               "HASH-TABLE-WEAKNESS" "MAKE-WEAK-POINTER"

               "WEAK-POINTER" "WEAK-POINTER-P" "WEAK-POINTER-VALUE"



               ;; If the user knows we're doing IEEE, he might reasonably

src/code/hash-table.lisp

+7 −5
Original line number Diff line number Diff line
@@ -39,11 +39,13 @@ 
  (number-entries 0 :type index)

  ;; The Key-Value pair vector.

  (table (missing-arg) :type simple-vector)

  ;; True if this is a weak hash table, meaning that key->value

  ;; mappings will disappear if there are no other references to the

  ;; key. Note: this only matters if the hash function indicates that

  ;; the hashing is EQ based.

  (weak-p nil :type (member t nil))

  ;; This slot is used to link weak hash tables during GC. When the GC

  ;; isn't running it is always NIL.

  (next-weak-hash-table nil :type null)

  ;; Non-NIL if this is some kind of weak hash table. For details see

  ;; the docstring of MAKE-HASH-TABLE.

  (weakness nil :type (member nil :key :value :key-or-value :key-and-value)

            :read-only t)

  ;; Index into the next-vector, chaining together buckets that need

  ;; to be rehashed because their hashing is EQ based and the key has

  ;; been moved by the garbage collector.

src/code/target-hash-table.lisp

+37 −23
Original line number Diff line number Diff line
@@ -108,7 +108,7 @@ 
                        (size +min-hash-table-size+)

                        (rehash-size 1.5)

                        (rehash-threshold 1)

                             (weak-p nil))

                        (weakness nil))

  #!+sb-doc

  "Create and return a new hash table. The keywords are as follows:

     :TEST -- Indicates what kind of test to use.
@@ -122,13 +122,20 @@ 
       forcing a rehash. Can be any positive number <=1, with density

       approaching zero as the threshold approaches 0. Density 1 means an

       average of one entry per bucket.

     :WEAK-P -- (This is an extension from CMU CL, not currently supported

       in SBCL 0.6.6, but perhaps supported in a future version.) If T,

       don't keep entries if the key would otherwise be garbage."

     :WEAKNESS -- IF NIL (the default) it is a normal non-weak hash table.

       If one of :KEY, :VALUE, :KEY-AND-VALUE, :KEY-OR-VALUE it is a weak

       hash table.

       Depending on the type of weakness the lack of references to the

       key and the value may allow for removal of the entry. If WEAKNESS

       is :KEY and the key would otherwise be garbage the entry is eligible

       for removal from the hash table. Similarly, if WEAKNESS is :VALUE

       the life of an entry depends on its value's references. If WEAKNESS

       is :KEY-AND-VALUE and either the key or the value would otherwise be

       garbage the entry can be removed. If WEAKNESS is :KEY-OR-VALUE and

       both the key and the value would otherwise be garbage the entry can

       be removed."

  (declare (type (or function symbol) test))

  (declare (type unsigned-byte size))

  (when weak-p

    (error "stub: unsupported WEAK-P option"))

  (multiple-value-bind (test test-fun hash-fun)

      (cond ((or (eq test #'eq) (eq test 'eq))

             (values 'eq #'eq #'eq-hash))
@@ -181,8 +188,9 @@ 
                                     :element-type

                                     '(unsigned-byte #.sb!vm:n-word-bits)

                                     :initial-element 0))

           ;; needs to be the same length as the KV vector

           ;; (FIXME: really?  why doesn't the code agree?)

           ;; Needs to be the half the length of the KV vector to link

           ;; KV entries - mapped to indeces at 2i and 2i+1 -

           ;; together.

           (next-vector (make-array size+1

                                    :element-type

                                    '(unsigned-byte #.sb!vm:n-word-bits)))
@@ -196,7 +204,7 @@ 
                   :rehash-threshold rehash-threshold

                   :rehash-trigger size

                   :table kv-vector

                   :weak-p weak-p

                   :weakness weakness

                   :index-vector index-vector

                   :next-vector next-vector

                   :hash-vector
@@ -244,9 +252,9 @@ 
      "Return the test HASH-TABLE was created with.")



#!+sb-doc

(setf (fdocumentation 'hash-table-weak-p 'function)

      "Return T if HASH-TABLE will not keep entries for keys that would

   otherwise be garbage, and NIL if it will.")

(setf (fdocumentation 'hash-table-weakness 'function)

      "Return the WEAKNESS of HASH-TABLE which is one of NIL, :KEY,

:VALUE, :KEY-AND-VALUE, :KEY-OR-VALUE.")



;;;; accessing functions
@@ -289,6 +297,10 @@ 
    ;; Disable GC tricks on the OLD-KV-VECTOR.

    (set-header-data old-kv-vector sb!vm:vector-normal-subtype)



    ;; Non-empty weak hash tables always need GC support.

    (when (and (hash-table-weakness table) (plusp (hash-table-count table)))

      (set-header-data new-kv-vector sb!vm:vector-valid-hashing-subtype))



    ;; FIXME: here and in several other places in the hash table code,

    ;; loops like this one are used when FILL or REPLACE would be

    ;; appropriate.  why are standard CL functions not used?
@@ -368,9 +380,11 @@ 
         (length (length index-vector)))

    (declare (type index size length))



    ;; Non-empty weak hash tables always need GC support.

    (unless (and (hash-table-weakness table) (plusp (hash-table-count table)))

      ;; Disable GC tricks, they will be re-enabled during the re-hash

    ;; if necesary.

    (set-header-data kv-vector sb!vm:vector-normal-subtype)

      ;; if necessary.

      (set-header-data kv-vector sb!vm:vector-normal-subtype))



    ;; Rehash all the entries.

    (setf (hash-table-next-free-kv table) 0)
@@ -536,7 +550,8 @@ 
                (hash-vector (hash-table-hash-vector hash-table))

                (test-fun (hash-table-test-fun hash-table)))

           (declare (type index index))



           (when (hash-table-weakness hash-table)

             (set-header-data kv-vector sb!vm:vector-valid-hashing-subtype))

           (cond ((or eq-based (not hash-vector))

                  (when eq-based

                    (set-header-data kv-vector
@@ -717,7 +732,11 @@ 
      (let* ((kv-vector (hash-table-table hash-table))

             (key (aref kv-vector (* 2 i)))

             (value (aref kv-vector (1+ (* 2 i)))))

        (unless (and (eq key +empty-ht-slot+)

        ;; We are running without locking or WITHOUT-GCING. For a weak

        ;; :VALUE hash table it's possible that the GC hit after KEY

        ;; was read and now the entry is gone. So check if either the

        ;; key or the value is empty.

        (unless (or (eq key +empty-ht-slot+)

                    (eq value +empty-ht-slot+))

          (funcall fun key value))))))
@@ -726,16 +745,11 @@ 
;;; Return a list of keyword args and values to use for MAKE-HASH-TABLE

;;; when reconstructing HASH-TABLE.

(defun %hash-table-ctor-args (hash-table)

  (when (hash-table-weak-p hash-table)

    ;; FIXME: This might actually work with no trouble, but as of

    ;; sbcl-0.6.12.10 when this code was written, weak hash tables

    ;; weren't working yet, so I couldn't test it. When weak hash

    ;; tables are supported again, this should be fixed.

    (error "can't dump weak hash tables readably")) ; defensive programming..

  `(:test             ',(hash-table-test             hash-table)

    :size             ',(hash-table-size             hash-table)

    :rehash-size      ',(hash-table-rehash-size      hash-table)

    :rehash-threshold ',(hash-table-rehash-threshold hash-table)))

    :rehash-threshold ',(hash-table-rehash-threshold hash-table)

    :weakness         ',(hash-table-weakness         hash-table)))



;;; Return an association list representing the same data as HASH-TABLE.

(defun %hash-table-alist (hash-table)

src/compiler/fndb.lisp

+1 −1
Original line number Diff line number Diff line
@@ -793,7 +793,7 @@ 
  (&key (:test callable) (:size unsigned-byte)

        (:rehash-size (or (integer 1) (float (1.0))))

        (:rehash-threshold (real 0 1))

        (:weak-p t))

        (:weakness (member nil :key :value :key-and-value :key-or-value)))

  hash-table

  (flushable unsafe))

(defknown hash-table-p (t) boolean (movable foldable flushable))