From ed2c117138090aafad6c70f0a63ab4b42a670b8a Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 25 Aug 2015 19:28:43 +0100
Subject: [PATCH 01/16] Branching master to branch/2015-08-25/tradeoff.

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

From f1441b58d151ebb3960f328fa45ea9f7638e5185 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 2 Sep 2015 21:55:24 +0100
Subject: [PATCH 02/16] Don't start a trace unless there's work to do.

Copied from Perforce
 Change: 188204
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h      |  3 ++-
 mps/code/policy.c   |  2 +-
 mps/code/trace.c    | 31 +++++++++++++++++++++++++++----
 mps/code/traceanc.c |  2 +-
 mps/code/walk.c     |  2 +-
 5 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index a5ca0a5c300..21eb9d9f5ea 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -393,7 +393,8 @@ extern Bool TraceIdCheck(TraceId id);
 extern Bool TraceSetCheck(TraceSet ts);
 extern Bool TraceCheck(Trace trace);
 extern Res TraceCreate(Trace *traceReturn, Arena arena, int why);
-extern void TraceDestroy(Trace trace);
+extern void TraceDestroyInit(Trace trace);
+extern void TraceDestroyFinished(Trace trace);
 
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
diff --git a/mps/code/policy.c b/mps/code/policy.c
index 64611a31d11..1052c67f2dc 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -258,7 +258,7 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
   return FALSE;
 
 failCondemn:
-  TraceDestroy(trace);
+  TraceDestroyInit(trace);
   /* This is an unlikely case, but clear the emergency flag so the next attempt
      starts normally. */
   ArenaSetEmergency(arena, FALSE);
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 005cee87fb2..2896d1af8cb 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -158,6 +158,7 @@ Bool TraceCheck(Trace trace)
   /* Use trace->state to check more invariants. */
   switch(trace->state) {
     case TraceINIT:
+      CHECKL(!TraceSetIsMember(trace->arena->flippedTraces, trace));
       /* @@@@ What can be checked here? */
       break;
 
@@ -422,6 +423,9 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
     } while (SegNext(&seg, arena, seg));
   }
 
+  if (!haveWhiteSegs)
+    return ResFAIL;
+
   EVENT3(TraceCondemnZones, trace, condemnedSet, trace->white);
 
   /* The trace's white set must be a subset of the condemned set */
@@ -755,7 +759,22 @@ found:
 }
 
 
-/* TraceDestroy -- destroy a trace object
+/* TraceDestroyInit -- destroy a trace object in state INIT */
+
+void TraceDestroyInit(Trace trace)
+{
+  AVERT(Trace, trace);
+  AVER(trace->state == TraceINIT);
+  AVER(trace->condemned == 0);
+
+  EVENT1(TraceDestroy, trace);
+
+  trace->sig = SigInvalid;
+  trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace);
+}
+
+
+/* TraceDestroyFinished -- destroy a trace object in state FINISHED
  *
  * Finish and deallocate a Trace object, freeing up a TraceId.
  *
@@ -764,7 +783,7 @@ found:
  * etc. would need to be reset to black.  This also means the error
  * paths in this file don't work.  @@@@ */
 
-void TraceDestroy(Trace trace)
+void TraceDestroyFinished(Trace trace)
 {
   AVERT(Trace, trace);
   AVER(trace->state == TraceFINISHED);
@@ -1555,6 +1574,9 @@ static Res traceCondemnAll(Trace trace)
     }
   }
 
+  if (!haveWhiteSegs)
+    return ResFAIL;
+
   /* Notify all the chains. */
   RING_FOR(chainNode, &arena->chainRing, nextChainNode) {
     Chain chain = RING_ELT(Chain, chainRing, chainNode);
@@ -1630,6 +1652,7 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
   AVER(0.0 <= mortality);
   AVER(mortality <= 1.0);
   AVER(finishingTime >= 0.0);
+  AVER(trace->condemned > 0);
 
   arena = trace->arena;
   
@@ -1794,7 +1817,7 @@ failStart:
      if the assertion isn't hit, so drop through anyway. */
   NOTREACHED;
 failCondemn:
-  TraceDestroy(trace);
+  TraceDestroyInit(trace);
   /* We don't know how long it'll be before another collection.  Make sure
      the next one starts in normal mode. */
   ArenaSetEmergency(arena, FALSE);
@@ -1841,7 +1864,7 @@ Size TracePoll(Globals globals)
            && (ArenaEmergency(arena) || traceWorkClock(trace) < pollEnd));
   scannedSize = traceWorkClock(trace) - oldScannedSize;
   if (trace->state == TraceFINISHED) {
-    TraceDestroy(trace);
+    TraceDestroyFinished(trace);
     /* A trace finished, and hopefully reclaimed some memory, so clear any
      * emergency. */
     ArenaSetEmergency(arena, FALSE);
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index c57500c0b65..aef049ab230 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -583,7 +583,7 @@ void ArenaPark(Globals globals)
     TRACE_SET_ITER(ti, trace, arena->busyTraces, arena)
       TraceAdvance(trace);
       if(trace->state == TraceFINISHED) {
-        TraceDestroy(trace);
+        TraceDestroyFinished(trace);
       }
     TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena);
   }
diff --git a/mps/code/walk.c b/mps/code/walk.c
index 38278cce1ad..e4542359469 100644
--- a/mps/code/walk.c
+++ b/mps/code/walk.c
@@ -359,7 +359,7 @@ static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f,
   rootsStepClosureFinish(rsc);
   /* Make this trace look like any other finished trace. */
   trace->state = TraceFINISHED;
-  TraceDestroy(trace);
+  TraceDestroyFinished(trace);
   AVER(!ArenaEmergency(arena)); /* There was no allocation. */
 
   return res;

From 2979b99c64e884754baad8eddea152746023aa13 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 10:12:18 +0100
Subject: [PATCH 03/16] Aver that results of arenaavail, arenacollectable and
 arenascannable are non-negative.

Copied from Perforce
 Change: 188207
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 084a223f4a4..9dbcb2ebfc3 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -1335,6 +1335,7 @@ Size ArenaAvail(Arena arena)
      this information from the operating system.  It also depends on the
      arena class, of course. */
 
+  AVER(sSwap >= arena->committed);
   return sSwap - arena->committed + arena->spareCommitted;
 }
 
@@ -1344,7 +1345,7 @@ Size ArenaAvail(Arena arena)
 Size ArenaCollectable(Arena arena)
 {
   /* Conservative estimate -- see job003929. */
-  return ArenaCommitted(arena) - ArenaSpareCommitted(arena);
+  return ArenaScannable(arena);
 }
 
 
@@ -1353,7 +1354,10 @@ Size ArenaCollectable(Arena arena)
 Size ArenaScannable(Arena arena)
 {
   /* Conservative estimate -- see job003929. */
-  return ArenaCommitted(arena) - ArenaSpareCommitted(arena);
+  Size committed = ArenaCommitted(arena);
+  Size spareCommitted = ArenaSpareCommitted(arena);
+  AVER(committed >= spareCommitted);
+  return committed - spareCommitted;
 }
 
 

From 85595290d37ff9edce748517d5021202ac1fe982 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 11:50:28 +0100
Subject: [PATCH 04/16] Accumulate trace metrics in arenapark.

Copied from Perforce
 Change: 188208
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c   |  6 ++----
 mps/code/mpm.h      |  1 +
 mps/code/trace.c    | 20 +++++++++++++-------
 mps/code/traceanc.c |  4 ++++
 4 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index cd072951e87..d92d9b403a5 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -729,13 +729,12 @@ void (ArenaPoll)(Globals globals)
     tracedSize = TracePoll(globals);
     if (tracedSize > 0) {
       quanta += 1;
-      arena->tracedSize += tracedSize;
     }
   } while (PolicyPollAgain(arena, start, tracedSize));
 
   /* Don't count time spent checking for work, if there was no work to do. */
   if(quanta > 0) {
-    arena->tracedTime += (ClockNow() - start) / (double) ClocksPerSec();
+    ArenaAccumulateTime(arena, start);
   }
 
   AVER(!PolicyPoll(arena));
