From 00e68aca39e9204fd398b839b89a9858a8f1bdd3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 24 Aug 2023 12:20:45 -0600
Subject: [PATCH] repair collector handling of ephemerons

When an ephemeron pair refers to an object in younger generation, and
when a collection would move that object to a generation that's less
the maximum target generation, the collector could sometimes mishandle
the ephemeron pair by trying to register it multiple times for later
handling.
---
 LOG                              |  5 ++++-
 c/gc.c                           | 24 +++++++++++++++++++-----
 mats/4.ms                        | 13 +++++++++++++
 release_notes/release_notes.stex |  5 +++++
 4 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/LOG b/LOG
index 1b35a37cb..687ca7d2b 100644
--- a/LOG
+++ b/LOG
@@ -2398,6 +2398,9 @@
 - reduce allocation and copying for certain cases in bytevector->string
     mats/io.ms release_notes/release_notes.stex s/io.ss
 - update zlib to version 1.3
-- repair collector handling of weak pointers when the max target generation
+- repair collector handling of weak pairs when the max target generation
   is greater than the minimum target generation
     c/gc.c mats/4.ms
+- repair collector handling of ephemeron pairs that refer to objects in
+  younger generations
+    c/gc.c mats/4.ms
diff --git a/c/gc.c b/c/gc.c
index ea6765601..9a73993e4 100644
--- a/c/gc.c
+++ b/c/gc.c
@@ -524,6 +524,7 @@ static IGEN copy(ptr pp, seginfo *si, ptr *ppp FORMAL_CTGS) {
         find_room(space_ephemeron, newg, type_pair, size_ephemeron, p);
         INITCAR(p) = Scar(pp);
         INITCDR(p) = Scdr(pp);
+        EPHEMERONNEXT(p) = Sfalse; /* #f => not yet swept */
       } else {
         ptr qq = Scdr(pp); ptr q;
         if (qq != pp && TYPEBITS(qq) == type_pair && ptr_get_segment(qq) == ptr_get_segment(pp) && FWDMARKER(qq) != forward_marker && !locked(qq)) {
@@ -2212,9 +2213,18 @@ static void add_ephemeron_to_pending(ptr pe) {
      through `pending_ephemerons` can dramatically decrease the number
      of times that we have to trigger re-checking, especially since
      check_pending_pehemerons() is run only after all other sweep
-     opportunities are exhausted. */
-  EPHEMERONNEXT(pe) = pending_ephemerons;
-  pending_ephemerons = pe;
+     opportunities are exhausted.
+     Guard against adding an empheron to the pending list a second
+     time. For example, an emphemeron can get swept twice if it's in
+     generation 2 and points to an inaccessible generation 0 object;
+     sweeping 2->0 will conservatively assume that the target will
+     end up in generation 1, which causes sweeping 2->1 to see the
+     same ephemeron again. (That might be the only way to sweep
+     an ephemeron twice, but I'm not sure.) */
+  if (EPHEMERONNEXT(pe) == Sfalse) {
+    EPHEMERONNEXT(pe) = pending_ephemerons;
+    pending_ephemerons = pe;
+  }
 }
 
 static void add_trigger_ephemerons_to_repending(ptr pe) {
@@ -2264,6 +2274,7 @@ static void check_pending_ephemerons(ONLY_FORMAL_CTGS) {
   pending_ephemerons = NULL;
   while (pe != NULL) {
     next_pe = EPHEMERONNEXT(pe);
+    EPHEMERONNEXT(pe) = Sfalse;
     check_ephemeron(pe, 1 ACTUAL_CTGS);
     pe = next_pe;
   }
@@ -2320,7 +2331,7 @@ static IGEN check_dirty_ephemeron(ptr pe, IGEN youngest FORMAL_CTGS) {
 }
 
 static void clear_trigger_ephemerons(void) {
-  ptr pe;
+  ptr pe, next_pe;
 
   if (pending_ephemerons != NULL)
     S_error_abort("clear_trigger_ephemerons(gc): non-empty pending list");
@@ -2333,6 +2344,7 @@ static void clear_trigger_ephemerons(void) {
     } else {
       seginfo *si;
       ptr p = Scar(pe);
+
       /* Key never became reachable, so clear key and value */
       INITCAR(pe) = Sbwp_object;
       INITCDR(pe) = Sbwp_object;
@@ -2341,6 +2353,8 @@ static void clear_trigger_ephemerons(void) {
       si = SegInfo(ptr_get_segment(p));
       si->trigger_ephemerons = NULL;
     }
-    pe = EPHEMERONNEXT(pe);
+    next_pe = EPHEMERONNEXT(pe);
+    EPHEMERONNEXT(pe) = Sfalse;
+    pe = next_pe;
   }
 }
diff --git a/mats/4.ms b/mats/4.ms
index 8fb991984..43d0d22e6 100644
--- a/mats/4.ms
+++ b/mats/4.ms
@@ -3964,6 +3964,19 @@
                    ;; Check that the GC update the reference to `key2` in `e`:
                    (eq? (car e) key2))))))))
 
+   ;; ----------------------------------------
+   ;; Check mutation two generations back and interaction with collection
+   (or (equal? (current-eval) interpret)
+       (equal? (with-interrupts-disabled
+                (let ([pr (ephemeron-cons 1 2)])
+                  (collect 0)
+                  (collect 1) ; puts `pr` in gen 2
+                  (let ([tl (list 1 2 3)])
+                    (set-car! pr tl) ; gen 2 reference to gen 0
+                    (collect 1 1 2)
+                    pr)))
+               '(#!bwp . #!bwp)))
+
    ;; ----------------------------------------
    ;; Check fasl:
    (let ([s (gensym)])
diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
index 34452a185..20841446d 100644
--- a/release_notes/release_notes.stex
+++ b/release_notes/release_notes.stex
@@ -1966,6 +1966,11 @@ The size of these string and bytevector buffers was previously hardcoded at 1024
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{Garbage collector incorrectly handles emphemerons (9.6.0)}
+
+A bug where the garbage collector sometimes incorrectly handles epehemeron pairs has
+been fixed.
+
 \subsection{Garbage collector incorrectly handles mutated weak pairs (9.6.0)}
 
 A bug where the garbage collector sometimes incorrectly handles mutated weak pairs has