From 0d5340c061681c571c5b3d1c83ad97eb67addc3e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 1 May 2017 08:42:06 -0600
Subject: [PATCH] fix interaction of ephemerons and generations; use for weak
 hashtables

original commit: 6f7147e505aae5c2b9139eea6df8a9c25a35289d
---
 c/gc.c       | 46 +++++++++++++++++++++++++++++++++++++++++++++-
 s/library.ss |  4 ++--
 s/newhash.ss |  2 +-
 3 files changed, 48 insertions(+), 4 deletions(-)

diff --git a/c/gc.c b/c/gc.c
index e91013ab60..32456ba584 100644
--- a/c/gc.c
+++ b/c/gc.c
@@ -52,6 +52,7 @@ static void resweep_dirty_weak_pairs PROTO((void));
 static void add_ephemeron_to_pending PROTO((ptr p));
 static void add_trigger_ephemerons_to_repending PROTO((ptr p));
 static void check_pending_ephemerons PROTO(());
+static int check_dirty_ephemeron PROTO((ptr pe, int tg, int youngest));
 static void clear_trigger_ephemerons PROTO(());
 
 /* MAXPTR is used to pad the sorted_locked_object vector.  The pad value must be greater than any heap address */
@@ -1929,7 +1930,7 @@ static void sweep_dirty(void) {
                 } else if (s == space_ephemeron) {
                   while (pp < ppend && *pp != forward_marker) {
                     ptr p = TYPE((ptr)pp, type_pair);
-                    add_ephemeron_to_pending(p);
+                    youngest = check_dirty_ephemeron(p, tg, youngest);
                     pp += size_ephemeron / sizeof(ptr);
                   }
                 } else {
@@ -2100,6 +2101,49 @@ static void check_pending_ephemerons() {
   }
 }
 
+/* Like check_pending_ephemeron(), but for a dirty, old-generation
+   ephemeron (that was not yet added to the pending list), so we can
+   be less pessimistic than setting `youngest` to the target
+   generation: */
+static int check_dirty_ephemeron(ptr pe, int tg, int youngest) {
+  ptr p;
+  seginfo *si;
+
+  p = Scar(pe);
+  if (!IMMEDIATE(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL) {
+    if (si->space & space_old && !locked(p)) {
+      if (FWDMARKER(p) == forward_marker && TYPEBITS(p) != type_flonum) {
+        INITCAR(pe) = FWDADDRESS(p);
+        relocate(&INITCDR(pe))
+        youngest = tg;
+      } else {
+        /* Not reached, so far; install as trigger */
+        EPHEMERONTRIGGERNEXT(pe) = si->trigger_ephemerons;
+        si->trigger_ephemerons = pe;
+        EPHEMERONNEXT(pe) = trigger_ephemerons;
+        trigger_ephemerons = pe;
+        /* Make the consistent (but pessimistic w.r.t. to wrong-way
+           pointers) assumption that the key will stay live and move
+           to the target generation. That assumption covers the value
+           part, too, since it can't end up younger than the target
+           generation. */
+        youngest = tg;
+      }
+    } else {
+      int pg;
+      if ((pg = si->generation) < youngest)
+        youngest = pg;
+      relocate_dirty(&INITCDR(pe), tg, youngest)
+    }
+  } else {
+    /* Non-collectable key means that the value determines
+       `youngest`: */
+    relocate_dirty(&INITCDR(pe), tg, youngest)
+  }
+
+  return youngest;
+}
+
 static void clear_trigger_ephemerons() {
   ptr pe;
 
diff --git a/s/library.ss b/s/library.ss
index 9fb3a7eeaf..9ae9d5da2b 100644
--- a/s/library.ss
+++ b/s/library.ss
@@ -1435,7 +1435,7 @@
              [b (vector-ref vec idx)])
         (lookup-keyval x b
           values
-          (let ([keyval (if (eq-ht-weak? h) (weak-cons x v) (cons x v))])
+          (let ([keyval (if (eq-ht-weak? h) (ephemeron-cons x v) (cons x v))])
             (vector-set! vec idx ($make-tlc h keyval b))
             (incr-size! h vec)
             keyval))))
@@ -1451,7 +1451,7 @@
               (begin
                 (vector-set! vec idx
                   ($make-tlc h
-                    (if (eq-ht-weak? h) (weak-cons x v) (cons x v))
+                    (if (eq-ht-weak? h) (ephemeron-cons x v) (cons x v))
                     b))
                 (incr-size! h vec))))))
   
diff --git a/s/newhash.ss b/s/newhash.ss
index 9783af0988..0862ff4c19 100644
--- a/s/newhash.ss
+++ b/s/newhash.ss
@@ -1019,7 +1019,7 @@ Documentation notes:
                           b
                           ($make-tlc h2
                             (let* ([keyval ($tlc-keyval b)] [key (car keyval)] [val (cdr keyval)])
-                              (if weak?  (weak-cons key val) (cons key val)))
+                              (if weak?  (ephemeron-cons key val) (cons key val)))
                             (inner ($tlc-next b))))))
                   (outer (fx+ i 1)))))
           h2))))