mps br/vmem: simple-chunk-return:

zcoll.c:
 How to get rid of all the objects, so full collect really collects all automatic objects:
   - Rootdrop() helps, but we can still retain a 1.2MB object;
   - stackwipe() does not help much -- these unwanted ambig refs are being left on the stack by MPS code that runs between mps_arena_collect and the flip!
   - therefore StackScan(0/1) to destroy stack+reg root before full collect: it's the only way to be sure.

 Reproducibility:
   - give Make() a random? switch, acted on by df() = diversity function, to allow bypass of rnd();
   - ZRndStateSet, to set the seed for rnd()

 Output:
   - print_M: switchable Mebibytes or Megabytes (more useful, to be honest);
   - get(): don't report message times, it messes up diffs.

 testlib.c/h:
 Reproducibility:
   - fix rnd_state so a rnd_state getter is possible;
   - testlib.h += rnd_state_t, rnd_state(), rnd_state_set(), rnd_state_set_v2()

 trace.c: traceFindGrey diag: no newline please

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

4 files changed, 253 insertions, 45 deletions

diff --git a/mps/code/testlib.c b/mps/code/testlib.c
index 71cc05d330e..0bc8771f134 100644
--- a/mps/code/testlib.c
+++ b/mps/code/testlib.c
@@ -221,48 +221,100 @@ mps_addr_t rnd_addr(void)
 }
 
 
-/* randomize -- randomize the generator, or initialize to replay */
+/* randomize -- randomize the generator, or initialize to replay
+ *
+ * There have been 3 versions of the rnd-states reported by this 
+ * function:
+ *
+ * 1. before RHSK got his hands on rnd().  These seed values are not 
+ *    currently supported, but it might be easy to add support.
+ *
+ * 2. v2 states: the published "seed" (state) value was the seed 
+ *    *before* the 10 rnds to churn up and separate nearby values 
+ *    from time().  This is unfortunate: you can't write a rnd_state 
+ *    getter, because it would have to go 10 steps back in time.
+ *
+ * 3. v3 states: when autogenerated from time(), the published 
+ *    state is that *after* the 10 rnds.  Therefore you can get this 
+ *    easily, store it, re-use it, etc.
+ */
 
 void randomize(int argc, char **argv)
 {
+  int i;
   int n;
+  unsigned long seedt;
   unsigned long seed0;
-  int i;
 
   if (argc > 1) {
     n = sscanf(argv[1], "%lu", &seed0);
     Insist(n == 1);
-    printf("randomize(): resetting initial seed to: %lu.\n", seed0);
+    printf("randomize(): resetting initial state (v3) to: %lu.\n", seed0);
+    rnd_state_set(seed0);
   } else {
     /* time_t uses an arbitrary encoding, but hopefully the low order */
     /* 31 bits will have at least one bit changed from run to run. */
-    seed0 = 1 + time(NULL) % (R_m - 1);
-    printf("randomize(): choosing initial seed: %lu.\n", seed0);
+    seedt = 1 + time(NULL) % (R_m - 1);
+
+    /* The value returned by time() on some OSs may simply be a 
+     * count of seconds: therefore successive runs may start with 
+     * nearby seeds, possibly differing only by 1.  So the first value
+     * returned by rnd() may differ by only 48271.  It is conceivable 
+     * that some tests might be able to 'spot' this pattern (for 
+     * example: by using the first rnd() value, mod 100M and rounded 
+     * to multiple of 1024K, as arena size in bytes).
+     * 
+     * So to mix it up a bit, we do a few iterations now.  How many?  
+     * Very roughly, 48271^2 is of the same order as 2^31, so two 
+     * iterations would make the characteristic difference similar to 
+     * the period.  Hey, let's go wild and do 10.
+     */
+    rnd_state_set(seedt);
+    for(i = 0; i < 10; i += 1) {
+      (void)rnd();
+    }
+
+    seed0 = rnd_state();
+    printf("randomize(): choosing initial state (v3): %lu.\n", seed0);
+    rnd_state_set(seed0);
   }
+}
+
+unsigned long rnd_state(void)
+{
+  return seed;
+}
 
