New function policystarttrace decides whether to start a trace.

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

mps/code/mpm.h

@@ -660,6 +660,7 @@ extern Res ArenaNoExtend(Arena arena, Addr base, Size size);
 
 extern Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
                        Size size, Pool pool);
+extern Bool PolicyStartTrace(Trace *traceReturn, Arena arena);
 
 
 /* Locus interface */

mps/code/policy.c

@@ -112,6 +112,87 @@ found:
 }
 
 
+/* PolicyStartTrace -- consider starting a trace
+ *
+ * If a trace was started, update *traceReturn and return TRUE.
+ * Otherwise, leave *traceReturn unchanged and return FALSE.
+ */
+
+Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
+{
+  Res res;
+  Trace trace;
+  Size sFoundation, sCondemned, sSurvivors, sConsTrace;
+  double tTracePerScan; /* tTrace/cScan */
+  double dynamicDeferral;
+
+  /* Compute dynamic criterion.  See strategy.lisp-machine. */
+  AVER(arena->topGen.mortality >= 0.0);
+  AVER(arena->topGen.mortality <= 1.0);
+  sFoundation = (Size)0; /* condemning everything, only roots @@@@ */
+  /* @@@@ sCondemned should be scannable only */
+  sCondemned = ArenaCommitted(arena) - ArenaSpareCommitted(arena);
+  sSurvivors = (Size)(sCondemned * (1 - arena->topGen.mortality));
+  tTracePerScan = sFoundation + (sSurvivors * (1 + TraceCopyScanRATIO));
+  AVER(TraceWorkFactor >= 0);
+  AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX);
+  sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor);
+  dynamicDeferral = (double)ArenaAvail(arena) - (double)sConsTrace;
+
+  if (dynamicDeferral < 0.0) {
+    /* Start full collection. */
+    res = TraceStartCollectAll(&trace, arena, TraceStartWhyDYNAMICCRITERION);
+    if (res != ResOK)
+      goto failStart;
+    *traceReturn = trace;
+    return TRUE;
+  } else {
+    /* Find the chain most over its capacity. */
+    Ring node, nextNode;
+    double firstTime = 0.0;
+    Chain firstChain = NULL;
+
+    RING_FOR(node, &arena->chainRing, nextNode) {
+      Chain chain = RING_ELT(Chain, chainRing, node);
+      double time;
+
+      AVERT(Chain, chain);
+      time = ChainDeferral(chain);
+      if (time < firstTime) {
+        firstTime = time; firstChain = chain;
+      }
+    }
+
+    /* If one was found, start collection on that chain. */
+    if(firstTime < 0) {
+      double mortality;
+
+      res = TraceCreate(&trace, arena, TraceStartWhyCHAIN_GEN0CAP);
+      AVER(res == ResOK);
+      res = ChainCondemnAuto(&mortality, firstChain, trace);
+      if (res != ResOK) /* should try some other trace, really @@@@ */
+        goto failCondemn;
+      trace->chain = firstChain;
+      ChainStartGC(firstChain, trace);
+      res = TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
+      /* We don't expect normal GC traces to fail to start. */
+      AVER(res == ResOK);
+      *traceReturn = trace;
+      return TRUE;
+    }
+  } /* (dynamicDeferral > 0.0) */
+  return FALSE;
+
+failCondemn:
+  TraceDestroy(trace);
+  /* This is an unlikely case, but clear the emergency flag so the next attempt
+     starts normally. */
+  ArenaSetEmergency(arena, FALSE);
+failStart:
+  return FALSE;
+}
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.

mps/code/trace.c

@@ -1813,103 +1813,40 @@ failCondemn:
 }
 
 
-/* TracePoll -- Check if there's any tracing work to be done */
+/* 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.
+ */
 
 Size TracePoll(Globals globals)
 {
   Trace trace;
-  Res res;
   Arena arena;
-  Size scannedSize;
+  Size oldScannedSize, 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;
-    double tTracePerScan; /* tTrace/cScan */
-    double dynamicDeferral;
-
-    /* Compute dynamic criterion.  See strategy.lisp-machine. */
-    AVER(arena->topGen.mortality >= 0.0);
-    AVER(arena->topGen.mortality <= 1.0);
-    sFoundation = (Size)0; /* condemning everything, only roots @@@@ */
-    /* @@@@ sCondemned should be scannable only */
-    sCondemned = ArenaCommitted(arena) - ArenaSpareCommitted(arena);
-    sSurvivors = (Size)(sCondemned * (1 - arena->topGen.mortality));
-    tTracePerScan = sFoundation + (sSurvivors * (1 + TraceCopyScanRATIO));
-    AVER(TraceWorkFactor >= 0);
-    AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX);
-    sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor);
-    dynamicDeferral = (double)ArenaAvail(arena) - (double)sConsTrace;
-
-    if(dynamicDeferral < 0.0) { /* start full GC */
-      res = TraceStartCollectAll(&trace, arena, TraceStartWhyDYNAMICCRITERION);
-      if(res != ResOK)
-        goto failStart;
-      scannedSize = traceWorkClock(trace);
-    } else { /* Find the nursery most over its capacity. */
-      Ring node, nextNode;
-      double firstTime = 0.0;
-      Chain firstChain = NULL;
-
-      RING_FOR(node, &arena->chainRing, nextNode) {
-        Chain chain = RING_ELT(Chain, chainRing, node);
-        double time;
-
-        AVERT(Chain, chain);
-        time = ChainDeferral(chain);
-        if(time < firstTime) {
-          firstTime = time; firstChain = chain;
-        }
-      }
-
-      /* If one was found, start collection on that chain. */
-      if(firstTime < 0) {
-        double mortality;
-
-        res = TraceCreate(&trace, arena, TraceStartWhyCHAIN_GEN0CAP);
-        AVER(res == ResOK);
-        res = ChainCondemnAuto(&mortality, firstChain, trace);
-        if(res != ResOK) /* should try some other trace, really @@@@ */
-          goto failCondemn;
-        trace->chain = firstChain;
-        ChainStartGC(firstChain, trace);
-        res = TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
-        /* We don't expect normal GC traces to fail to start. */
-        AVER(res == ResOK);
-        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;
-
+  if (arena->busyTraces != TraceSetEMPTY) {
     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);
-      /* A trace finished, and hopefully reclaimed some memory, so clear any
-         emergency. */
-      ArenaSetEmergency(arena, FALSE);
-    }
+  } else {
+    /* No traces are running: consider starting one now. */
+    if (!PolicyStartTrace(&trace, arena))
+      return (Size)0;
+  }
+
+  AVER(arena->busyTraces == TraceSetSingle(trace));
+  oldScannedSize = traceWorkClock(trace);
+  TraceQuantum(trace);
+  scannedSize = traceWorkClock(trace) - oldScannedSize;
+  if (trace->state == TraceFINISHED) {
+    TraceDestroy(trace);
+    /* A trace finished, and hopefully reclaimed some memory, so clear any
+     * emergency. */
+    ArenaSetEmergency(arena, FALSE);
   }
   return scannedSize;
-
-failCondemn:
-  TraceDestroy(trace);
-  /* This is an unlikely case, but clear the emergency flag so the next attempt
-     starts normally. */
-  ArenaSetEmergency(arena, FALSE);
-failStart:
-  return (Size)0;
 }