@@ -817,12 +816,11 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
     now = ClockNow();
     if (scanned > 0) {
       stepped = TRUE;
-      arena->tracedSize += scanned;
     }
   } while ((scanned > 0) && (now < end));
 
   if (stepped) {
-    arena->tracedTime += (now - start) / (double) clocks_per_sec;
+    ArenaAccumulateTime(arena, start);
   }
 
   return stepped;
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 21eb9d9f5ea..ba7e85f2f65 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -537,6 +537,7 @@ extern Bool ArenaGrainSizeCheck(Size size);
 #define AddrIsArenaGrain(addr, arena) AddrIsAligned(addr, ArenaGrainSize(arena))
 #define SizeArenaGrains(size, arena) SizeAlignUp(size, ArenaGrainSize(arena))
 #define SizeIsArenaGrains(size, arena) SizeIsAligned(size, ArenaGrainSize(arena))
+#define ArenaAccumulateTime(arena, start) ((arena)->tracedTime += (ClockNow() - (start)) / (double) ClocksPerSec())
 
 extern void ArenaEnterLock(Arena arena, Bool recursive);
 extern void ArenaLeaveLock(Arena arena, Bool recursive);
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 2896d1af8cb..9e7d880f2b6 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1737,14 +1737,23 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
 }
 
 
+/* traceWorkClock -- a measure of the work done for this trace
+ *
+ * .workclock: Segment and root scanning work is the regulator.  */
+
+#define traceWorkClock(trace) ((trace)->segScanSize + (trace)->rootScanSize)
+
+
 /* TraceAdvance -- progress a trace by one step */
 
 void TraceAdvance(Trace trace)
 {
   Arena arena;
+  Size oldWork, newWork;
 
   AVERT(Trace, trace);
   arena = trace->arena;
+  oldWork = traceWorkClock(trace);
 
   switch (trace->state) {
   case TraceUNFLIPPED:
@@ -1773,6 +1782,10 @@ void TraceAdvance(Trace trace)
     NOTREACHED;
     break;
   }
+
+  newWork = traceWorkClock(trace);
+  AVER(newWork >= oldWork);
+  arena->tracedSize += newWork - oldWork;
 }
 
 
@@ -1825,13 +1838,6 @@ failCondemn:
 }
 
 
-/* traceWorkClock -- a measure of the work done for this trace
- *
- * .workclock: Segment and root scanning work is the regulator.  */
-
-#define traceWorkClock(trace) ((trace)->segScanSize + (trace)->rootScanSize)
-
-
 /* TracePoll -- Check if there's any tracing work to be done
  *
  * Consider starting a trace if none is running; advance the running
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index aef049ab230..c3743b6dc29 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -572,11 +572,13 @@ void ArenaPark(Globals globals)
   TraceId ti;
   Trace trace;
   Arena arena;
+  Clock start;
 
   AVERT(Globals, globals);
   arena = GlobalsArena(globals);
 
   globals->clamped = TRUE;
+  start = ClockNow();
 
   while(arena->busyTraces != TraceSetEMPTY) {
     /* Advance all active traces. */
@@ -587,6 +589,8 @@ void ArenaPark(Globals globals)
       }
     TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena);
   }
+
+  ArenaAccumulateTime(arena, start);
   
   /* Clear any emergency flag so that the next collection starts normally.
      Any traces that have been finished may have reclaimed memory. */

From 7c83105da92460a6e69ae3e80675ec4fc8655fcf Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 11:54:55 +0100
Subject: [PATCH 05/16] Accumulate scannedsize in mrg pool.

Copied from Perforce
 Change: 188209
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmrg.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index f329b87f110..3bd3655a94c 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -620,6 +620,7 @@ static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg)
             MRGFinalize(arena, linkseg, i);
           }
         }
+        ss->scannedSize += sizeof *refPart;
       }
     }
   } TRACE_SCAN_END(ss);

From 61bae42d439a1196acce9a87414317c02b8b7590 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 13:01:55 +0100
Subject: [PATCH 06/16] Introduce new type work representing a measure of work
 done by the collector. use this systematically to make the code clearer.

