4 files changed, 101 insertions, 19 deletions

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 3fab5f4d547..399145f3629 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -1619,18 +1619,44 @@ static void VMFree(Addr base, Size size, Pool pool)
   return;
 }
 
+
+/* M_whole, M_frac -- print count of bytes as Megabytes
+ *
+ * Split into a whole number of MB, "m" for the decimal point, and 
+ * then the decimal fraction (thousandths of a MB, ie. kB).
+ *
+ * Input:                208896
+ * Output:  (Megabytes)  0m209
+ */
+#define bPerM (1000000UL)  /* Megabytes */
+#define bThou (1000UL)
+DIAG_DECL(
+static Count M_whole(size_t bytes)
+{
+  size_t M;  /* MBs */
+  M = (bytes + (bThou / 2)) / bPerM;
+  return M;
+}
+static Count M_frac(size_t bytes)
+{
+  Count Mthou;  /* thousandths of a MB */
+  Mthou = (bytes + (bThou / 2)) / bThou;
+  Mthou = Mthou % 1000;
+  return Mthou;
+}
+)
+
+
 static void VMCompact(Arena arena, Trace trace)
 {
   VMArena vmArena;
   Ring node, next;
   DIAG_DECL( Size vmem1; )
-  DIAG_DECL( Size vmem2; )
-  DIAG_DECL( Size vmemD; )
   DIAG_DECL( Count count; )
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
-  UNUSED(trace);  /* it's there for better diag; not used yet */
+  AVERT(Trace, trace);
 
   /* Destroy any empty chunks (except the primary). */
   sparePagesPurge(vmArena);
@@ -1638,6 +1664,7 @@ static void VMCompact(Arena arena, Trace trace)
     vmem1 = VMArenaReserved(arena);
     count = 0;
   );
+
   RING_FOR(node, &arena->chunkRing, next) {
     Chunk chunk = RING_ELT(Chunk, chunkRing, node);
     if(chunk != arena->primary
@@ -1646,17 +1673,30 @@ static void VMCompact(Arena arena, Trace trace)
       DIAG( count += 1; );
     }
   }