+void rnd_state_set(unsigned long seed0)
+{
   Insist(seed0 < R_m);
   Insist(seed0 != 0);
   seed = seed0;
 
   rnd_verify(0);
   Insist(seed == seed0);
+}
+
+/* rnd_state_set_2 -- legacy support for v2 rnd states
+ *
+ * In v2, the published "seed" (state) value was the seed *before* 
+ * the 10 rnds to churn up and separate nearby values from time().
+ *
+ * Set the seed, then convert it to a v3 state by doing those 10 rnds.
+ */
+void rnd_state_set_v2(unsigned long seed0_v2)
+{
+  int i;
+  unsigned long seed0;
 
-  /* The 'random' seed is taken from time(), which may simply be a 
-   * count of seconds: therefore successive runs may start with 
-   * nearby seeds, possibly differing only by 1.  So the first value
-   * returned by rnd() may differ by only 48271.  It is conceivable 
-   * that some tests might be able to 'spot' this pattern (for 
-   * example: by using the first rnd() value, mod 100M and rounded 
-   * to multiple of 1024K, as arena size in bytes).
-   * 
-   * So to mix it up a bit, we do a few iterations now.  How many?  
-   * Very roughly, 48271^2 is of the same order as 2^31, so two 
-   * iterations would make the characteristic difference similar to 
-   * the period.  Hey, let's go wild and do 10.
-   */
+  rnd_state_set(seed0_v2);
   for(i = 0; i < 10; i += 1) {
     (void)rnd();
   }
+
+  seed0 = rnd_state();
+  printf("rnd_state_set_v2(): seed0_v2 = %lu, converted to state_v3 = %lu.\n", seed0_v2, seed0);
+  rnd_state_set(seed0);
 }
 
 
diff --git a/mps/code/testlib.h b/mps/code/testlib.h
index cf40053c2d3..2a70fa81f58 100644
--- a/mps/code/testlib.h
+++ b/mps/code/testlib.h
@@ -138,10 +138,14 @@ extern void verror(const char *format, va_list args);
 
 /* rnd -- random number generator
  *
- * rnd() generates a sequence of integers in the range [1, 2^31-1].
+ * rnd() generates a sequence of integers in the range [1, 2^31-2].
  */
 
 extern unsigned long rnd(void);
+typedef unsigned long rnd_state_t;
+extern rnd_state_t rnd_state(void);
+extern void rnd_state_set(rnd_state_t state_v3);
+extern void rnd_state_set_v2(rnd_state_t seed0_v2);  /* legacy */
 
 
 /* rnd_verify() -- checks behaviour of rnd() */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index ff13b6180a9..b4b17c11b49 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -974,7 +974,7 @@ static void traceFindGrey_diag(Bool found, Rank rank)
     *report_lim++ = this;
     *report_lim++ = '\0';
     DIAG_SINGLEF(( "traceFindGrey",
-                   "rank sequence: $S\n",
+                   "rank sequence: $S",
                    (WriteFS)report_array,
                    NULL ));
   }
diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c
index 36a15188041..aa2f5f9f26c 100644
--- a/mps/code/zcoll.c
+++ b/mps/code/zcoll.c
@@ -87,6 +87,10 @@ static void *myrootAmbig[myrootAmbigCOUNT];
 #define myrootExactCOUNT 30000
 static void *myrootExact[myrootExactCOUNT];
 
