Add mps_arena_start_collect(): starting an incremental world collection.

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

mps/code/mpm.h

@@ -475,6 +475,7 @@ extern Bool (ArenaStep)(Globals globals, double interval);
 extern void ArenaClamp(Globals globals);
 extern void ArenaRelease(Globals globals);
 extern void ArenaPark(Globals globals);
+extern Res ArenaStartCollect(Globals globals);
 extern Res ArenaCollect(Globals globals);
 extern Bool ArenaHasAddr(Arena arena, Addr addr);
 

mps/code/mps.h

@@ -238,6 +238,7 @@ typedef struct mps_fmt_fixed_s {
 extern void mps_arena_clamp(mps_arena_t);
 extern void mps_arena_release(mps_arena_t);
 extern void mps_arena_park(mps_arena_t);
+extern mps_res_t mps_arena_start_collect(mps_arena_t);
 extern mps_res_t mps_arena_collect(mps_arena_t);
 extern mps_bool_t mps_arena_step(mps_arena_t, double);
 extern void mps_space_clamp(mps_space_t);

mps/code/mpsi.c

@@ -341,6 +341,16 @@ void mps_space_park(mps_space_t mps_space)
 }
 
 
+mps_res_t mps_arena_start_collect(mps_space_t mps_space)
+{
+  Res res;
+  Arena arena = (Arena)mps_space;
+  ArenaEnter(arena);
+  res = ArenaStartCollect(ArenaGlobals(arena));
+  ArenaLeave(arena);
+  return res;
+}
+
 mps_res_t mps_arena_collect(mps_space_t mps_space)
 {
   Res res;

mps/code/trace.c

@@ -1507,6 +1507,37 @@ static void traceQuantum(Trace trace)
            && (trace->emergency || traceWorkClock(trace) < pollEnd));
 }
 
+/* traceStartCollectAll: start a trace which condemns everything in
+ * the arena. */
+
+static Res traceStartCollectAll(Trace *traceReturn, Arena arena)
+{
+  Trace trace;
+  Res res;
+  double finishingTime;
+
+  AVERT(Arena, arena);
+  AVER(arena->busyTraces == TraceSetEMPTY);
+
+  res = TraceCreate(&trace, arena);
+  AVER(res == ResOK); /* succeeds because no other trace is busy */
+  res = traceCondemnAll(trace);
+  if (res != ResOK) /* should try some other trace, really @@@@ */
+    goto failCondemn;
+  finishingTime = ArenaAvail(arena)
+                  - trace->condemned * (1.0 - TraceTopGenMortality);
+  if (finishingTime < 0)
+    /* Run out of time, should really try a smaller collection. @@@@ */
+    finishingTime = 0.0;
+  TraceStart(trace, TraceTopGenMortality, finishingTime);
+  *traceReturn = trace;
+  return ResOK;
+
+failCondemn:
+  TraceDestroy(trace);
+  return res;
+}
+
 
 /* TracePoll -- Check if there's any tracing work to be done */
 
@@ -1537,22 +1568,12 @@ Bool TracePoll(Globals globals)
     AVER(TraceWorkFactor >= 0);
     AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX);
     sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor);
-    dynamicDeferral = (double)sConsTrace - (double)ArenaAvail(arena);
+    dynamicDeferral = (double)ArenaAvail(arena) - (double)sConsTrace;
 
-    if (dynamicDeferral > 0.0) { /* start full GC */
-      double finishingTime;
-
-      res = TraceCreate(&trace, arena);
-      AVER(res == ResOK); /* succeeds because no other trace is busy */
-      res = traceCondemnAll(trace);
-      if (res != ResOK) /* should try some other trace, really @@@@ */
-        goto failCondemn;
-      finishingTime = ArenaAvail(arena)
-                      - trace->condemned * (1.0 - TraceTopGenMortality);
-      if (finishingTime < 0)
-        /* Run out of time, should really try a smaller collection. @@@@ */
-        finishingTime = 0.0;
-      TraceStart(trace, TraceTopGenMortality, finishingTime);
+    if (dynamicDeferral < 0.0) { /* start full GC */
+      res = traceStartCollectAll(&trace, arena);
+      if (res != ResOK)
+        goto failStart;
       done = TRUE;
     } else { /* Find the nursery most over its capacity. */
       Ring node, nextNode;
@@ -1600,11 +1621,12 @@ Bool TracePoll(Globals globals)
 
 failCondemn:
   TraceDestroy(trace);
+failStart:
   return FALSE;
 }
 
 
-/* ArenaClamp -- clamp the arena (no new collections) */
+/* ArenaClamp -- clamp the arena (no optional collection increments) */
 
 void ArenaClamp(Globals globals)
 {
@@ -1613,7 +1635,8 @@ void ArenaClamp(Globals globals)
 }
 
 
-/* ArenaRelease -- release the arena (allow new collections) */
+/* ArenaRelease -- release the arena (allow optional collection
+ * increments) */
 
 void ArenaRelease(Globals globals)
 {
@@ -1623,7 +1646,7 @@ void ArenaRelease(Globals globals)
 }
 
 
-/* ArenaClamp -- finish all collections and clamp the arena */
+/* ArenaPark -- finish all current collections and clamp the arena */
 
 void ArenaPark(Globals globals)
 {
@@ -1646,33 +1669,44 @@ void ArenaPark(Globals globals)
   }
 }
 
+/* ArenaStartCollect -- start a collection of everything in the
+ * arena; leave unclamped. */
 
-/* ArenaCollect -- collect everything in arena */
-
-Res ArenaCollect(Globals globals)
+Res ArenaStartCollect(Globals globals)
 {
-  Trace trace;
+  Arena arena;
   Res res;
+  Trace trace;
 
   AVERT(Globals, globals);
+  arena = GlobalsArena(globals);
+
   ArenaPark(globals);
-
-  res = TraceCreate(&trace, GlobalsArena(globals));
-  AVER(res == ResOK); /* should be a trace available -- we're parked */
-
-  res = traceCondemnAll(trace);
+  res = traceStartCollectAll(&trace, arena);
   if (res != ResOK)
-    goto failBegin;
-
-  TraceStart(trace, 0.0, 0.0);
-  ArenaPark(globals);
+    goto failStart;
+  ArenaRelease(globals);
   return ResOK;
 
-failBegin:
-  TraceDestroy(trace);
+failStart:
+  ArenaRelease(globals);
   return res;
 }
 
+/* ArenaCollect -- collect everything in arena; leave clamped */
+
+Res ArenaCollect(Globals globals)
+{
+  Res res;
+
+  AVERT(Globals, globals);
+  res = ArenaStartCollect(globals);
+  if (res != ResOK)
+    return res;
+
+  ArenaPark(globals);
+  return ResOK;
+}
 
 /* C. COPYRIGHT AND LICENSE
  *