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

@@ -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)

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 */ \

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;

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);
 

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 */

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:

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))
 

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));