Here is one cut at opportunistically collecting the world. it's not very good.

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

mps/code/global.c

@@ -183,6 +183,12 @@ Bool GlobalsCheck(Globals arenaGlobals)
     CHECKL(RingCheck(&arena->greyRing[rank]));
   CHECKL(RingCheck(&arena->chainRing));
 
+  CHECKL(arena->tracedSize >= 0.0);
+  CHECKL(arena->tracedTime >= 0.0);
+  CHECKL(arena->savedStepTime >= 0.0);
+  CHECKL(arena->lastStep >= 0);
+  CHECKL(arena->lastCollected >= 0);
+
   /* can't write a check for arena->epoch */
 
   /* check that each history entry is a subset of the next oldest */
@@ -261,6 +267,11 @@ Res GlobalsInit(Globals arenaGlobals)
   arena->finalPool = NULL;
   arena->busyTraces = TraceSetEMPTY;    /* <code/trace.c> */
   arena->flippedTraces = TraceSetEMPTY; /* <code/trace.c> */
+  arena->tracedSize = 0.0;
+  arena->tracedTime = 0.0;
+  arena->savedStepTime = 0.0;
+  arena->lastStep = mps_clock();
+  arena->lastCollected = mps_clock();
   arena->insideShield = FALSE;          /* <code/shield.c> */
   arena->shCacheI = (Size)0;
   arena->shCacheLimit = (Size)1;
@@ -269,7 +280,7 @@ Res GlobalsInit(Globals arenaGlobals)
   for(i = 0; i < ShieldCacheSIZE; i++)
     arena->shCache[i] = NULL;
 
