From 056efe111d77251c49a6b9a46b6a39e0e5da81e9 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 21 Dec 2023 13:10:47 -0700
Subject: [PATCH] ensure write barrier in last step of `vector-sort!` (#784)

The old `$vector-copy!` could use `$ptr-copy!`, which doesn't have an
associated write barrier. As a result, using `$vector-copy!` at the
end of `vector-sort!` is incorrect.

The new test is arranges for one half of a vector to have generation-0
objects and the other to have immediate objects; the two halves are
already sorted, so they end up being swapped via a temporary vector
and `$vector-copy!`. As a result, a collection afterward can fail to
scan the half of the original vector that it should scan.

The solution here is to rename the internal `$vector-copy!` function
to `$vector-fill-copy!` (by analogy to `$stencil-vector-fill-set!`)
and use keep using it for things like `vector-copy`. But the new
`$vector-copy!` as used by `vector-sort!` avoids `$ptr-copy!`.
---
 mats/5_6.ms | 40 ++++++++++++++++++++++++++++++++++++++++
 s/5_6.ss    | 20 ++++++++++++--------
 2 files changed, 52 insertions(+), 8 deletions(-)

diff --git a/mats/5_6.ms b/mats/5_6.ms
index 83ac6ac73..4ba11b913 100644
--- a/mats/5_6.ms
+++ b/mats/5_6.ms
@@ -1340,6 +1340,46 @@
                 (fprintf (console-output-port) "\n~s\n" ls)
                 (errorf #f "failed")))))))
     (make-string 200 #\.))
+
+  (let ([Ns '(10 100 1024 2048 4096)])
+    (with-interrupts-disabled
+     (andmap
+      (lambda (N)
+        (define vec (make-vector (* 2 N)))
+        ;; make the vector gen-1:
+        (collect 0 1)
+        ;; fill first half with immediates and second half with gen-0 objects,
+        ;; where both halves are already in order
+        (let loop ([i 0])
+          (unless (fx= i N)
+            (vector-set! vec i i)
+            (vector-set! vec (fx+ i N) (number->string i))
+            (loop (fx+ i 1))))
+        ;; sort, moving objects in second half to first
+        (vector-sort! (lambda (a b)
+                        (cond
+                          [(string? a)
+                           (if (string? b)
+                               (< (string->number a) (string->number b))
+                               #t)]
+                          [(string? b) #f]
+                          [else (< a b)]))
+                      vec)
+        ;; check whether dirty words got recorded correctly...
+        ;; collect all gen-0 into gen-1
+        (collect 0 1)
+        ;; make sure the right values are in the still in vector,
+        ;; which suggests that gen-0 references were updated correctly
+        (let loop ([i 0])
+          (unless (fx= i N)
+            (unless (equal? (vector-ref vec (fx+ i N)) i)
+              (errorf 'oops "at ~s ~s" i (vector-ref vec (fx+ i N))))
+            (unless (equal? (vector-ref vec i) (number->string i))
+              (errorf 'oops "at ~s ~s" i (vector-ref vec i)))
+            (loop (fx+ i 1))))
+        ;; passes
+        #t)
+      Ns)))
 )
 
 (mat vector->immutable-vector
diff --git a/s/5_6.ss b/s/5_6.ss
index f4410ea63..725fc8b1f 100644
--- a/s/5_6.ss
+++ b/s/5_6.ss
@@ -36,20 +36,24 @@
     v))
 
 (define ($vector-copy! v1 v2 n)
+  (let loop ([i (fx- n 1)])
+    (cond
+      [(fx> i 0)
+       (vector-set! v2 i (vector-ref v1 i))
+       (let ([i (fx- i 1)]) (vector-set! v2 i (vector-ref v1 i)))
+       (loop (fx- i 2))]
+      [(fx= i 0) (vector-set! v2 i (vector-ref v1 i))])))
+
+;; assumes that `v2` is newer than values to copy
+(define ($vector-fill-copy! v1 v2 n)
   (if (fx<= n 10)
-      (let loop ([i (fx- n 1)])
-        (cond
-          [(fx> i 0)
-           (vector-set! v2 i (vector-ref v1 i))
-           (let ([i (fx- i 1)]) (vector-set! v2 i (vector-ref v1 i)))
-           (loop (fx- i 2))]
-          [(fx= i 0) (vector-set! v2 i (vector-ref v1 i))]))
+      ($vector-copy! v1 v2 n)
       ($ptr-copy! v1 (constant vector-data-disp) v2
         (constant vector-data-disp) n)))
 
 (define ($vector-copy v1 n)
   (let ([v2 (make-vector n)])
-    ($vector-copy! v1 v2 n)
+    ($vector-fill-copy! v1 v2 n)
     v2))
 
 (set! vector->list