Copied from Perforce
 Change: 188210
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h   |  5 +++--
 mps/code/eventdef.h |  6 +++---
 mps/code/global.c   | 20 +++++++++---------
 mps/code/mpm.h      |  4 ++--
 mps/code/mpmst.h    |  4 ++--
 mps/code/mpmtypes.h |  1 +
 mps/code/policy.c   | 11 +++++-----
 mps/code/trace.c    | 50 ++++++++++++++++++++++++---------------------
 mps/design/type.txt |  9 ++++++++
 9 files changed, 62 insertions(+), 48 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 1c1df84f751..cf39d861457 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -422,8 +422,9 @@
 #define ARENA_MINIMUM_COLLECTABLE_SIZE ((Size)1000000)
 
 /* ARENA_DEFAULT_COLLECTION_RATE is an estimate of the MPS's
- * collection rate (in bytes per second), for use in the case where
- * there isn't enough data to use a measured value. */
+ * collection rate (in work per second; see <design/type/#work>), for
+ * use in the case where there isn't enough data to use a measured
+ * value. */
 
 #define ARENA_DEFAULT_COLLECTION_RATE (25000000.0)
 
diff --git a/mps/code/eventdef.h b/mps/code/eventdef.h
index 081b45de7c2..225c21f5f65 100644
--- a/mps/code/eventdef.h
+++ b/mps/code/eventdef.h
@@ -36,7 +36,7 @@
  */
 
 #define EVENT_VERSION_MAJOR  ((unsigned)1)
-#define EVENT_VERSION_MEDIAN ((unsigned)4)
+#define EVENT_VERSION_MEDIAN ((unsigned)5)
 #define EVENT_VERSION_MINOR  ((unsigned)0)
 
 
@@ -447,7 +447,7 @@
   PARAM(X,  1, W, condemned) \
   PARAM(X,  2, W, notCondemned) \
   PARAM(X,  3, W, foundation) \
-  PARAM(X,  4, W, rate) \
+  PARAM(X,  4, W, quantumWork) \
   PARAM(X,  5, D, mortality) \
   PARAM(X,  6, D, finishingTime)
 
@@ -674,7 +674,7 @@
   PARAM(X,  4, W, notCondemned) /* collectible but not condemned bytes */ \
   PARAM(X,  5, W, foundation)   /* foundation size */ \
   PARAM(X,  6, W, white)        /* white reference set */ \
-  PARAM(X,  7, W, rate)         /* segs to scan per increment */
+  PARAM(X,  7, W, quantumWork)  /* work constituting a quantum */
 
 #define EVENT_VMCompact_PARAMS(PARAM, X) \
   PARAM(X,  0, W, vmem0)        /* pre-collection reserved size */ \
diff --git a/mps/code/global.c b/mps/code/global.c
index d92d9b403a5..d15e5cd0da7 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -189,7 +189,7 @@ Bool GlobalsCheck(Globals arenaGlobals)
     CHECKD_NOSIG(Ring, &arena->greyRing[rank]);
   CHECKD_NOSIG(Ring, &arena->chainRing);
 
-  CHECKL(arena->tracedSize >= 0.0);
+  CHECKL(arena->tracedWork >= 0.0);
   CHECKL(arena->tracedTime >= 0.0);
   /* no check for arena->lastWorldCollect (Clock) */
 
@@ -287,7 +287,7 @@ Res GlobalsInit(Globals arenaGlobals)
   arena->finalPool = NULL;
   arena->busyTraces = TraceSetEMPTY;    /* <code/trace.c> */
   arena->flippedTraces = TraceSetEMPTY; /* <code/trace.c> */
-  arena->tracedSize = 0.0;
+  arena->tracedWork = 0.0;
   arena->tracedTime = 0.0;
   arena->lastWorldCollect = ClockNow();
   arena->insideShield = FALSE;          /* <code/shield.c> */
@@ -705,7 +705,7 @@ void (ArenaPoll)(Globals globals)
   Arena arena;
   Clock start;
   Count quanta;
-  Size tracedSize;
+  Work tracedWork;
 
   AVERT(Globals, globals);
 
@@ -726,11 +726,11 @@ void (ArenaPoll)(Globals globals)
   EVENT3(ArenaPoll, arena, start, 0);
 
   do {
-    tracedSize = TracePoll(globals);
-    if (tracedSize > 0) {
+    tracedWork = TracePoll(globals);
+    if (tracedWork > 0) {
       quanta += 1;
     }
-  } while (PolicyPollAgain(arena, start, tracedSize));
+  } while (PolicyPollAgain(arena, start, tracedWork));
 
   /* Don't count time spent checking for work, if there was no work to do. */
   if(quanta > 0) {
@@ -779,7 +779,7 @@ static Bool arenaShouldCollectWorld(Arena arena,
 
 Bool ArenaStep(Globals globals, double interval, double multiplier)
 {
-  Size scanned;
+  Work work;
   Bool stepped;
   Clock start, end, now;
   Clock clocks_per_sec;
@@ -812,12 +812,12 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
 
   /* loop while there is work to do and time on the clock. */
   do {
-    scanned = TracePoll(globals);
+    work = TracePoll(globals);
     now = ClockNow();
-    if (scanned > 0) {
+    if (work > 0) {
       stepped = TRUE;
     }
-  } while ((scanned > 0) && (now < end));
+  } while ((work > 0) && (now < end));
 
   if (stepped) {
     ArenaAccumulateTime(arena, start);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index ba7e85f2f65..3e888ad28de 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -399,7 +399,7 @@ extern void TraceDestroyFinished(Trace trace);
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
 extern Res TraceStart(Trace trace, double mortality, double finishingTime);
-extern Size TracePoll(Globals globals);
+extern Work TracePoll(Globals globals);
 
 extern Rank TraceRankForAccess(Arena arena, Seg seg);
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
@@ -667,7 +667,7 @@ extern Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
 extern Bool PolicyStartTrace(Trace *traceReturn, Arena arena);
 extern double PolicyCollectionTime(Arena arena);
 extern Bool PolicyPoll(Arena arena);
-extern Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize);
+extern Bool PolicyPollAgain(Arena arena, Clock start, Work tracedWork);
 
 
 /* Locus interface */
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index ac5c12c1498..86b6ec94890 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -486,7 +486,7 @@ typedef struct TraceStruct {
   Size condemned;               /* condemned bytes */
   Size notCondemned;            /* collectable but not condemned */
   Size foundation;              /* initial grey set size */
-  Size rate;                    /* segs to scan per increment */
+  Work quantumWork;             /* collection work constituting a quantum */
   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 */
@@ -777,7 +777,7 @@ typedef struct mps_arena_s {
   TraceMessage tMessage[TraceLIMIT];  /* <design/message-gc/> */
 
   /* policy fields */
-  double tracedSize;
+  double tracedWork;
   double tracedTime;
   Clock lastWorldCollect;
 
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 3a494760cb6..c744fb41fb6 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -38,6 +38,7 @@ typedef Word Size;                      /* <design/type/#size> */
 typedef Word Count;                     /* <design/type/#count> */
 typedef Word Index;                     /* <design/type/#index> */
 typedef Word Align;                     /* <design/type/#align> */
+typedef Word Work;                      /* <design/type/#work> */
 typedef unsigned Shift;                 /* <design/type/#shift> */
 typedef unsigned Serial;                /* <design/type/#serial> */
 typedef Addr Ref;                       /* <design/type/#ref> */
diff --git a/mps/code/policy.c b/mps/code/policy.c
index 1052c67f2dc..ff570e4899b 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -280,9 +280,8 @@ double PolicyCollectionTime(Arena arena)
   collectableSize = ArenaCollectable(arena);
   /* The condition arena->tracedTime >= 1.0 ensures that the division
    * can't overflow. */
-  if (arena->tracedSize >= ARENA_MINIMUM_COLLECTABLE_SIZE
-      && arena->tracedTime >= 1.0)
-    collectionRate = arena->tracedSize / arena->tracedTime;
+  if (arena->tracedTime >= 1.0)
+    collectionRate = arena->tracedWork / arena->tracedTime;
   else
     collectionRate = ARENA_DEFAULT_COLLECTION_RATE;
   collectionTime = collectableSize / collectionRate;
@@ -313,10 +312,10 @@ Bool PolicyPoll(Arena arena)
  * should return to the mutator.
  *
  * start is the clock time when the MPS was entered.
- * tracedSize is the amount of work done by the last call to TracePoll.
+ * tracedWork is the amount of work done by the last call to TracePoll.
  */
 
-Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize)
+Bool PolicyPollAgain(Arena arena, Clock start, Work tracedWork)
 {
   Globals globals;
   double nextPollThreshold;
@@ -325,7 +324,7 @@ Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize)
   globals = ArenaGlobals(arena);
   UNUSED(start);
   
-  if (tracedSize == 0) {
+  if (tracedWork == 0) {
     /* No work was done.  Sleep until NOW + a bit. */
     nextPollThreshold = globals->fillMutatorSize + ArenaPollALLOCTIME;
   } else {
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 9e7d880f2b6..d34d953bf40 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -109,7 +109,7 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
   STATISTIC(ss->preservedInPlaceCount = (Count)0);
   ss->preservedInPlaceSize = (Size)0; /* see .message.data */
   STATISTIC(ss->copiedSize = (Size)0);
-  ss->scannedSize = (Size)0; /* see .workclock */
+  ss->scannedSize = (Size)0; /* see .work */
   ss->sig = ScanStateSig;
 
   AVERT(ScanState, ss);
@@ -277,7 +277,7 @@ static void traceUpdateCounts(Trace trace, ScanState ss,
       break;
     }
     case traceAccountingPhaseSegScan: {
-      trace->segScanSize += ss->scannedSize; /* see .workclock */
+      trace->segScanSize += ss->scannedSize; /* see .work */
       trace->segCopiedSize += ss->copiedSize;
       STATISTIC(++trace->segScanCount);
       break;
@@ -697,14 +697,14 @@ found:
   trace->condemned = (Size)0;   /* nothing condemned yet */
   trace->notCondemned = (Size)0;
   trace->foundation = (Size)0;  /* nothing grey yet */
-  trace->rate = (Size)0;        /* no scanning to be done yet */
+  trace->quantumWork = (Work)0; /* no work done yet */
   STATISTIC(trace->greySegCount = (Count)0);
   STATISTIC(trace->greySegMax = (Count)0);
   STATISTIC(trace->rootScanCount = (Count)0);
   trace->rootScanSize = (Size)0;
   trace->rootCopiedSize = (Size)0;
   STATISTIC(trace->segScanCount = (Count)0);
-  trace->segScanSize = (Size)0; /* see .workclock */
+  trace->segScanSize = (Size)0; /* see .work */
   trace->segCopiedSize = (Size)0;
   STATISTIC(trace->singleScanCount = (Count)0);
   STATISTIC(trace->singleScanSize = (Size)0);
@@ -1713,8 +1713,10 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
     /* integer, so try to make sure it fits. */
     if(nPolls >= (double)LONG_MAX)
       nPolls = (double)LONG_MAX;
-    /* rate equals scanning work per number of polls available */
-    trace->rate = (trace->foundation + sSurvivors) / (unsigned long)nPolls + 1;
+    /* One quantum of work equals scanning work divided by number of
+     * polls, plus one to ensure it's not zero. */
+    trace->quantumWork
+      = (trace->foundation + sSurvivors) / (unsigned long)nPolls + 1;
   }
 
   /* TODO: compute rate of scanning here. */
@@ -1722,11 +1724,11 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
   EVENT8(TraceStart, trace, mortality, finishingTime,
          trace->condemned, trace->notCondemned,
          trace->foundation, trace->white,
-         trace->rate);
+         trace->quantumWork);
 
   STATISTIC_STAT(EVENT7(TraceStatCondemn, trace,
                         trace->condemned, trace->notCondemned,
-                        trace->foundation, trace->rate,
+                        trace->foundation, trace->quantumWork,
                         mortality, finishingTime));
 
   trace->state = TraceUNFLIPPED;
@@ -1737,11 +1739,11 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
 }
 
 
-/* traceWorkClock -- a measure of the work done for this trace
+/* traceWork -- a measure of the work done for this trace
  *
- * .workclock: Segment and root scanning work is the regulator.  */
+ * .work: Segment and root scanning work is the measure.  */
 
-#define traceWorkClock(trace) ((trace)->segScanSize + (trace)->rootScanSize)
+#define traceWork(trace) ((Work)((trace)->segScanSize + (trace)->rootScanSize))
 
 
 /* TraceAdvance -- progress a trace by one step */
@@ -1749,11 +1751,11 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
 void TraceAdvance(Trace trace)
 {
   Arena arena;
-  Size oldWork, newWork;
+  Work oldWork, newWork;
 
   AVERT(Trace, trace);
   arena = trace->arena;
-  oldWork = traceWorkClock(trace);
+  oldWork = traceWork(trace);
 
   switch (trace->state) {
   case TraceUNFLIPPED:
@@ -1783,9 +1785,9 @@ void TraceAdvance(Trace trace)
     break;
   }
 
-  newWork = traceWorkClock(trace);
+  newWork = traceWork(trace);
   AVER(newWork >= oldWork);
-  arena->tracedSize += newWork - oldWork;
+  arena->tracedWork += newWork - oldWork;
 }
 
 
@@ -1844,11 +1846,11 @@ failCondemn:
  * trace (if any) by one quantum. Return a measure of the work done.
  */
 
-Size TracePoll(Globals globals)
+Work TracePoll(Globals globals)
 {
   Trace trace;
   Arena arena;
-  Size oldScannedSize, scannedSize, pollEnd;
+  Work oldWork, newWork, work, endWork;
 
   AVERT(Globals, globals);
   arena = GlobalsArena(globals);
@@ -1862,20 +1864,22 @@ Size TracePoll(Globals globals)
   }
 
   AVER(arena->busyTraces == TraceSetSingle(trace));
-  oldScannedSize = traceWorkClock(trace);
-  pollEnd = oldScannedSize + trace->rate;
+  oldWork = traceWork(trace);
+  endWork = oldWork + trace->quantumWork;
   do {
     TraceAdvance(trace);
   } while (trace->state != TraceFINISHED
-           && (ArenaEmergency(arena) || traceWorkClock(trace) < pollEnd));
-  scannedSize = traceWorkClock(trace) - oldScannedSize;
+           && (ArenaEmergency(arena) || traceWork(trace) < endWork));
+  newWork = traceWork(trace);
+  AVER(newWork >= oldWork);
+  work = newWork - oldWork;
   if (trace->state == TraceFINISHED) {
     TraceDestroyFinished(trace);
     /* A trace finished, and hopefully reclaimed some memory, so clear any
      * emergency. */
     ArenaSetEmergency(arena, FALSE);
   }
-  return scannedSize;
+  return work;
 }
 
 
@@ -1913,7 +1917,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth)
                "  condemned $U\n", (WriteFU)trace->condemned,
                "  notCondemned $U\n", (WriteFU)trace->notCondemned,
                "  foundation $U\n", (WriteFU)trace->foundation,
-               "  rate $U\n", (WriteFU)trace->rate,
+               "  quantumWork $U\n", (WriteFU)trace->quantumWork,
                "  rootScanSize $U\n", (WriteFU)trace->rootScanSize,
                "  rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize,
                "  segScanSize $U\n", (WriteFU)trace->segScanSize,
diff --git a/mps/design/type.txt b/mps/design/type.txt
index 25943f41a4b..dc3c3b8cf99 100644
--- a/mps/design/type.txt
+++ b/mps/design/type.txt
@@ -664,6 +664,15 @@ _`.word.ops`: ``WordIsAligned()``, ``WordAlignUp()``,
 ``WordAlignDown()`` and ``WordRoundUp()``.
 
 
+``typedef MPS_T_WORD Work``
+
+_`.work`: ``Work`` is an unsigned integral type representing
+accumulated work done by the collector.
+
+_`.work.impl`: Work is currently implemented as a count of bytes
+scanned by the collector.
+
+
 ``typedef Word ZoneSet``
 
 _`.zoneset`: ``ZoneSet`` is a conservative approximation to a set of

From 68489eec1ecf51fa421e63b6cd5e420bda38e0c9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 15:35:38 +0100
Subject: [PATCH 07/16] Move the clearing of the emergency flag down into
 tracedestroy{init,finish}.

Copied from Perforce
 Change: 188216
 ServerID: perforce.ravenbrook.com
---
 mps/code/policy.c   |  3 ---
 mps/code/trace.c    | 15 +++++++--------
 mps/code/traceanc.c |  7 +++----
 3 files changed, 10 insertions(+), 15 deletions(-)

diff --git a/mps/code/policy.c b/mps/code/policy.c
index ff570e4899b..3cba467a2c7 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -259,9 +259,6 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
 
 failCondemn:
   TraceDestroyInit(trace);
-  /* This is an unlikely case, but clear the emergency flag so the next attempt
-     starts normally. */
-  ArenaSetEmergency(arena, FALSE);
 failStart:
   return FALSE;
 }
diff --git a/mps/code/trace.c b/mps/code/trace.c
index d34d953bf40..5786c677a51 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -771,6 +771,9 @@ void TraceDestroyInit(Trace trace)
 
   trace->sig = SigInvalid;
   trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace);
