Mps br/padding: more diagnostic for how padding survives a collection.

More diag:
  - new traceSetSignalEmergency;
  - new AMCFix_amcSegCreateNailboard and AMCHeaderFix_amcSegCreateNailboard
    (note: the other, unreported, route to becoming boarded is because of a (mutator) buffer);
  - in traces: show SegBase and zone;
   - in TraceStart: show genZoneSets;
   - in amcReclaimNailed: show cbpip and cbpad.
 zcoll.c:
   - sizemethod 1 to Make command: occasionally makes >1MiB objects;
   - declare root_table all MPS_RANK_AMBIG.

Copied from Perforce
 Change: 167726
 ServerID: perforce.ravenbrook.com

4 files changed, 93 insertions, 10 deletions

diff --git a/mps/code/diag.c b/mps/code/diag.c
index e98c264034c..fc56422d568 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -31,13 +31,18 @@ struct RuleStruct RulesGlobal[] = {
   { "+", "*", "*", "*" },
   { "-", "DIAGTEST_", "*", "*" },
   { "-", "*", "*", "*" },
+  { "+", "DiagFilter_Rules", "*", "*" },
   { "+", "AMCWhiten", "*", "*" },
+  { "+", "AMCFix_amcSegCreateNailboard", "*", "*" },
+  { "+", "AMCHeaderFix_amcSegCreateNailboard", "*", "*" },
   { "+", "AMCReclaim_Mobile", "*", "*" },
   { "+", "amcReclaimNailed", "*", "*" },
   { "+", "TraceStart", "*", "because code " },
   { "+", "TraceStart", "*", "reserved" },
   { "+", "TraceStart", "*", "committed" },
   { "+", "TraceStart", "*", "alignment" },
+  { "+", "TraceStart", "*", "genZoneSet" },
+  { "+", "traceSetSignalEmergency", "*", "*" },
   { NULL, "", "", "" }
 };
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index b56b548bf2b..c4c57149e96 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -1189,11 +1189,13 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
 {
   Res res;
   Size segSize;
+  Addr base;
   char abzSketch[5];
   char abzSketchAfter[5];
   Bool condemned;
   
   segSize = SegSize(seg);
+  base = SegBase(seg);
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
 
   AVER(!TraceSetIsMember(SegWhite(seg), trace)); /* from trace.c#start.black */
@@ -1206,6 +1208,7 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
   if(segSize >= bigseg)
     DIAG_SINGLEF(( "AMCWhiten",
       "  segSize: $W\n", segSize,
+      "  segBase: $A, zone: $U\n", (WriteFA)base, AddrZone(pool->arena, base),
       "  sketch: $S\n", abzSketch,
       "  sketchAfter: $S\n", abzSketchAfter,
       "  condemned?: $S", condemned ? "Condemned" : "not condemned",
@@ -1674,6 +1677,14 @@ Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
         return res;
       ++ss->nailCount;
       SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces));
+      if(SegSize(seg) >= bigseg) {
+        DIAG_SINGLEF(( "AMCFix_amcSegCreateNailboard",
+          "  segSize: $W\n", SegSize(seg),
+          "  segBase: $A, zone: $U\n", (WriteFA)SegBase(seg), AddrZone(pool->arena, SegBase(seg)),
+          "  ref: $A\n", (WriteFA)*refIO,
+          "  &ref: $A\n", (WriteFA)refIO,
+          NULL ));
+      }
     }
     amcFixInPlace(pool, seg, ss, refIO);
     return ResOK;
@@ -1824,6 +1835,11 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
         return res;
       ++ss->nailCount;
       SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces));
+      DIAG_SINGLEF(( "AMCHeaderFix_amcSegCreateNailboard",
+        "  segBase: $A, zone: $U\n", (WriteFA)SegBase(seg), AddrZone(pool->arena, SegBase(seg)),
+        "  ref: $A\n", (WriteFA)*refIO,
+        "  &ref: $A\n", (WriteFA)refIO,
+        NULL ));
     }
     amcFixInPlace(pool, seg, ss, refIO);
     return ResOK;
