[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Fix make-hash-table with weakness + GC race
From:       Douglas Katzman via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2020-06-23 21:42:23
Message-ID: 1592948544.113079.14237 () sfp-scm-2 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  ad7f20ccde66fa7b11dc45fd3c3aa546dab90cdd (commit)
      from  7c0b715e75e046b6fe737f0feef1cc81efdee480 (commit)

- Log -----------------------------------------------------------------
commit ad7f20ccde66fa7b11dc45fd3c3aa546dab90cdd
Author: Douglas Katzman <dougk@google.com>
Date:   Tue Jun 23 17:38:37 2020 -0400

    Fix make-hash-table with weakness + GC race
---
 src/code/target-hash-table.lisp | 20 +++++++++++---------
 src/runtime/gc-common.c         |  2 +-
 tests/hash-table.impure.lisp    | 25 +++++++++++++++++++++++++
 3 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
index fcb6b28f6..7ffdb8abe 100644
--- a/src/code/target-hash-table.lisp
+++ b/src/code/target-hash-table.lisp
@@ -297,7 +297,11 @@ Examples:
 (defun set-kv-hwm (vector hwm) (setf (svref vector 0) hwm))
 (defsetf kv-vector-high-water-mark set-kv-hwm)
 
-(defmacro new-kv-vector (size weakp)
+;;; Make a new key/value vector. Weak tables do not mark the vector as weak
+;;; initially, because the vector can't hold a backpointer to the table
+;;; since the table hasn't been made yet. (GC asserts that every weak hash-table
+;;; storage vector has a table pointer - no exceptions)
+(defmacro %alloc-kv-pairs (size)
   `(let ((v (make-array (+ (* 2 ,size) kv-pairs-overhead-slots)
                         :initial-element +empty-ht-slot+)))
      (setf (kv-vector-high-water-mark v) 0)
@@ -306,11 +310,7 @@ Examples:
      ;; is set, so it needs to see a valid value in the 'supplement' slot.
      ;; Neither 0 nor +empty-ht-slot+ is a valid value.
      (setf (kv-vector-supplement v) nil)
-     (set-header-data v (if ,weakp
-                            (logior sb-vm:vector-weak-subtype
-                                    sb-vm:vector-hashing-subtype)
-                            sb-vm:vector-hashing-subtype))
-
+     (set-header-data v sb-vm:vector-hashing-subtype)
      v))
 
 (defun install-hash-table-lock (table)
@@ -488,7 +488,7 @@ Examples:
                                      :element-type 'hash-table-index
                                      :initial-element 0))
            (weakp (logtest flags hash-table-weak-flag))
-           (kv-vector (new-kv-vector size weakp))
+           (kv-vector (%alloc-kv-pairs size))
            ;; Needs to be the half the length of the KV vector to link
            ;; KV entries - mapped to indices at 2i and 2i+1 -
            ;; together.
@@ -521,6 +521,9 @@ Examples:
             (if weakp
                 table
                 (or hash-vector (= table-kind hash-table-kind-eql))))
+      (when weakp
+        (set-header-data kv-vector (logior sb-vm:vector-hashing-subtype
+                                           sb-vm:vector-weak-subtype)))
       (when (logtest flags hash-table-synchronized-flag)
         (install-hash-table-lock table))
       table))
@@ -631,8 +634,7 @@ multiple threads accessing the same hash-table without locking."
          (new-index-vector (make-array new-n-buckets
                                        :element-type 'hash-table-index
                                        :initial-element 0))
-         ;; New kv vector is not marked as weak, even for a weak table
-         (new-kv-vector (new-kv-vector new-size nil))
+         (new-kv-vector (%alloc-kv-pairs new-size))
          (new-next-vector (make-array (1+ new-size) :element-type 'hash-table-index))
          (new-hash-vector
            (when old-hash-vector
diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 60e1e40ab..0d8833755 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -1358,7 +1358,7 @@ scav_vector (lispobj *where, lispobj header)
     }
 
     lispobj* data = where + 2;
-    // Verify that the rehash epoch is a fixnum
+    // Verify that the rehash stamp is a fixnum
     gc_assert(fixnump(data[1]));
 
     /* Scavenge element (length-1), which may be a hash-table structure. */
diff --git a/tests/hash-table.impure.lisp b/tests/hash-table.impure.lisp
index 6f7b28475..8e005cb72 100644
--- a/tests/hash-table.impure.lisp
+++ b/tests/hash-table.impure.lisp
@@ -3,6 +3,31 @@
 ;;; Keep moving everything that can move during each GC
 #+gencgc (setf (generation-number-of-gcs-before-promotion 0) 1000000)
 
+;;; Check for GC invariant loss during weak table creation.
+;;; This didn't always fail, but might have, and now shouldn't.
+(defglobal *number-of-weak-tables* 0)
+(defun make-weak-key-table () (make-hash-table :weakness :key))
+(defun something-useless (x) (list x))
+(defun weak-table-allocation-test ()
+  (let ((thread
+         (sb-thread:make-thread
+           (lambda ()
+             (loop
+               (sleep .0001)
+               (gc)
+               (sb-thread:barrier (:read))
+               (when (> *number-of-weak-tables* 1000) (return)))))))
+    (loop repeat 1001 do
+      (something-useless (make-weak-key-table))
+      (incf *number-of-weak-tables*)
+      (sb-thread:barrier (:write)))
+    (sb-thread:join-thread thread)))
+;;; Interpreted code is probably too slow to be useful in this test
+(compile 'weak-table-allocation-test)
+(weak-table-allocation-test)
+(with-test (:name :weak-table-gc-invariant :skipped-on (not :sb-thread))
+  (weak-table-allocation-test))
+
 (defun is-address-sensitive (tbl)
   (let ((data (sb-kernel:get-header-data (sb-impl::hash-table-pairs tbl))))
     (logtest data sb-vm:vector-addr-hashing-subtype)))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]