+
+  /* Clear the emergency flag so the next trace starts normally. */
+  ArenaSetEmergency(trace->arena, FALSE);
 }
 
 
@@ -828,6 +831,9 @@ void TraceDestroyFinished(Trace trace)
   trace->sig = SigInvalid;
   trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace);
   trace->arena->flippedTraces = TraceSetDel(trace->arena->flippedTraces, trace);
+
+  /* Hopefully the trace reclaimed some memory, so clear any emergency. */
+  ArenaSetEmergency(trace->arena, FALSE);
 }
 
 
@@ -1833,9 +1839,6 @@ failStart:
   NOTREACHED;
 failCondemn:
   TraceDestroyInit(trace);
-  /* We don't know how long it'll be before another collection.  Make sure
-     the next one starts in normal mode. */
-  ArenaSetEmergency(arena, FALSE);
   return res;
 }
 
@@ -1873,12 +1876,8 @@ Work TracePoll(Globals globals)
   newWork = traceWork(trace);
   AVER(newWork >= oldWork);
   work = newWork - oldWork;
-  if (trace->state == TraceFINISHED) {
+  if (trace->state == TraceFINISHED)
     TraceDestroyFinished(trace);
-    /* A trace finished, and hopefully reclaimed some memory, so clear any
-     * emergency. */
-    ArenaSetEmergency(arena, FALSE);
-  }
   return work;
 }
 
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index c3743b6dc29..e60f8ffcdb3 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -591,10 +591,9 @@ void ArenaPark(Globals globals)
   }
 
   ArenaAccumulateTime(arena, start);