@@ -1928,7 +1944,37 @@ returnRes:
 
 static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
 {
+  /* Diagnostics for padding:
+   *
+   * Hopefully we're only interested in big segments: those that 
+   * are much bigger than MPS default segsize of 1 page (usually 4096 
+   * bytes).
+   *
+   * To avoid having to be stateful, we can simply emit diag for 
+   * trace start, and for each big seg we see in the trace.
+   *
+   * We want to:
+   *   - see the large amount of padding being created;
+   *   - know exactly how much padding was created
+   *     (to correlate -- or not -- with GR's printHeapSummary report);
+   *   - get an idea of size distribution;
+   *   - understand _why_ it had to be padded, not freed.
+   *
+   * But we may not see the padding being created: if not, we want to 
+   * know why not.  So clock the segments into the trace (Whiten) as 
+   * well as out of it (Reclaim).
+   *
+   * Why seg not freed?  Must have been non-mobile, and not freed 
+   * because of a nail on the start of an object.  (Which could be a 
+   * cli, pad, or fwd).
+   *  - Why is the seg nailed in the first place?  There was an ambig 
+   *    ref into it.
+   *  - Why was it not freed?  There was an ambig ref apparently to 
+   *    the start of an object on it.
+   */
+  
   Size segSize;
+  Addr base;
   char abzSketch[5];
   Count Npip = 0, Npad = 0;
   char cond[4];
@@ -1954,6 +2000,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
   AVERT(Arena, arena);
 
   segSize = SegSize(seg);
+  base = SegBase(seg);
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
 
   /* see <design/poolamc/#nailboard.limitations> for improvements */
@@ -2029,8 +2076,10 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
   if(segSize >= bigseg)
     DIAG_SINGLEF(( "amcReclaimNailed",
       "  segSize: $W\n", segSize,
+      "  segBase: $A, zone: $U\n", (WriteFA)base, AddrZone(arena, base),
       "  sketch: $S\n", abzSketch,
       "  Npip: $U, Npad: $U\n", Npip, Npad,
+      "  cbpip: $W, cbpad: $W\n", preservedInPlaceSize, bytesReclaimed,
       "  cond: $S (empty? buffered? nailed?)\n", cond,
       "  freed?: $S", freed ? "Freed" : "preserved",
       NULL ));
@@ -2044,6 +2093,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
 static void AMCReclaim(Pool pool, Trace trace, Seg seg)
 {
   Size segSize;
+  Addr base;
   char abzSketch[5];
 
   AMC amc;
@@ -2078,6 +2128,7 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg)
   }
   
   segSize = SegSize(seg);
+  base = SegBase(seg);
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
 
   /* We may not free a buffered seg.  (But all buffered + condemned */
@@ -2095,6 +2146,7 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg)
   if(segSize >= bigseg)
     DIAG_SINGLEF(( "AMCReclaim_Mobile",
       "  segSize: $W\n", segSize,
+      "  segBase: $A, zone: $U\n", (WriteFA)base, AddrZone(pool->arena, base),
       "  sketch: $S\n", abzSketch,
       "  Freed.",
       NULL ));
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 3958232dfec..1082eaefe78 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -308,6 +308,9 @@ static void traceSetSignalEmergency(TraceSet ts, Arena arena)
   TraceId ti;
   Trace trace;
 
+  DIAG_SINGLEF(( "traceSetSignalEmergency",
+    "traceSet: $B", ts, NULL ));
+
   TRACE_SET_ITER(ti, trace, ts, arena)
     trace->emergency = TRUE;
   TRACE_SET_ITER_END(ti, trace, ts, arena);
diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c
index 962e2135f70..ec587bafdbb 100644
--- a/mps/code/zcoll.c
+++ b/mps/code/zcoll.c
@@ -404,7 +404,7 @@ static void checksi(int si, int si_shouldBe, const char *script, const char *scr
 {
   if(si != si_shouldBe) {
     printf("bad script command %s (full script %s).\n", script, scriptAll);
-    cdie(FALSE, "unknown script command");
+    cdie(FALSE, "bad script command!");
   }
 }
 
@@ -442,19 +442,42 @@ static void testscriptC(mps_arena_t arena, mps_ap_t ap, const char *script)
         unsigned keepTotal = 0;
         unsigned keep1in = 0;
         unsigned keepRootspace = 0;
-        si = sscanf(script, "Make(keep-1-in %u, keep %u, rootspace %u)%n",
-                    &keep1in, &keepTotal, &keepRootspace, &sb);
-        checksi(si, 3, script, scriptAll);
+        unsigned sizemethod = 0;
+        si = sscanf(script, "Make(keep-1-in %u, keep %u, rootspace %u, sizemethod %u)%n",
+                    &keep1in, &keepTotal, &keepRootspace, &sizemethod, &sb);
+        checksi(si, 4, script, scriptAll);
         script += sb;
-        printf("  Make(keep-1-in %u, keep %u, rootspace %u).\n",
-               keep1in, keepTotal, keepRootspace);
+        printf("  Make(keep-1-in %u, keep %u, rootspace %u, sizemethod %u).\n",
+               keep1in, keepTotal, keepRootspace, sizemethod);
         
         Insist(keepRootspace <= myrootCOUNT);
 
         objCount = 0;
         while(keepCount < keepTotal) {
           mps_word_t v;
-          die(make_dylan_vector(&v, ap, 2), "make_dylan_vector");
+          unsigned slots = 2;  /* minimum */
+          switch(sizemethod) {
+            case 0: {
+              /* minimum */
+              slots = 2;
+              break;
+            }
+            case 1: {
+              slots = 2;
+              if(rnd() % 10000 == 0) {
+                printf("*");
+                slots = 300000;
+              }
+              break;
+            }
+            default: {
+              printf("bad script command %s (full script %s).\n", script, scriptAll);
+              printf(" -- sizemethod %u unknown.\n", sizemethod);
+              cdie(FALSE, "bad script command!");
+              break;
+            }
+          }
+          die(make_dylan_vector(&v, ap, slots), "make_dylan_vector");
           DYLAN_VECTOR_SLOT(v, 0) = DYLAN_INT(objCount);
           DYLAN_VECTOR_SLOT(v, 1) = (mps_word_t)NULL;
           objCount++;
@@ -482,7 +505,7 @@ static void testscriptC(mps_arena_t arena, mps_ap_t ap, const char *script)
       default: {
         printf("unknown script command %c (script %s).\n",
                *script, scriptAll);
-        cdie(FALSE, "unknown script command");
+        cdie(FALSE, "unknown script command!");
         return;
       }
     }
@@ -532,7 +555,7 @@ static void *testscriptB(void *arg, size_t s)
   for(i = 0; i < myrootCOUNT; ++i) {
     myroot[i] = NULL;
   }
-  die(mps_root_create_table(&root_table, arena, MPS_RANK_EXACT, (mps_rm_t)0,
+  die(mps_root_create_table(&root_table, arena, MPS_RANK_AMBIG, (mps_rm_t)0,
                             myroot, (size_t)myrootCOUNT),
       "root_create");
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create");
@@ -612,7 +635,7 @@ int main(int argc, char **argv)
   /* The most basic scripts */
 
   /* 1<<19 == 524288 == 1/2 Mebibyte */
-  testscriptA("Arena(size 524288), Make(keep-1-in 5, keep 50000, rootspace 30000), Collect.");
+  testscriptA("Arena(size 524288), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect.");
 
   /* 16<<20 == 16777216 == 16 Mebibyte */
   /* See .catalog.broken.