+
   DIAG(
-    vmem2 = VMArenaReserved(arena);
-    vmemD = vmem1 - vmem2;
+    Size vmem2 = VMArenaReserved(arena);
+    Size vmemD = vmem1 - vmem2;
+    Size live = trace->forwardedSize + trace->preservedInPlaceSize;
+    Size livePerc = live / (trace->condemned / 100);
     
-    if(vmemD != 0) {
+    if(vmemD != 0
+       || trace->why == TraceStartWhyCLIENTFULL_INCREMENTAL
+       || trace->why == TraceStartWhyCLIENTFULL_BLOCK) {
       DIAG_SINGLEF(( "VMCompact",
-        "vmem was $W, released $W, now $W", vmem1, vmemD, vmem2,
+        "vmem was $Um$3, ", M_whole(vmem1), M_frac(vmem1),
+        "released $Um$3, ", M_whole(vmemD), M_frac(vmemD),
+        "now $Um$3", M_whole(vmem2), M_frac(vmem2),
+        " (why $U", trace->why,
+        ": $Um$3", M_whole(trace->condemned), M_frac(trace->condemned),
+        "[->$Um$3", M_whole(live), M_frac(live),
+        " $U%-live", livePerc,
+        " $Um$3-stuck]", M_whole(trace->preservedInPlaceSize), M_frac(trace->preservedInPlaceSize),
+        " ($Um$3-not)", M_whole(trace->notCondemned), M_frac(trace->notCondemned),
+        " )",
         NULL));
     }
   );
-  
 }
 
 mps_res_t mps_arena_vm_growth(mps_arena_t mps_arena,
diff --git a/mps/code/diag.c b/mps/code/diag.c
index ba3688157d8..479b0e4b92e 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -28,21 +28,32 @@ typedef struct RuleStruct {
 /* RulesGlobal -- throw away some diags (see INSTRUCTIONS below) */
 
 struct RuleStruct RulesGlobal[] = {
+  { "-", "*", "*", "*" },
+  { "+", "DiagFilter_Rules", "*", "*" },
+  { "+", "VMCompact", "*", "*" },
+  /* ----v---- always on please (RHSK) ----v---- */
+  { "+", "traceSetSignalEmergency", "*", "*" },
+  { NULL, "", "", "" }
+};
+
+struct RuleStruct RulesGlobal_RHSK[] = {
   { "+", "*", "*", "*" },
   { "+", "DiagFilter_Rules", "*", "*" },
   { "-", "DIAGTEST_", "*", "*" },
-  { "-", "AMCTraceEnd_pageret", "*", "*" },
+  { "+", "AMCTraceEnd_pageret", "*", "*" },
   { "-", "ChainCondemnAuto", "*", "*" },
   { "+", "VM_ix_", "*", "*" },
   { "-", "vmArenaExtend_", "*", "*" },
   { "-", "traceFindGrey", "*", "*" },
-  { "+", "TraceStart", "*", "*" },
+  { "-", "TraceStart", "*", "*" },
+  { "+", "TraceStart", "*", "controlPool" },
+  { "+", "TraceStart", "*", "reserved" },
+  { "+", "TraceStart", "*", "committed" },
+  { "+", "TraceStart", "*", "genZoneSet" },
   { "-", "TraceStart", "because code 1", "*" },
-  { "+", "TraceStart", "because code 2", "controlPool" },
-  { "+", "TraceStart", "because code 2", "reserved" },
-  { "+", "TraceStart", "because code 2", "committed" },
-  { "+", "TraceStart", "because code 2", "genZoneSet" },
-  { "+", "VM_ix_", "*", "*" },
+  { "+", "VMCompact", "*", "*" },
+  { "-", "VMCompact_hex", "*", "*" },
+  { "+", "VM_ix_Create", "*", "*" },
   /* ----v---- always on please (RHSK) ----v---- */
   { "+", "traceSetSignalEmergency", "*", "*" },
   { NULL, "", "", "" }
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 84c9fdc870b..a0d66350e7b 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -517,6 +517,12 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
             if (res != ResOK) return res;
           } break;
 
+          case '3': {                   /* decimal for thousandths */
+            WriteFU u = va_arg(args, WriteFU);
+            res = WriteWord(stream, (Word)u, 10, 3);
+            if (res != ResOK) return res;
+          } break;
+
           case 'B': {                   /* binary, see .writef.p */
             WriteFB b = va_arg(args, WriteFB);
             res = WriteWord(stream, (Word)b, 2, sizeof(WriteFB) * CHAR_BIT);
diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c
index aa2f5f9f26c..879a35eb29d 100644
--- a/mps/code/zcoll.c
+++ b/mps/code/zcoll.c
@@ -847,15 +847,31 @@ int main(int argc, char **argv)
   /* Try 10MB arena */
   /* testscriptA("Arena(size 10485760), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect."); */
   if(1) {
-    testscriptA("Arena(size 10485760), "
-                "ZRndStateSet(239185672), "
+    testscriptA("Arena(size 10000000), "
                 "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) {
+  if(1) {
+    testscriptA("Arena(size 4000000), "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect, "
+                "Rootdrop(rank E), StackScan(0), Collect, Collect, StackScan(1), "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect, "
+                "Rootdrop(rank E), Collect, Collect.");
+  }
+  if(1) {
+    testscriptA("Arena(size 4000000), "
+                "Make(random 1, keep-1-in 5, keep 10000, rootspace 30000, sizemethod 1), "
+                "Rootdrop(rank E), Collect, "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), "
+                "Rootdrop(rank E), Collect, "
+                "Make(random 1, keep-1-in 5, keep 100000, rootspace 30000, sizemethod 1), "
+                "Rootdrop(rank E), Collect, "
+                "Make(random 1, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), "
+                "Rootdrop(rank E), Collect.");
+  }
+  if(1) {
     testscriptA("Arena(size 10485760), "
                 "Make(random 0, keep-1-in 5, keep 50000, rootspace 30000, sizemethod 2), "
                 "Collect, "
@@ -864,6 +880,15 @@ int main(int argc, char **argv)
                 "Collect, "
                 "Rootdrop(rank E), Collect, 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.");
+  }
 
   /* LSP -- Large Segment Padding (job001811)
    *