-  
-  /* Clear any emergency flag so that the next collection starts normally.
-     Any traces that have been finished may have reclaimed memory. */
-  ArenaSetEmergency(arena, FALSE);
+
+  /* All traces have finished so there must not be an emergency. */
+  AVER(!ArenaEmergency(arena));
 }
 
 /* ArenaStartCollect -- start a collection of everything in the

From 1437590cb3f758ba32ea8bf3d6eb01c15982d682 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 15:39:39 +0100
Subject: [PATCH 08/16] Move the arenaemergency test up to policypollagain.

Copied from Perforce
 Change: 188217
 ServerID: perforce.ravenbrook.com
---
 mps/code/policy.c | 2 +-
 mps/code/trace.c  | 3 +--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/mps/code/policy.c b/mps/code/policy.c
index 3cba467a2c7..e3c09c8d6d7 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -333,7 +333,7 @@ Bool PolicyPollAgain(Arena arena, Clock start, Work tracedWork)
   AVER(nextPollThreshold > globals->pollThreshold);
   globals->pollThreshold = nextPollThreshold;
 
-  return PolicyPoll(arena);
+  return ArenaEmergency(arena) || PolicyPoll(arena);
 }
 
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 5786c677a51..378b6bed9a1 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1871,8 +1871,7 @@ Work TracePoll(Globals globals)
   endWork = oldWork + trace->quantumWork;
   do {
     TraceAdvance(trace);
-  } while (trace->state != TraceFINISHED
-           && (ArenaEmergency(arena) || traceWork(trace) < endWork));
+  } while (trace->state != TraceFINISHED && traceWork(trace) < endWork);
   newWork = traceWork(trace);
   AVER(newWork >= oldWork);
   work = newWork - oldWork;

From 0ff67113aedaac4dd4c6b46ec91a94077e0ec26e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 15:51:37 +0100
Subject: [PATCH 09/16] Separate the values "more work to do?" and "amount of
 work done" in tracepoll. previously, the code used "amount of work done > 0"
 when it needed "more work to do?" but that's not right, because on the last
 two calls to traceadvance, no "work" is done (because reclaim work is not
 measured), but there may still be more work to do.

Copied from Perforce
 Change: 188218
 ServerID: perforce.ravenbrook.com
---
 mps/code/eventdef.h |  2 +-
 mps/code/global.c   | 35 ++++++++++++++++-------------------
 mps/code/mpm.h      |  4 ++--
 mps/code/policy.c   | 10 +++++-----
 mps/code/trace.c    | 11 +++++++----
 5 files changed, 31 insertions(+), 31 deletions(-)

diff --git a/mps/code/eventdef.h b/mps/code/eventdef.h
index 225c21f5f65..cb7b590274c 100644
--- a/mps/code/eventdef.h
+++ b/mps/code/eventdef.h
@@ -655,7 +655,7 @@
 #define EVENT_ArenaPoll_PARAMS(PARAM, X) \
   PARAM(X,  0, P, arena) \
   PARAM(X,  1, W, start) \
-  PARAM(X,  2, W, quanta)
+  PARAM(X,  2, B, workWasDone)
 
 #define EVENT_ArenaSetEmergency_PARAMS(PARAM, X) \
   PARAM(X,  0, P, arena) \
diff --git a/mps/code/global.c b/mps/code/global.c
index d15e5cd0da7..d9a5bf9c6c7 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -704,7 +704,7 @@ void (ArenaPoll)(Globals globals)
 {
   Arena arena;
   Clock start;
-  Count quanta;
+  Bool moreWork, workWasDone = FALSE;
   Work tracedWork;
 
   AVERT(Globals, globals);
@@ -721,25 +721,24 @@ void (ArenaPoll)(Globals globals)
 
   /* fillMutatorSize has advanced; call TracePoll enough to catch up. */
   start = ClockNow();
-  quanta = 0;
 
-  EVENT3(ArenaPoll, arena, start, 0);
+  EVENT3(ArenaPoll, arena, start, FALSE);
 
   do {
-    tracedWork = TracePoll(globals);
-    if (tracedWork > 0) {
-      quanta += 1;
+    moreWork = TracePoll(&tracedWork, globals);
+    if (moreWork) {
+      workWasDone = TRUE;
     }
-  } while (PolicyPollAgain(arena, start, tracedWork));
+  } while (PolicyPollAgain(arena, moreWork, tracedWork));
 
   /* Don't count time spent checking for work, if there was no work to do. */
-  if(quanta > 0) {
+  if (workWasDone) {
     ArenaAccumulateTime(arena, start);
   }
 
   AVER(!PolicyPoll(arena));
 
-  EVENT3(ArenaPoll, arena, start, quanta);
+  EVENT3(ArenaPoll, arena, start, BOOLOF(workWasDone));
 
   globals->insidePoll = FALSE;
 }