+static mps_root_t root_stackreg;
+static void *stack_start;
+static mps_thr_t stack_thr;
+
 
 static unsigned long cols(size_t bytes)
 {
@@ -125,19 +129,28 @@ static void showStatsAscii(size_t notcon, size_t con, size_t live, size_t alimit
 }
 
 
-/* print_M -- print count of bytes as Mebibytes with decimal fraction 
+/* print_M -- print count of bytes as Mebibytes or Megabytes
+ *
+ * Print as a whole number, "m" for the decimal point, and 
+ * then the decimal fraction.
  *
- * Input:   208896
- * Output:  0m199
+ * Input:                208896
+ * Output:  (Mebibytes)  0m199
+ * Output:  (Megabytes)  0m209
  */
+#if 0
+#define bPerM (1UL << 20)  /* Mebibytes */
+#else
+#define bPerM (1000000UL)  /* Megabytes */
+#endif
 static void print_M(size_t bytes)
 {
-  size_t M;  /* Mebibytes */
-  double Mfrac;  /* fraction of a Mebibyte */
+  size_t M;  /* M thingies */
+  double Mfrac;  /* fraction of an M thingy */
 
-  M = bytes / (1UL<<20);
-  Mfrac = (double)(bytes % (1UL<<20));
-  Mfrac = (Mfrac / (1UL<<20));
+  M = bytes / bPerM;
+  Mfrac = (double)(bytes % bPerM);
+  Mfrac = (Mfrac / bPerM);
 
   printf("%1lum%03.f", M, Mfrac * 1000);
 }
@@ -165,6 +178,7 @@ static void showStatsText(size_t notcon, size_t con, size_t live)
 /* get -- get messages
  *
  */
+#define get_print_times 0
 static void get(mps_arena_t arena)
 {
   mps_message_type_t type;
@@ -183,8 +197,10 @@ static void get(mps_arena_t arena)
     switch(type) {
       case mps_message_type_gc_start(): {
         mclockBegin = mps_message_clock(arena, message);
+#if get_print_times
         printf("    %5lu: (%5lu)",
                mclockBegin, mclockBegin - mclockEnd);
+#endif
         printf("    Coll Begin                                     (%s)\n",
                mps_message_gc_start_why(arena, message));
         break;
@@ -198,8 +214,10 @@ static void get(mps_arena_t arena)
 
         mclockEnd = mps_message_clock(arena, message);
         
+#if get_print_times
         printf("    %5lu: (%5lu)",
                mclockEnd, mclockEnd - mclockBegin);
+#endif
         printf("    Coll End  ");
         showStatsText(notcon, con, live);
         if(rnd()==0) showStatsAscii(notcon, con, live, alimit);
@@ -444,7 +462,21 @@ static void BigdropSmall(mps_arena_t arena, mps_ap_t ap, size_t big, char small_
 }
 
 
-static void Make(mps_arena_t arena, mps_ap_t ap, unsigned keep1in, unsigned keepTotal, unsigned keepRootspace, unsigned sizemethod)
+/* df -- diversity function
+ *
+ * Either deterministic based on "number", or 'random' (ie. call rnd).
+ */
+
+static unsigned long df(unsigned randm, unsigned number)
+{
+  if(randm == 0) {
+    return number;
+  } else {
+    return rnd();
+  }
+}
+
+static void Make(mps_arena_t arena, mps_ap_t ap, unsigned randm, unsigned keep1in, unsigned keepTotal, unsigned keepRootspace, unsigned sizemethod)
 {
   unsigned keepCount = 0;
   unsigned long objCount = 0;
@@ -463,7 +495,15 @@ static void Make(mps_arena_t arena, mps_ap_t ap, unsigned keep1in, unsigned keep
       }
       case 1: {
         slots = 2;
-        if(rnd() % 10000 == 0) {
+        if(df(randm, objCount) % 10000 == 0) {
+          printf("*");
+          slots = 300000;
+        }
+        break;
+      }
+      case 2: {
+        slots = 2;
+        if(df(randm, objCount) % 6661 == 0) {  /* prime */
           printf("*");
           slots = 300000;
         }
@@ -479,9 +519,9 @@ static void Make(mps_arena_t arena, mps_ap_t ap, unsigned keep1in, unsigned keep
     DYLAN_VECTOR_SLOT(v, 0) = DYLAN_INT(objCount);
     DYLAN_VECTOR_SLOT(v, 1) = (mps_word_t)NULL;
     objCount++;
-    if(rnd() % keep1in == 0) {
+    if(df(randm, objCount) % keep1in == 0) {
       /* keep this one */
-      myrootExact[rnd() % keepRootspace] = (void*)v;
+      myrootExact[df(randm, keepCount) % keepRootspace] = (void*)v;
       keepCount++;
     }
     get(arena);
@@ -494,13 +534,76 @@ static void Make(mps_arena_t arena, mps_ap_t ap, unsigned keep1in, unsigned keep
 }
 
 
+static void Rootdrop(char rank_char)
+{
+  unsigned long i;
+  
+  if(rank_char == 'A') {
+    for(i = 0; i < myrootAmbigCOUNT; ++i) {
+      myrootAmbig[i] = NULL;
+    }
+  } else if(rank_char == 'E') {
+    for(i = 0; i < myrootExactCOUNT; ++i) {
+      myrootExact[i] = NULL;
+    }
+  } else {
+    cdie(0, "Rootdrop: rank must be 'A' or 'E'.\n");
+  }
+}
+
+
+#define stackwipedepth 50000
+static void stackwipe(void)
+{
+  unsigned iw;
+  unsigned long aw[stackwipedepth];
+  
+  /* http://xkcd.com/710/ */
+  /* I don't want my friends to stop calling; I just want the */
+  /* compiler to stop optimising away my code. */
+  
+  /* Do you ever get two even numbers next to each other?  Hmmmm :-) */
+  for(iw = 0; iw < stackwipedepth; iw++) {
+    if((iw & 1) == 0) {
+      aw[iw] = 1;
+    } else {
+      aw[iw] = 0;
+    }
+  }
+  for(iw = 1; iw < stackwipedepth; iw++) {
+    if(aw[iw - 1] + aw[iw] != 1) {
+      printf("Errrr....\n");
+      break;
+    }
+  }
+}
+
+
+static void StackScan(mps_arena_t arena, int on)
+{
+  if(on) {
+    Insist(root_stackreg == NULL);
+    die(mps_root_create_reg(&root_stackreg, arena,
+                            mps_rank_ambig(), (mps_rm_t)0, stack_thr,
+                            mps_stack_scan_ambig, stack_start, 0),
+        "root_stackreg");
+    Insist(root_stackreg != NULL);
+  } else {
+    Insist(root_stackreg != NULL);
+    mps_root_destroy(root_stackreg);
+    root_stackreg = NULL;
+    Insist(root_stackreg == NULL);
+  }
+}
+
+
 /* checksi -- check count of sscanf items is correct
  */
 
 static void checksi(int si, int si_shouldBe, const char *script, const char *scriptAll)
 {
   if(si != si_shouldBe) {
-    printf("bad script command %s (full script %s).\n", script, scriptAll);
+    printf("bad script command (sscanf found wrong number of params) %s (full script %s).\n", script, scriptAll);
     cdie(FALSE, "bad script command!");
   }
 }
@@ -521,6 +624,7 @@ static void testscriptC(mps_arena_t arena, mps_ap_t ap, const char *script)
         checksi(si, 0, script, scriptAll);
         script += sb;
         printf("  Collect\n");
+        stackwipe();
         mps_arena_collect(arena);
         mps_arena_release(arena);
         break;
@@ -546,17 +650,48 @@ static void testscriptC(mps_arena_t arena, mps_ap_t ap, const char *script)
         break;
       }
       case 'M': {
+        unsigned randm = 0;
         unsigned keep1in = 0;
         unsigned keepTotal = 0;
         unsigned keepRootspace = 0;
         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);
+        si = sscanf(script, "Make(random %u, keep-1-in %u, keep %u, rootspace %u, sizemethod %u)%n",
+                    &randm, &keep1in, &keepTotal, &keepRootspace, &sizemethod, &sb);
+        checksi(si, 5, script, scriptAll);
+        script += sb;
+        printf("  Make(random %u, keep-1-in %u, keep %u, rootspace %u, sizemethod %u).\n",
+               randm, keep1in, keepTotal, keepRootspace, sizemethod);
+        Make(arena, ap, randm, keep1in, keepTotal, keepRootspace, sizemethod);
+        break;
+      }
+      case 'R': {
+        char drop_ref = ' ';
+        si = sscanf(script, "Rootdrop(rank %c)%n",
+                       &drop_ref, &sb);
+        checksi(si, 1, script, scriptAll);
+        script += sb;
+        printf("  Rootdrop(rank %c)\n", drop_ref);
+        Rootdrop(drop_ref);
+        break;
+      }
+      case 'S': {
+        unsigned on = 0;
+        si = sscanf(script, "StackScan(%u)%n",
+                       &on, &sb);
+        checksi(si, 1, script, scriptAll);
         script += sb;
-        printf("  Make(keep-1-in %u, keep %u, rootspace %u, sizemethod %u).\n",
-               keep1in, keepTotal, keepRootspace, sizemethod);
-        Make(arena, ap, keep1in, keepTotal, keepRootspace, sizemethod);
+        printf("  StackScan(%u)\n", on);
+        StackScan(arena, on);
+        break;
+      }
+      case 'Z': {
+        unsigned long s0;
+        si = sscanf(script, "ZRndStateSet(%lu)%n",
+                       &s0, &sb);
+        checksi(si, 1, script, scriptAll);
+        script += sb;
+        printf("  ZRndStateSet(%lu)\n", s0);
+        rnd_state_set(s0);
         break;
       }
       case ' ':
@@ -603,7 +738,6 @@ static void *testscriptB(void *arg, size_t s)
   mps_root_t root_table_Ambig;
   mps_root_t root_table_Exact;
   mps_ap_t ap;
-  mps_root_t root_stackreg;
   void *stack_starts_here;  /* stack scanning starts here */
 
   Insist(s == sizeof(trampDataStruct));
@@ -634,9 +768,11 @@ static void *testscriptB(void *arg, size_t s)
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create");
   
   /* root_stackreg: stack & registers are ambiguous roots = mutator's workspace */
+  stack_start = &stack_starts_here;
+  stack_thr = thr;
   die(mps_root_create_reg(&root_stackreg, arena,
-                          mps_rank_ambig(), (mps_rm_t)0, thr,
-                          mps_stack_scan_ambig, &stack_starts_here, 0),
+                          mps_rank_ambig(), (mps_rm_t)0, stack_thr,
+                          mps_stack_scan_ambig, stack_start, 0),
       "root_stackreg");
 
 
@@ -701,8 +837,8 @@ static void testscriptA(const char *script)
  */
 int main(int argc, char **argv)
 {
-
   randomize(argc, argv);
+  
   /* 1<<19 == 524288 == 1/2 Mebibyte */
   /* 16<<20 == 16777216 == 16 Mebibyte */
 
@@ -710,8 +846,24 @@ int main(int argc, char **argv)
   /* This is bogus!  sizemethod 1 can make a 300,000-slot dylan vector, ie. 1.2MB. */
   /* Try 10MB arena */
   /* testscriptA("Arena(size 10485760), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect."); */
-  testscriptA("Arena(size 10485760), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect,"
-              "Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect.");
+  if(1) {
+    testscriptA("Arena(size 10485760), "
+                "ZRndStateSet(239185672), "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect, "
+                "Rootdrop(rank E), StackScan(0), Collect, Collect, StackScan(1), "
+                "ZRndStateSet(239185672), "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect, "
+                "Rootdrop(rank E), Collect, Collect.");
+  }
+  if(0) {
+    testscriptA("Arena(size 10485760), "
+                "Make(random 0, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 2), "
+                "Collect, "
+                "Rootdrop(rank E), Collect, Collect, "
+                "Make(random 0, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 2), "
+                "Collect, "
+                "Rootdrop(rank E), Collect, Collect.");
+  }
 
   /* LSP -- Large Segment Padding (job001811)
    *