From 74ff7d56bc0e39aa695fd1202e235cdbd7963f27 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 12 Feb 2010 14:16:53 +0000
Subject: [PATCH] Mps br/padding: make arenapoll do lots of tracepolls if
 required, to catch up after fillmutatorsize jumps by > 64kib (job002205)

Changes:
  - separate ArenaPoll and ArenaStep code paths;
  - simplify ArenaPoll;
  - loop calling TracePoll to catch-up;
  zcoll: 100MB is a more sensible arena size than 0.5 MB
Warning: barely "experimental" code quality, omitting the following necessities:
  - consideration of interactions with ArenaStep,
  - re-engineering of ArenaPoll and friends.

Copied from Perforce
 Change: 169814
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 32 ++++++++++++++++++++++++++++----
 mps/code/zcoll.c  |  4 +++-
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index 55bb5013a79..71a86d99659 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -649,19 +649,43 @@ void (ArenaPoll)(Globals globals)
 #else
 void ArenaPoll(Globals globals)
 {
-  double size;
+  Arena arena;
+  Clock start;
+  Size tracedSize;
+  Bool didSomeTraceWork = FALSE;
 
   AVERT(Globals, globals);
 
   if (globals->clamped)
     return;
-  size = globals->fillMutatorSize;
-  if (globals->insidePoll || size < globals->pollThreshold)
+  if (globals->insidePoll)
+    return;
+  if(globals->fillMutatorSize < globals->pollThreshold)
     return;
 
   globals->insidePoll = TRUE;
 
-  (void)ArenaStep(globals, 0.0, 0.0);
+  /* fillMutatorSize has advanced; call TracePoll enough to catch up. */
+  start = ClockNow();
+  arena = GlobalsArena(globals);
+  do {
+    tracedSize = TracePoll(globals);
+    if(tracedSize == 0)
+      break;
+
+    didSomeTraceWork = TRUE;
+    arena->tracedSize += tracedSize;
+
+    /* Increment pollThreshold; check: enough precision? */
+    AVER(globals->pollThreshold
+         < globals->pollThreshold + ArenaPollALLOCTIME);
+    globals->pollThreshold += ArenaPollALLOCTIME;
+  } while (tracedSize > 0
+           && globals->pollThreshold <= globals->fillMutatorSize);
+
+  if(didSomeTraceWork) {
+    arena->tracedTime += (ClockNow() - start) / (double) ClocksPerSec();
+  }
 
   globals->insidePoll = FALSE;
 }
diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c
index 373e60ec2c3..9bc9e931884 100644
--- a/mps/code/zcoll.c
+++ b/mps/code/zcoll.c
@@ -704,7 +704,9 @@ int main(int argc, char **argv)
   /* 16<<20 == 16777216 == 16 Mebibyte */
 
   /* 1<<19 == 524288 == 1/2 Mebibyte */
-  testscriptA("Arena(size 524288), Make(keep-1-in 5, keep 50000, rootspace 30000, sizemethod 1), Collect.");
+  /* 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.");
 
   /* LSP -- Large Segment Padding (job001811)
    *