@@ -780,7 +779,7 @@ static Bool arenaShouldCollectWorld(Arena arena,
 Bool ArenaStep(Globals globals, double interval, double multiplier)
 {
   Work work;
-  Bool stepped;
+  Bool moreWork, workWasDone = FALSE;
   Clock start, end, now;
   Clock clocks_per_sec;
   Arena arena;
@@ -796,8 +795,6 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
   end = start + (Clock)(interval * clocks_per_sec);
   AVER(end >= start);
 
-  stepped = FALSE;
-
   if (arenaShouldCollectWorld(arena, interval, multiplier,
                               start, clocks_per_sec))
   {
@@ -806,24 +803,24 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
     res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
     if (res == ResOK) {
       arena->lastWorldCollect = start;
-      stepped = TRUE;
+      workWasDone = TRUE;
     }
   }
 
   /* loop while there is work to do and time on the clock. */
   do {
-    work = TracePoll(globals);
+    moreWork = TracePoll(&work, globals);
     now = ClockNow();
-    if (work > 0) {
-      stepped = TRUE;
+    if (moreWork) {
+      workWasDone = TRUE;
     }
-  } while ((work > 0) && (now < end));
+  } while (moreWork && now < end);
 
-  if (stepped) {
+  if (workWasDone) {
     ArenaAccumulateTime(arena, start);
   }
 
-  return stepped;
+  return workWasDone;
 }
 
 /* ArenaFinalize -- registers an object for finalization
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 3e888ad28de..ad8620b800f 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -399,7 +399,7 @@ extern void TraceDestroyFinished(Trace trace);
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
 extern Res TraceStart(Trace trace, double mortality, double finishingTime);
-extern Work TracePoll(Globals globals);
+extern Bool TracePoll(Work *workReturn, Globals globals);
 
 extern Rank TraceRankForAccess(Arena arena, Seg seg);
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
@@ -667,7 +667,7 @@ extern Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
 extern Bool PolicyStartTrace(Trace *traceReturn, Arena arena);
 extern double PolicyCollectionTime(Arena arena);
 extern Bool PolicyPoll(Arena arena);
-extern Bool PolicyPollAgain(Arena arena, Clock start, Work tracedWork);
+extern Bool PolicyPollAgain(Arena arena, Bool moreWork, Work tracedWork);
 
 
 /* Locus interface */
diff --git a/mps/code/policy.c b/mps/code/policy.c
index e3c09c8d6d7..77f91ebacd0 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -309,20 +309,20 @@ Bool PolicyPoll(Arena arena)
  * should return to the mutator.
  *
  * start is the clock time when the MPS was entered.
- * tracedWork is the amount of work done by the last call to TracePoll.
+ * moreWork and tracedWork are the results of the last call to TracePoll.
  */
 
-Bool PolicyPollAgain(Arena arena, Clock start, Work tracedWork)
+Bool PolicyPollAgain(Arena arena, Bool moreWork, Work tracedWork)
 {
   Globals globals;
   double nextPollThreshold;
 
   AVERT(Arena, arena);
   globals = ArenaGlobals(arena);
-  UNUSED(start);
+  UNUSED(tracedWork);
   
-  if (tracedWork == 0) {
-    /* No work was done.  Sleep until NOW + a bit. */
+  if (!moreWork) {
+    /* No more work to do.  Sleep until NOW + a bit. */
     nextPollThreshold = globals->fillMutatorSize + ArenaPollALLOCTIME;
   } else {
     /* We did one quantum of work; consume one unit of 'time'. */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 378b6bed9a1..47bd74b8283 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1846,10 +1846,12 @@ failCondemn:
 /* TracePoll -- Check if there's any tracing work to be done
  *
  * Consider starting a trace if none is running; advance the running
- * trace (if any) by one quantum. Return a measure of the work done.
+ * trace (if any) by one quantum. If there may be more work to do,
+ * update *workReturn with a measure of the work done and return TRUE.
+ * Otherwise return FALSE.
  */
 
-Work TracePoll(Globals globals)
+Bool TracePoll(Work *workReturn, Globals globals)
 {
   Trace trace;
   Arena arena;
@@ -1863,7 +1865,7 @@ Work TracePoll(Globals globals)
   } else {
     /* No traces are running: consider starting one now. */
     if (!PolicyStartTrace(&trace, arena))
-      return (Size)0;
+      return FALSE;
   }
 
   AVER(arena->busyTraces == TraceSetSingle(trace));
@@ -1877,7 +1879,8 @@ Work TracePoll(Globals globals)
   work = newWork - oldWork;
   if (trace->state == TraceFINISHED)
     TraceDestroyFinished(trace);
-  return work;
+  *workReturn = work;
+  return TRUE;
 }
 
 

From 6f0c939e2f3ed4c173622b840f12f3df2c68fdf4 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 19:11:49 +0100
Subject: [PATCH 10/16] Arenastep considers collecting the world after
 finishing a trace (not just on entry if no traces are busy).

ArenaStep does not care about quanta, so call TraceAdvance instead of TracePoll.

Copied from Perforce
 Change: 188219
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 85 ++++++++++++++++++++++++-----------------------
 1 file changed, 44 insertions(+), 41 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index d9a5bf9c6c7..a6ab23572f7 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -747,39 +747,37 @@ void (ArenaPoll)(Globals globals)
  * and whether much time has passed since the last time we did that
  * opportunistically. */
 static Bool arenaShouldCollectWorld(Arena arena,
-                                    double interval,
-                                    double multiplier,
+                                    double availableTime,
                                     Clock now,
                                     Clock clocks_per_sec)
 {
-  /* don't collect the world if we're not given any time */
-  if ((interval > 0.0) && (multiplier > 0.0)) {
-    /* don't collect the world if we're already collecting. */
-    if (arena->busyTraces == TraceSetEMPTY) {
-      /* don't collect the world if it's very small */
-      Size collectableSize = ArenaCollectable(arena);
-      if (collectableSize > ARENA_MINIMUM_COLLECTABLE_SIZE) {
-        /* how long would it take to collect the world? */
-        double collectionTime = PolicyCollectionTime(arena);
+  AVERT(Arena, arena);
+  /* Can't collect the world if we're not given any time. */
+  AVER(availableTime > 0.0);
+  /* Can't collect the world if we're already collecting. */
+  AVER(arena->busyTraces == TraceSetEMPTY);
 
-        /* how long since we last collected the world? */
-        double sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
-                                        (double) clocks_per_sec);
-        /* have to be offered enough time, and it has to be a long time
-         * since we last did it. */
-        if ((interval * multiplier > collectionTime) &&
-            sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION)
-          return TRUE;
-      }
-    }
+  /* Don't collect the world if it's very small. */
+  Size collectableSize = ArenaCollectable(arena);
+  if (collectableSize > ARENA_MINIMUM_COLLECTABLE_SIZE) {
+    /* How long would it take to collect the world? */
+    double collectionTime = PolicyCollectionTime(arena);
+    
+    /* How long since we last collected the world? */
+    double sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
+                                    (double) clocks_per_sec);
+    /* have to be offered enough time, and it has to be a long time
+     * since we last did it. */
+    if ((availableTime > collectionTime) &&
+        sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION)
+      return TRUE;
   }
   return FALSE;
 }
 
 Bool ArenaStep(Globals globals, double interval, double multiplier)
 {
-  Work work;
-  Bool moreWork, workWasDone = FALSE;
+  Bool workWasDone = FALSE;
   Clock start, end, now;
   Clock clocks_per_sec;
   Arena arena;
@@ -791,30 +789,35 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
   arena = GlobalsArena(globals);
   clocks_per_sec = ClocksPerSec();
 
-  start = ClockNow();
+  start = now = ClockNow();
   end = start + (Clock)(interval * clocks_per_sec);
   AVER(end >= start);
 
-  if (arenaShouldCollectWorld(arena, interval, multiplier,
-                              start, clocks_per_sec))
-  {
-    Res res;
-    Trace trace;
-    res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
-    if (res == ResOK) {
-      arena->lastWorldCollect = start;
-      workWasDone = TRUE;
-    }
-  }
-
   /* loop while there is work to do and time on the clock. */
   do {
-    moreWork = TracePoll(&work, globals);
-    now = ClockNow();
-    if (moreWork) {
-      workWasDone = TRUE;
+    Trace trace;
+    if (arena->busyTraces != TraceSetEMPTY) {
+      trace = ArenaTrace(arena, (TraceId)0);
+    } else {
+      /* No traces are running: consider collecting the world. */
+      if (arenaShouldCollectWorld(arena, end - now, now, clocks_per_sec)) {
+        Res res;
+        res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
+        if (res != ResOK)
+          break;
+        arena->lastWorldCollect = now;
+      } else {
+        /* Not worth collecting the world; consider starting a trace. */
+        if (!PolicyStartTrace(&trace, arena))
+          break;
+      }
     }
-  } while (moreWork && now < end);
+    TraceAdvance(trace);
+    if (trace->state == TraceFINISHED)
+      TraceDestroyFinished(trace);
+    workWasDone = TRUE;
+    now = ClockNow();
+  } while (now < end);
 
   if (workWasDone) {
     ArenaAccumulateTime(arena, start);

From c2488346e73d8c119e229b9c03b5189fbccc605d Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 3 Sep 2015 20:14:06 +0100
Subject: [PATCH 11/16] There can only be an emergency when a trace is busy, so
 check this.

Copied from Perforce
 Change: 188220
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/mps/code/global.c b/mps/code/global.c
index a6ab23572f7..3e33b2e507a 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -214,6 +214,8 @@ Bool GlobalsCheck(Globals arenaGlobals)
   CHECKL(RingCheck(&arenaRing));
 
   CHECKL(BoolCheck(arena->emergency));
+  /* There can only be an emergency when a trace is busy. */
+  CHECKL(!arena->emergency || arena->busyTraces != TraceSetEMPTY);
   
   if (arenaGlobals->defaultChain != NULL)
     CHECKD(Chain, arenaGlobals->defaultChain);

From 49635c2e8632a125fd2929d11c49e246b9dbfa13 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 4 Sep 2015 08:53:23 +0100
Subject: [PATCH 12/16] Fix bug introduced by change 188219: the end of the
 interval is not the same as the available collection time.

Copied from Perforce
 Change: 188223
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index 3e33b2e507a..48c9c01ec98 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -780,7 +780,7 @@ static Bool arenaShouldCollectWorld(Arena arena,
 Bool ArenaStep(Globals globals, double interval, double multiplier)
 {
   Bool workWasDone = FALSE;
-  Clock start, end, now;
+  Clock start, intervalEnd, availableEnd, now;
   Clock clocks_per_sec;
   Arena arena;
 
@@ -792,8 +792,10 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
   clocks_per_sec = ClocksPerSec();
 
   start = now = ClockNow();
-  end = start + (Clock)(interval * clocks_per_sec);
-  AVER(end >= start);
+  intervalEnd = start + (Clock)(interval * clocks_per_sec);
+  AVER(intervalEnd >= start);
+  availableEnd = start + (Clock)(interval * multiplier * clocks_per_sec);
+  AVER(availableEnd >= start);
 
   /* loop while there is work to do and time on the clock. */
   do {
@@ -802,7 +804,9 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
       trace = ArenaTrace(arena, (TraceId)0);
     } else {
       /* No traces are running: consider collecting the world. */
-      if (arenaShouldCollectWorld(arena, end - now, now, clocks_per_sec)) {
+      if (arenaShouldCollectWorld(arena, availableEnd - now, now,
+                                  clocks_per_sec))
+      {
         Res res;
         res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
         if (res != ResOK)
@@ -819,7 +823,7 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
       TraceDestroyFinished(trace);
     workWasDone = TRUE;
     now = ClockNow();
-  } while (now < end);
+  } while (now < intervalEnd);
 
   if (workWasDone) {
     ArenaAccumulateTime(arena, start);

From 38b52d7a0556d17ef871d204f4c820a6befd65e1 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 4 Sep 2015 22:28:40 +0100
Subject: [PATCH 13/16] Avoid "iso c90 forbids mixed declarations and code"
 error from gcc.

Copied from Perforce
 Change: 188257
 ServerID: perforce.ravenbrook.com
---
 mps/code/policy.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/mps/code/policy.c b/mps/code/policy.c
index b172405ab6b..b207910afbf 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -160,6 +160,8 @@ static double policyCollectionTime(Arena arena)
 Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
                               Clock now, Clock clocks_per_sec)
 {
+  Size collectableSize;
+
   AVERT(Arena, arena);
   /* Can't collect the world if we're not given any time. */
   AVER(availableTime > 0.0);
@@ -167,7 +169,7 @@ Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
   AVER(arena->busyTraces == TraceSetEMPTY);
 
   /* Don't collect the world if it's very small. */
-  Size collectableSize = ArenaCollectable(arena);
+  collectableSize = ArenaCollectable(arena);
   if (collectableSize > ARENA_MINIMUM_COLLECTABLE_SIZE) {
     /* How long would it take to collect the world? */
     double collectionTime = policyCollectionTime(arena);

From b8df4963ee2b0a6906bb193c9c2995ae2d3c3f10 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 4 Sep 2015 22:35:03 +0100
Subject: [PATCH 14/16] Can't assume that the caller will give us any available
 time.

Copied from Perforce
 Change: 188259
 ServerID: perforce.ravenbrook.com
---
 mps/code/policy.c | 34 ++++++++++++++++++----------------
 1 file changed, 18 insertions(+), 16 deletions(-)

diff --git a/mps/code/policy.c b/mps/code/policy.c
index b207910afbf..a2ef85dea80 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -161,29 +161,31 @@ Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
                               Clock now, Clock clocks_per_sec)
 {
   Size collectableSize;
+  double collectionTime, sinceLastWorldCollect;
 
   AVERT(Arena, arena);
-  /* Can't collect the world if we're not given any time. */
-  AVER(availableTime > 0.0);
   /* Can't collect the world if we're already collecting. */
   AVER(arena->busyTraces == TraceSetEMPTY);
 
+  if (availableTime <= 0.0)
+    /* Can't collect the world if we're not given any time. */
+    return FALSE;
+
   /* Don't collect the world if it's very small. */
   collectableSize = ArenaCollectable(arena);
-  if (collectableSize > ARENA_MINIMUM_COLLECTABLE_SIZE) {
-    /* How long would it take to collect the world? */
-    double collectionTime = policyCollectionTime(arena);
-    
-    /* How long since we last collected the world? */
-    double sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
-                                    (double) clocks_per_sec);
-    /* have to be offered enough time, and it has to be a long time
-     * since we last did it. */
-    if ((availableTime > collectionTime) &&
-        sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION)
-      return TRUE;
-  }
-  return FALSE;
+  if (collectableSize < ARENA_MINIMUM_COLLECTABLE_SIZE)
+    return FALSE;
+
+  /* How long would it take to collect the world? */
+  collectionTime = policyCollectionTime(arena);
+
+  /* How long since we last collected the world? */
+  sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
+                           (double) clocks_per_sec);
+
+  /* Offered enough time, and long enough since we last did it? */
+  return availableTime > collectionTime
+    && sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION;
 }
 
 

From 91520b352612841cd53f2ff04ac9594968874bdc Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sat, 12 Mar 2016 15:45:05 +0000
Subject: [PATCH 15/16] Manual allocation should not longer start any traces,
 so test this.

Copied from Perforce
 Change: 189894
 ServerID: perforce.ravenbrook.com
---
 mps/code/apss.c  | 2 ++
 mps/code/mpmss.c | 2 ++
 2 files changed, 4 insertions(+)

diff --git a/mps/code/apss.c b/mps/code/apss.c
index 5192baada42..79a029f86b1 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -210,6 +210,8 @@ static void test(mps_arena_class_t arena_class, mps_arg_s arena_args[],
                mps_class_mvt(), args), "stress MVT");
   } MPS_ARGS_END(args);
 
+  /* Manual allocation should not cause any garbage collections. */
+  Insist(mps_collections(arena) == 0);
   mps_arena_destroy(arena);
 }
 
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 2c746b7e34d..31616425a65 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -212,6 +212,8 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
                mps_class_mfs(), args), "stress MFS");
   } MPS_ARGS_END(args);
 
+  /* Manual allocation should not cause any garbage collections. */
+  Insist(mps_collections(arena) == 0);
   mps_arena_destroy(arena);
 }
 

