From e82d034c98dcbbffe37c26e138eb8c461b0a358a Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Sat, 20 Mar 2010 13:51:23 +0000
Subject: [PATCH] Mps br/vmem: prepare for simple-chunk-return:

arenavm.c: VMFree is okay for testing chunk-ret; though just sparePagesPurge() for now;
  diag.c: show what we want for using zcoll to show chunk-ret:
    VM_ix_Create/Destroy
    TraceStart, excpet only briefly for dyn-crit (why=2) and not at all for minor
  locus.c: no newline on "condemn gens" diag please
  tract.c: ChunkDecache is BROKEN; just add AVER to catch this for now
  vmix.c: VM_ix_Create_ok/VM_ix_Destroy (vmw3.c needs similar)
  zcoll.c:
    release after mps_arena_collect!!!
    make, collect, make, collect, to show chunk-ret
    10MB arena means many chunks
None of this is releaseable quality of course.

Copied from Perforce
 Change: 170071
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenavm.c | 10 ++++++++++
 mps/code/diag.c    | 14 ++++++++++++--
 mps/code/locus.c   |  2 +-
 mps/code/tract.c   |  5 +++++
 mps/code/vmix.c    | 11 +++++++++++
 mps/code/zcoll.c   |  9 +++++++--
 6 files changed, 46 insertions(+), 5 deletions(-)

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 506fac2c678..56cb6a977ab 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -1613,6 +1613,16 @@ static void VMFree(Addr base, Size size, Pool pool)
   }
   /* @@@@ Chunks are never freed. */
 
+  /* ... oh yes they are */
+  sparePagesPurge(vmArena);
+#if 0
+  /* destroy any empty chunks */
+  RING_FOR(node, &arena->chunkRing, next) {
+    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
+    vmChunkDestroy(chunk);
+  }
+#endif
+
   return;
 }
 
diff --git a/mps/code/diag.c b/mps/code/diag.c
index 643e4918792..f335270a5dc 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -28,10 +28,20 @@ typedef struct RuleStruct {
 /* RulesGlobal -- throw away some diags (see INSTRUCTIONS below) */
 
 struct RuleStruct RulesGlobal[] = {
-  { "-", "*", "*", "*" },
+  { "+", "*", "*", "*" },
   { "+", "DiagFilter_Rules", "*", "*" },
   { "-", "DIAGTEST_", "*", "*" },
-  { "+", "AMCTraceEnd_pageret", "*", "*" },
+  { "-", "AMCTraceEnd_pageret", "*", "*" },
+  { "+", "VM_ix_", "*", "*" },
+  { "-", "vmArenaExtend_", "*", "*" },
+  { "-", "traceFindGrey", "*", "*" },
+  { "+", "TraceStart", "*", "*" },
+  { "-", "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_", "*", "*" },
   /* ----v---- always on please (RHSK) ----v---- */
   { "+", "traceSetSignalEmergency", "*", "*" },
   { NULL, "", "", "" }
diff --git a/mps/code/locus.c b/mps/code/locus.c
index c426e5a4b3d..2c94d0f71b3 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -298,7 +298,7 @@ Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace)
   DIAG_SINGLEF(( "ChainCondemnAuto",
     "condemn gens [0..$U]", topCondemnedGenSerial,
     " (of $U)", chain->genCount,
-    " of this chain $P.\n", (void*)chain,
+    " of this chain $P.", (void*)chain,
     NULL ));
 
   /* Condemn everything in these zones. */
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 7f8f58e788b..66900ded163 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -206,6 +206,10 @@ Res ChunkInit(Chunk chunk, Arena arena,
   chunk->pageTable = pageTable = p;
 
   /* @@@@ Is BootAllocated always right? */
+  /* Last thing we BootAlloc'd is pageTable.  We requested pageSize */
+  /* alignment, and pageTableSize is itself pageSize aligned, so */
+  /* BootAllocated should also be pageSize aligned. */
+  AVER(AddrIsAligned(BootAllocated(boot), pageSize));
   chunk->allocBase = (Index)(BootAllocated(boot) >> pageShift);
 
   /* Init allocTable after class init, because it might be mapped there. */
@@ -320,6 +324,7 @@ Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
   /* check cache first */
   if (arena->chunkCache.base <= addr && addr < arena->chunkCache.limit) {
     *chunkReturn = arena->chunkCache.chunk;
+    AVER_CRITICAL(*chunkReturn != NULL);
     return TRUE;
   }
   RING_FOR(node, &arena->chunkRing, next) {
diff --git a/mps/code/vmix.c b/mps/code/vmix.c
index 948285d7ced..71f6354a32c 100644
--- a/mps/code/vmix.c
+++ b/mps/code/vmix.c
@@ -161,6 +161,11 @@ Res VMCreate(VM *vmReturn, Size size)
   AVERT(VM, vm);
 
   EVENT_PAA(VMCreate, vm, vm->base, vm->limit);
+  DIAG_SINGLEF((
+    "VM_ix_Create_ok",
+    "[$W..<$W>..$W)", 
+    vm->base, (char*)vm->limit - (char*)vm->base, vm->limit,
+    NULL ));
 
   *vmReturn = vm;
   return ResOK;
@@ -180,6 +185,12 @@ void VMDestroy(VM vm)
   AVERT(VM, vm);
   AVER(vm->mapped == (Size)0);
 
+  DIAG_SINGLEF((
+    "VM_ix_Destroy",
+    "[$W..<$W>..$W)", 
+    vm->base, (char*)vm->limit - (char*)vm->base, vm->limit,
+    NULL ));
+
   /* This appears to be pretty pointless, since the descriptor */
   /* page is about to vanish completely.  However, munmap might fail */
   /* for some reason, and this would ensure that it was still */
diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c
index 9bc9e931884..27a59c5dc24 100644
--- a/mps/code/zcoll.c
+++ b/mps/code/zcoll.c
@@ -472,6 +472,7 @@ static void testscriptC(mps_arena_t arena, mps_ap_t ap, const char *script)
         script += sb;
         printf("  Collect\n");
         mps_arena_collect(arena);
+        mps_arena_release(arena);
         break;
       }
       case 'K': {
@@ -705,8 +706,10 @@ int main(int argc, char **argv)
 
   /* 1<<19 == 524288 == 1/2 Mebibyte */
   /* This is bogus!  sizemethod 1 can make a 300,000-slot dylan vector, ie. 1.2MB. */
-  /* Try 100MB arena */
-  testscriptA("Arena(size 100000000), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect.");
+  /* 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.");
 
   /* LSP -- Large Segment Padding (job001811)
    *
@@ -737,10 +740,12 @@ int main(int argc, char **argv)
   /* 7p = 28672b; 8p = 32768b */
   /* 28000 = Medium segment */
   /* 29000 = Large segment */
+#if 0
   testscriptA("Arena(size 16777216), BigdropSmall(big 28000, small A), Collect.");
   testscriptA("Arena(size 16777216), BigdropSmall(big 29000, small A), Collect.");
   testscriptA("Arena(size 16777216), BigdropSmall(big 28000, small E), Collect.");
   testscriptA("Arena(size 16777216), BigdropSmall(big 29000, small E), Collect.");
+#endif
 
   /* 16<<20 == 16777216 == 16 Mebibyte */
   /* See .catalog.broken.