A dev build's self-equality scan starts by bumping a stamp rather than clearing its table, so one large scan leaves later ones as cheap as their own size.

runtime/flan_dyn.c

@@ -2894,22 +2894,27 @@ flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc,
  * top. A release build keeps no guards, and takes the shortcut. */
 /* The containers one scan has already walked. A container reached twice —
  * shared, or holding itself — is walked once, so a scan is linear in what it
- * can reach rather than exponential, and a cycle ends. Cleared at the start
+ * can reach rather than exponential, and a cycle ends. Open addressing over
- * of each scan; open addressing over the object's address. */
+ * the object's address, each slot stamped with the scan that filled it. */
-static flan_obj **scan_seen;
+typedef struct { flan_obj *o; uint64_t stamp; } scan_slot;
+static scan_slot *scan_seen;
 static size_t     scan_cap, scan_n;
+/* The scan a slot was filled by. A slot from an earlier scan reads as empty,
+ * so starting a scan costs a counter bump rather than clearing a table that
+ * one large scan left large. */
+static uint64_t   scan_stamp;
 
 static int scan_first_visit(flan_obj *o) {
   size_t i, mask;
   if (scan_n * 2 >= scan_cap) {
     size_t ncap = scan_cap ? scan_cap * 2 : 64, j;
-    flan_obj **n = (flan_obj **)calloc(ncap, sizeof *n);
+    scan_slot *n = (scan_slot *)calloc(ncap, sizeof *n);
     if (n == NULL) return 0;   /* no room to remember: stop descending */
     for (j = 0; j < scan_cap; j++) {
       size_t k;
-      if (scan_seen[j] == NULL) continue;
+      if (scan_seen[j].stamp != scan_stamp) continue;
-      for (k = ((uintptr_t)scan_seen[j] >> 4) & (ncap - 1); n[k] != NULL;
+      for (k = ((uintptr_t)scan_seen[j].o >> 4) & (ncap - 1);
-           k = (k + 1) & (ncap - 1)) {}
+           n[k].stamp == scan_stamp; k = (k + 1) & (ncap - 1)) {}
       n[k] = scan_seen[j];
     }
     free(scan_seen);
@@ -2917,9 +2922,11 @@ static int scan_first_visit(flan_obj *o) {
     scan_cap = ncap;
   }
   mask = scan_cap - 1;
-  for (i = ((uintptr_t)o >> 4) & mask; scan_seen[i] != NULL; i = (i + 1) & mask)
+  for (i = ((uintptr_t)o >> 4) & mask; scan_seen[i].stamp == scan_stamp;
-    if (scan_seen[i] == o) return 0;
+       i = (i + 1) & mask)
-  scan_seen[i] = o;
+    if (scan_seen[i].o == o) return 0;
+  scan_seen[i].o = o;
+  scan_seen[i].stamp = scan_stamp;
   scan_n++;
   return 1;
 }
@@ -2947,10 +2954,8 @@ static int64_t views_guarded;
 
 static void stale_scan(flan_dyn v, int depth) {
   if (views_guarded == 0) return;
-  if (scan_n > 0) {
+  scan_stamp++;   /* never 0, which is what a fresh slot holds */
-    memset(scan_seen, 0, scan_cap * sizeof *scan_seen);
   scan_n = 0;
-  }
   stale_walk(v, depth);
 }
 

test/programs/dyn-view-any.flan

@@ -331,4 +331,17 @@
         (push c c)
         (println (= c c))
         0)
+      ;; One self-compare over 300000 containers, then twenty thousand
+      ;; small ones: a large scan must not make every later one pay for it.
+      (= n 26)
+      (let [a [(i64 1)]
+            k (keep a)
+            big (the dyn [])
+            small (the dyn [1])
+            hits (i64 0)]
+        (dotimes [i 300000] (push big (the dyn [i])))
+        (println (= big big))
+        (dotimes [i 20000] (when (= small small) (set hits (+ hits 1))))
+        (println hits)
+        0)
       :else (do (println "?") 1))))

test/test_acceptance.ml

@@ -5994,16 +5994,19 @@ level "1"
          each, so both answer in well under a second rather than in time
          exponential in the sharing, or never. *)
       List.iter
-        (fun mode ->
+        (fun (mode, want) ->
            let t0 = Unix.gettimeofday () in
            let code, text = run exe (Some mode) in
            let dt = Unix.gettimeofday () -. t0 in
-           if code <> 0 || text <> "true\n" || dt > 1.0 then begin
+           if code <> 0 || text <> want || dt > 1.0 then begin
              incr failures;
              Printf.printf "FAIL  %s\n        got: %S (exit %d) in %.2fs\n"
                (name (", self-equality, mode " ^ mode)) text code dt
            end)
-        [ "24"; "25" ];
+        [ ("24", "true\n"); ("25", "true\n");
+          (* And a scan that visited 300000 containers leaves nothing for
+             the next twenty thousand small ones to clear. *)
+          ("26", "true\n20000\n") ];
       (* The collector takes back what it charged for a view: a leak here
          once doubled the heap's trigger forever. *)
       let code, text = run exe (Some "11") in