From 2a3c4e05900fd1e611215383b45befc648e01176 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 14 Mar 2016 20:10:14 +0000
Subject: [PATCH 16/16] Address points made by rb in review
 <https://info.ravenbrook.com/mail/2016/03/14/18-48-19/0/>

Copied from Perforce
 Change: 190031
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c    | 19 ++++++++++---------
 mps/code/eventdef.h |  2 +-
 mps/code/global.c   |  4 ++--
 mps/code/mpm.h      |  4 ++--
 mps/code/mpmst.h    |  2 +-
 mps/code/policy.c   |  3 +++
 mps/code/trace.c    | 33 ++++++++++++++++++---------------
 mps/code/traceanc.c |  2 +-
 mps/design/type.txt |  6 ++++--
 9 files changed, 42 insertions(+), 33 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 17634daecbd..dc7ae37b15c 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -1320,15 +1320,6 @@ Size ArenaAvail(Arena arena)
 /* ArenaCollectable -- return estimate of collectable memory in arena */
 
 Size ArenaCollectable(Arena arena)
-{
-  /* Conservative estimate -- see job003929. */
-  return ArenaScannable(arena);
-}
-
-
-/* ArenaScannable -- return estimate of scannable memory in arena */
-
-Size ArenaScannable(Arena arena)
 {
   /* Conservative estimate -- see job003929. */
   Size committed = ArenaCommitted(arena);
@@ -1338,6 +1329,16 @@ Size ArenaScannable(Arena arena)
 }
 
 
+/* ArenaAccumulateTime -- accumulate time spent tracing */
+
+void ArenaAccumulateTime(Arena arena, Clock start, Clock end)
+{
+  AVERT(Arena, arena);
+  AVER(start <= end);
+  arena->tracedTime += (end - start) / (double) ClocksPerSec();
+}
+
+
 /* ArenaExtend -- Add a new chunk in the arena */
 
 Res ArenaExtend(Arena arena, Addr base, Size size)
diff --git a/mps/code/eventdef.h b/mps/code/eventdef.h
index cb7b590274c..312f257ee0f 100644
--- a/mps/code/eventdef.h
+++ b/mps/code/eventdef.h
@@ -674,7 +674,7 @@
   PARAM(X,  4, W, notCondemned) /* collectible but not condemned bytes */ \
   PARAM(X,  5, W, foundation)   /* foundation size */ \
   PARAM(X,  6, W, white)        /* white reference set */ \
-  PARAM(X,  7, W, quantumWork)  /* work constituting a quantum */
+  PARAM(X,  7, W, quantumWork)  /* tracing work to be done in each poll */
 
 #define EVENT_VMCompact_PARAMS(PARAM, X) \
   PARAM(X,  0, W, vmem0)        /* pre-collection reserved size */ \
diff --git a/mps/code/global.c b/mps/code/global.c
index fae5b0bb2dd..39e83714f82 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -739,7 +739,7 @@ void (ArenaPoll)(Globals globals)
 
   /* Don't count time spent checking for work, if there was no work to do. */
   if (workWasDone) {
-    ArenaAccumulateTime(arena, start);
+    ArenaAccumulateTime(arena, start, ClockNow());
   }
 
   AVER(!PolicyPoll(arena));
@@ -801,7 +801,7 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
   } while (now < intervalEnd);
 
   if (workWasDone) {
-    ArenaAccumulateTime(arena, start);
+    ArenaAccumulateTime(arena, start, now);
   }
 
   return workWasDone;
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 2cd17c27135..6cbc676ab00 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -397,6 +397,7 @@ extern Res TraceCreate(Trace *traceReturn, Arena arena, int why);
 extern void TraceDestroyInit(Trace trace);
 extern void TraceDestroyFinished(Trace trace);
 