-  for (i=0; i < TraceLIMIT; i++) {
+ for (i=0; i < TraceLIMIT; i++) {
     /* <design/arena/#trace.invalid> */
     arena->trace[i].sig = SigInvalid;
   }
@@ -556,27 +567,92 @@ void ArenaPoll(Globals globals)
 Bool ArenaStep(Globals globals, double interval)
 {
   double size;
-  Bool b, stepped;
-  Word start;
-  Word end;
+  Size scanned;
+  Bool stepped;
+  Word start, end, now;
+  Word clocks_per_sec;
+  Arena arena;
 
   AVERT(Globals, globals);
   AVER(interval >= 0.0);
 
-  interval = interval * mps_clocks_per_sec();
-  start = mps_clock();
-  end = start + interval;
-  
+  arena = GlobalsArena(globals);
+  clocks_per_sec = mps_clocks_per_sec();
 
+  start = mps_clock();
+  end = start + interval * clocks_per_sec;
   AVER(end >= start);
 
   stepped = FALSE;
+
   /* loop while there is work to do and time on the clock. */
   do {
-    b = TracePoll(globals);
-    if (b)
+    scanned = TracePoll(globals);
+    now = mps_clock();
+    if (scanned > 0) {
       stepped = TRUE;
-  } while (b && mps_clock() < end);
+      arena->tracedSize += scanned;
+    }
+  } while ((scanned > 0) && (now < end));
+
+  if (stepped) {
+    arena->tracedTime += (now - start) / (double) clocks_per_sec;
+    arena->savedStepTime = 0.0;
+    arena->lastStep = now;
+  } else if (interval > 0.0) {
+    /* All the CPU time since we last took a sensible step has been
+     * spent in the mutator.  If this is large, the mutator is busy
+     * and doing an opportunistic collect-world is not a good idea.
+     * But if it is small, and we have accumulated a lot of step time
+     * since then, then the mutator is offering us a lot of time in
+     * comparison to the amount of time it is taking, and can be
+     * considered idle for our purposes.
+     *
+     * Here 'large' and 'small' can be assessed by comparing amounts
+     * of time to the amount of time it would take to scan the arena.
+     *
+     * The problem here is spotting when we are idle.  Suppose that
+     * the mutator was busy a while ago, and there was a collection: a
+     * non-trivial step.  Then the mutator continued for a while but
+     * then went idle.  The continuing calls to mps_arena_step()
+     * continue to save up time but it never looks as if the mutator
+     * is really idle.
+     *
+     * So we need a better heuristic.  If we save up enough time, we
+     * can probably kick off a collection anyway, regardless of
+     * apparent mutator busyness.
+     */
+    double scanRate;
+    Size arenaSize;
+    double arenaScanTime;
+    double sinceLastStep;
+
+    arena->savedStepTime += interval;
+
+    if ((arena->tracedSize > 1000000.0) &&
+        (arena->tracedTime > 1.0))
+      scanRate = arena->tracedSize / arena->tracedTime;
+    else
+      scanRate = 25000000.0; /* a reasonable default. */
+
+    arenaSize = ArenaCommitted(arena) - ArenaSpareCommitted(arena);
+    arenaScanTime = arenaSize / scanRate;
+    if (arenaScanTime < 1.0)
+      arenaScanTime = 1.0;     /* clamp below to avoid being too eager */
+    sinceLastStep = (now - arena->lastStep) / (double) clocks_per_sec;
+    if ((arena->lastStep > arena->lastCollected) &&
+        ((arena->savedStepTime > arenaScanTime * 4.0) ||
+         ((arena->savedStepTime > arenaScanTime) &&
+          ((sinceLastStep < arenaScanTime / 10.0))))) {
+      /* either we've accumulated masses of step time since the last
+       * step, or the mutator seems idle and we've accumulated quite a
+       * bit. */
+      ArenaStartCollect(globals);
+      arena->savedStepTime = 0.0;
+      arena->lastStep = now;
+      arena->lastCollected = now;
+    }
+  }
 
   size = globals->fillMutatorSize;
   globals->pollThreshold = size + ArenaPollALLOCTIME;

mps/code/mpm.h

@@ -356,7 +356,7 @@ extern void TraceDestroy(Trace trace);
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
 extern void TraceStart(Trace trace, double mortality, double finishingTime);
-extern Bool TracePoll(Globals globals);
+extern Size TracePoll(Globals globals);
 
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
 extern Res TraceFix(ScanState ss, Ref *refIO);

mps/code/mpmst.h

@@ -504,11 +504,11 @@ typedef struct TraceStruct {
   STATISTIC_DECL(Count greySegCount); /* number of grey segs */
   STATISTIC_DECL(Count greySegMax); /* max number of grey segs */
   STATISTIC_DECL(Count rootScanCount); /* number of roots scanned */
-  STATISTIC_DECL(Count rootScanSize); /* total size of scanned roots */
-  STATISTIC_DECL(Size rootCopiedSize); /* bytes copied by scanning roots */
+  Count rootScanSize;           /* total size of scanned roots */
+  Size rootCopiedSize;          /* bytes copied by scanning roots */
   STATISTIC_DECL(Count segScanCount); /* number of segs scanned */
   Count segScanSize;            /* total size of scanned segments */
-  STATISTIC_DECL(Size segCopiedSize); /* bytes copied by scanning segments */
+  Size segCopiedSize;           /* bytes copied by scanning segments */
   STATISTIC_DECL(Count singleScanCount); /* number of single refs scanned */
   STATISTIC_DECL(Count singleScanSize); /* total size of single refs scanned */
   STATISTIC_DECL(Size singleCopiedSize); /* bytes copied by scanning single refs */
@@ -673,6 +673,14 @@ typedef struct ArenaStruct {
   TraceSet flippedTraces;       /* set of running and flipped traces */
   TraceStruct trace[TraceLIMIT]; /* trace structures.  See
                                    <design/trace/#intance.limit> */
+
+  /* policy fields */
+  double tracedSize;
+  double tracedTime;
+  double savedStepTime;
+  Word lastStep;
+  Word lastCollected;
+
   RingStruct greyRing[RankLIMIT]; /* ring of grey segments at each rank */
   STATISTIC_DECL(Count writeBarrierHitCount); /* write barrier hits */
   RingStruct chainRing;         /* ring of chains */

mps/code/steptest.c

@@ -25,6 +25,8 @@
 #define ambigRootsCOUNT   50
 #define objCOUNT          2000000
 #define clockSetFREQ      10000
+#define multiStepFREQ     500000
+#define multiStepSTEPS    100
 
 #define genCOUNT          3
 #define gen1SIZE          750  /* kB */
@@ -298,7 +300,8 @@ static void *test(void *arg, size_t s)
     mps_fmt_t format;
     mps_chain_t chain;
     mps_root_t exactRoot, ambigRoot;
-    unsigned long objs; size_t i;
+    unsigned long objs;
+    size_t i, j;
     mps_message_t message;
     size_t live, condemned, not_condemned;
     size_t messages;
@@ -375,6 +378,10 @@ static void *test(void *arg, size_t s)
         if (objs % step_frequencies[test_number] == 0)
             test_step(arena);
 
+        if (objs % multiStepFREQ == 0)
+            for (j=0; j<multiStepSTEPS; ++j)
+                test_step(arena);
+
         if (objs % clockSetFREQ == 0)
             set_clock_timing();
 

mps/code/trace.c

@@ -273,14 +273,14 @@ static void traceUpdateCounts(Trace trace, ScanState ss,
 {
   switch(phase) {
   case traceAccountingPhaseRootScan:
-    STATISTIC(trace->rootScanSize += ss->scannedSize);
-    STATISTIC(trace->rootCopiedSize += ss->copiedSize);
+    trace->rootScanSize += ss->scannedSize;
+    trace->rootCopiedSize += ss->copiedSize;
     STATISTIC(++trace->rootScanCount);
     break;
 
   case traceAccountingPhaseSegScan:
     trace->segScanSize += ss->scannedSize; /* see .workclock */
-    STATISTIC(trace->segCopiedSize += ss->copiedSize);
+    trace->segCopiedSize += ss->copiedSize;
     STATISTIC(++trace->segScanCount);
     break;
 
@@ -657,11 +657,11 @@ found:
   STATISTIC(trace->greySegCount = (Count)0);
   STATISTIC(trace->greySegMax = (Count)0);
   STATISTIC(trace->rootScanCount = (Count)0);
-  STATISTIC(trace->rootScanSize = (Size)0);
-  STATISTIC(trace->rootCopiedSize = (Size)0);
+  trace->rootScanSize = (Size)0;
+  trace->rootCopiedSize = (Size)0;
   STATISTIC(trace->segScanCount = (Count)0);
   trace->segScanSize = (Size)0; /* see .workclock */
-  STATISTIC(trace->segCopiedSize = (Size)0);
+  trace->segCopiedSize = (Size)0;
   STATISTIC(trace->singleScanCount = (Count)0);
   STATISTIC(trace->singleScanSize = (Size)0);
   STATISTIC(trace->singleCopiedSize = (Size)0);
@@ -1467,9 +1467,9 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
 
 /* traceWorkClock -- a measure of the work done for this trace
  *
- * .workclock: Segment scanning work is the regulator.  */
+ * .workclock: Segment and root scanning work is the regulator.  */
 
-#define traceWorkClock(trace) (trace)->segScanSize
+#define traceWorkClock(trace) ((trace)->segScanSize + (trace)->rootScanSize)
 
 
 /* traceQuantum -- progresses a trace by one quantum */
@@ -1541,16 +1541,17 @@ failCondemn:
 
 /* TracePoll -- Check if there's any tracing work to be done */
 
-Bool TracePoll(Globals globals)
+Size TracePoll(Globals globals)
 {
   Trace trace;
   Res res;
   Arena arena;
-  Bool done = FALSE;
+  Size scannedSize;
 
   AVERT(Globals, globals);
   arena = GlobalsArena(globals);
 
+  scannedSize = (Size)0;
   if (arena->busyTraces == TraceSetEMPTY) {
     /* If no traces are going on, see if we need to start one. */
     Size sFoundation, sCondemned, sSurvivors, sConsTrace;
@@ -1574,7 +1575,7 @@ Bool TracePoll(Globals globals)
       res = traceStartCollectAll(&trace, arena);
       if (res != ResOK)
         goto failStart;
-      done = TRUE;
+      scannedSize = traceWorkClock(trace);
     } else { /* Find the nursery most over its capacity. */
       Ring node, nextNode;
       double firstTime = 0.0;
@@ -1603,26 +1604,28 @@ Bool TracePoll(Globals globals)
         trace->chain = firstChain;
         ChainStartGC(firstChain, trace);
         TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
-        done = TRUE;
+        scannedSize = traceWorkClock(trace);
       }
     } /* (dynamicDeferral > 0.0) */
   } /* (arena->busyTraces == TraceSetEMPTY) */
 
   /* If there is a trace, do one quantum of work. */
   if (arena->busyTraces != TraceSetEMPTY) {
+    Size oldScanned;
     trace = ArenaTrace(arena, (TraceId)0);
     AVER(arena->busyTraces == TraceSetSingle(trace));
+    oldScanned = traceWorkClock(trace);
     traceQuantum(trace);
+    scannedSize = traceWorkClock(trace) - oldScanned;
     if (trace->state == TraceFINISHED)
       TraceDestroy(trace);
-    done = TRUE;
   }
-  return done;
+  return scannedSize;
 
 failCondemn:
   TraceDestroy(trace);
 failStart:
-  return FALSE;
+  return (Size)0;
 }