+extern Bool TraceIsEmpty(Trace trace);
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
 extern Res TraceStart(Trace trace, double mortality, double finishingTime);
@@ -537,7 +538,6 @@ extern Bool ArenaGrainSizeCheck(Size size);
 #define AddrIsArenaGrain(addr, arena) AddrIsAligned(addr, ArenaGrainSize(arena))
 #define SizeArenaGrains(size, arena) SizeAlignUp(size, ArenaGrainSize(arena))
 #define SizeIsArenaGrains(size, arena) SizeIsAligned(size, ArenaGrainSize(arena))
-#define ArenaAccumulateTime(arena, start) ((arena)->tracedTime += (ClockNow() - (start)) / (double) ClocksPerSec())
 
 extern void ArenaEnterLock(Arena arena, Bool recursive);
 extern void ArenaLeaveLock(Arena arena, Bool recursive);
@@ -572,6 +572,7 @@ extern Bool ArenaHasAddr(Arena arena, Addr addr);
 extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
 extern void ArenaChunkInsert(Arena arena, Chunk chunk);
 extern void ArenaChunkRemoved(Arena arena, Chunk chunk);
+extern void ArenaAccumulateTime(Arena arena, Clock start, Clock now);
 
 extern void ArenaSetEmergency(Arena arena, Bool emergency);
 extern Bool ArenaEmergency(Arena arean);
@@ -628,7 +629,6 @@ extern Res ArenaNoGrow(Arena arena, LocusPref pref, Size size);
 
 extern Size ArenaAvail(Arena arena);
 extern Size ArenaCollectable(Arena arena);
-extern Size ArenaScannable(Arena arena);
 
 extern Res ArenaExtend(Arena, Addr base, Size size);
 
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index b7267e2cba3..4e848f5da57 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -486,7 +486,7 @@ typedef struct TraceStruct {
   Size condemned;               /* condemned bytes */
   Size notCondemned;            /* collectable but not condemned */
   Size foundation;              /* initial grey set size */
-  Work quantumWork;             /* collection work constituting a quantum */
+  Work quantumWork;             /* tracing work to be done in each poll */
   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 */
diff --git a/mps/code/policy.c b/mps/code/policy.c
index 82709f7376f..a9bc710be1b 100644
--- a/mps/code/policy.c
+++ b/mps/code/policy.c
@@ -325,6 +325,8 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
       res = policyCondemnChain(&mortality, firstChain, trace);
       if (res != ResOK) /* should try some other trace, really @@@@ */
         goto failCondemn;
+      if (TraceIsEmpty(trace))
+        goto nothingCondemned;
       trace->chain = firstChain;
       ChainStartGC(firstChain, trace);
       res = TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
@@ -336,6 +338,7 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
   } /* (dynamicDeferral > 0.0) */
   return FALSE;
 
+nothingCondemned:
 failCondemn:
   TraceDestroyInit(trace);
 failStart:
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 6973d8ce63d..6d9cb0f0f98 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -339,6 +339,15 @@ static ZoneSet traceSetWhiteUnion(TraceSet ts, Arena arena)
 }
 
 
+/* TraceIsEmpty -- return TRUE if trace has no condemned segments */
+
+Bool TraceIsEmpty(Trace trace)
+{
+  AVERT(Trace, trace);
+  return trace->condemned == 0;
+}
+
+
 /* TraceAddWhite -- add a segment to the white set of a trace */
 
 Res TraceAddWhite(Trace trace, Seg seg)
@@ -391,7 +400,6 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
   Seg seg;
   Arena arena;
   Res res;
-  Bool haveWhiteSegs = FALSE;
 
   AVERT(Trace, trace);
   AVER(condemnedSet != ZoneSetEMPTY);
@@ -418,14 +426,10 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
         res = TraceAddWhite(trace, seg);
         if(res != ResOK)
           goto failBegin;
-        haveWhiteSegs = TRUE;
       }
     } while (SegNext(&seg, arena, seg));
   }
 
-  if (!haveWhiteSegs)
-    return ResFAIL;
-
   EVENT3(TraceCondemnZones, trace, condemnedSet, trace->white);
 
   /* The trace's white set must be a subset of the condemned set */
@@ -434,7 +438,7 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
   return ResOK;
 
 failBegin:
-  AVER(!haveWhiteSegs); /* See .whiten.fail. */
+  AVER(TraceIsEmpty(trace)); /* See .whiten.fail. */
   return res;
 }
 
@@ -697,7 +701,7 @@ found:
   trace->condemned = (Size)0;   /* nothing condemned yet */
   trace->notCondemned = (Size)0;
   trace->foundation = (Size)0;  /* nothing grey yet */
-  trace->quantumWork = (Work)0; /* no work done yet */
+  trace->quantumWork = (Work)0; /* computed in TraceStart */
   STATISTIC(trace->greySegCount = (Count)0);
   STATISTIC(trace->greySegMax = (Count)0);
   STATISTIC(trace->rootScanCount = (Count)0);
@@ -1482,7 +1486,6 @@ static Res traceCondemnAll(Trace trace)
   Res res;
   Arena arena;
   Ring poolNode, nextPoolNode, chainNode, nextChainNode;
-  Bool haveWhiteSegs = FALSE;
 
   arena = trace->arena;
   AVERT(Arena, arena);
@@ -1501,12 +1504,11 @@ static Res traceCondemnAll(Trace trace)
         res = TraceAddWhite(trace, seg);
         if (res != ResOK)
           goto failBegin;
-        haveWhiteSegs = TRUE;
       }
     }
   }
 
-  if (!haveWhiteSegs)
+  if (TraceIsEmpty(trace))
     return ResFAIL;
 
   /* Notify all the chains. */
@@ -1525,7 +1527,7 @@ failBegin:
    * pool class that fails to whiten a segment, then this assertion
    * will be triggered. In that case, we'll have to recover here by
    * blackening the segments again. */
-  AVER(!haveWhiteSegs);
+  AVER(TraceIsEmpty(trace));
   return res;
 }
 
@@ -1645,8 +1647,8 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
     /* integer, so try to make sure it fits. */
     if(nPolls >= (double)LONG_MAX)
       nPolls = (double)LONG_MAX;
-    /* One quantum of work equals scanning work divided by number of
-     * polls, plus one to ensure it's not zero. */
+    /* One quantum of work equals total tracing work divided by number
+     * of polls, plus one to ensure it's not zero. */
     trace->quantumWork
       = (trace->foundation + sSurvivors) / (unsigned long)nPolls + 1;
   }
@@ -1671,9 +1673,10 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
 }
 
 
-/* traceWork -- a measure of the work done for this trace
+/* traceWork -- a measure of the work done for this trace.
  *
- * .work: Segment and root scanning work is the measure.  */
+ * See design.mps.type.work.
+ */
 
 #define traceWork(trace) ((Work)((trace)->segScanSize + (trace)->rootScanSize))
 
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index e60f8ffcdb3..4730c7a0f54 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -590,7 +590,7 @@ void ArenaPark(Globals globals)
     TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena);
   }
 
-  ArenaAccumulateTime(arena, start);
+  ArenaAccumulateTime(arena, start, ClockNow());
 
   /* All traces have finished so there must not be an emergency. */
   AVER(!ArenaEmergency(arena));
diff --git a/mps/design/type.txt b/mps/design/type.txt
index dc3c3b8cf99..5f546e1e32e 100644
--- a/mps/design/type.txt
+++ b/mps/design/type.txt
@@ -669,8 +669,10 @@ _`.word.ops`: ``WordIsAligned()``, ``WordAlignUp()``,
 _`.work`: ``Work`` is an unsigned integral type representing
 accumulated work done by the collector.
 
-_`.work.impl`: Work is currently implemented as a count of bytes
-scanned by the collector.
+_`.work.impl`: Work is implemented as a count of the bytes scanned by
+the collector in segments and roots. This is a very crude measure,
+because it depends on the scanning functions supplied by the mutator,
+which we know very little about.
 
 
 ``typedef Word ZoneSet``