implement exp-strategy-3 manually cherry picking from branch exp-stra…

…tegy-2

code/ld.c

@@ -106,6 +106,7 @@ Res HistoryDescribe(History history, mps_lib_FILE *stream, Count depth)
 
   res = WriteF(stream, depth,
                "History $P {\n",      (WriteFP)history,
+               "  collections= $U\n", (WriteFU)history->collections,
                "  epoch      = $U\n", (WriteFU)history->epoch,
                "  prehistory = $B\n", (WriteFB)history->prehistory,
                "  history {\n",
@@ -268,7 +269,7 @@ Bool LDIsStale(mps_ld_t ld, Arena arena, Addr addr)
  * because it updates the notion of the 'current' and 'oldest' history
  * entries.
  */
-void LDAge(Arena arena, RefSet rs)
+static void LDAge(Arena arena, RefSet rs)
 {
   History history;
   Size i;
@@ -296,6 +297,23 @@ void LDAge(Arena arena, RefSet rs)
   AVER(history->epoch != 0);      /* .epoch-size */
 }
 
+/* LDAdvance
+ *
+ * Advance History during flip
+ */
+void LDAdvance(Arena arena, RefSet moved)
+{
+  History history;
+  history = ArenaHistory(arena);
+  AVERT(Arena, arena);
+
+  if (moved != ZoneSetEMPTY) {
+    LDAge(arena, moved);
+  }
+  ++history->collections;
+
+  AVER(history->collections != 0);
+}
 
 /* LDMerge -- merge two location dependencies
  *

code/mpm.h

@@ -494,6 +494,7 @@ extern void GlobalsReinitializeAll(void);
 #define ArenaThreadRing(arena)  (&(arena)->threadRing)
 #define ArenaDeadRing(arena)    (&(arena)->deadRing)
 #define ArenaEpoch(arena)       (ArenaHistory(arena)->epoch) /* .epoch.ts */
+#define ArenaCollections(arena) (ArenaHistory(arena)->collections)
 #define ArenaTrace(arena, ti)   (&(arena)->trace[ti])
 #define ArenaZoneShift(arena)   ((arena)->zoneShift)
 #define ArenaStripeSize(arena)  ((Size)1 << ArenaZoneShift(arena))
@@ -921,7 +922,7 @@ extern void LDReset(mps_ld_t ld, Arena arena);
 extern void LDAdd(mps_ld_t ld, Arena arena, Addr addr);
 extern Bool LDIsStaleAny(mps_ld_t ld, Arena arena);
 extern Bool LDIsStale(mps_ld_t ld, Arena arena, Addr addr);
-extern void LDAge(Arena arena, RefSet moved);
+extern void LDAdvance(Arena arena, RefSet moved);
 extern void LDMerge(mps_ld_t ld, Arena arena, mps_ld_t from);
 
 

code/mpmst.h

@@ -692,6 +692,7 @@ typedef struct ShieldStruct {
 typedef struct HistoryStruct {
   Sig sig;                         /* design.mps.sig.field */
   Epoch epoch;                     /* <design/arena#.ld.epoch> */
+  Count collections;             /* number of flips */
   RefSet prehistory;               /* <design/arena#.ld.prehistory> */
   RefSet history[LDHistoryLENGTH]; /* <design/arena#.ld.history> */
 } HistoryStruct;

code/mpmtypes.h

@@ -380,7 +380,9 @@ enum {
     "Client requests: immediate full collection.")                      \
   X(WALK, "walk", "Walking all live objects.")                          \
   X(EXTENSION, "extension", \
-    "Extension: an MPS extension started the trace.")
+    "Extension: an MPS extension started the trace.")                   \
+  X(CHAINFULL, "chain full",                                            \
+    "Chain full: Chain is filling top generation.")
 
 enum {
 #define X(WHY, SHORT, LONG) TraceStartWhy ## WHY,

code/mpsi.c

@@ -1697,7 +1697,7 @@ mps_bool_t mps_ld_isstale_any(mps_ld_t ld, mps_arena_t arena)
 
 mps_word_t mps_collections(mps_arena_t arena)
 {
-  return ArenaEpoch(arena); /* thread safe: see <code/arena.h#epoch.ts> */
+    return ArenaCollections(arena);
 }
 
 

code/policy.c

@@ -197,26 +197,51 @@ Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
     && sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION;
 }
 
+/* policyCollectChain - work out generations to collect
+ *
+ * *genReturn is set to top generation number to collect.
+ * *topReturn is set if collection of topGen is indicated.
+ */
 
-/* policyCondemnChain -- condemn approriate parts of this chain
+static Res policyCollectChainTime(Bool *topReturn, Count *genReturn, Chain chain)
+{
+  size_t topCondemnedGen;
+  Count collections;
+  Bool top;
+
+  AVER(topReturn != NULL);
+  AVER(genReturn != NULL);
+  AVERT(Chain, chain);
+
+  collections = ArenaCollections(chain->arena);
+  topCondemnedGen = SizeFloorLog2(collections ^ (collections+1));
+  top = (topCondemnedGen >= chain->genCount);
+  if (topCondemnedGen > chain->genCount - 1) {
+    topCondemnedGen = chain->genCount - 1;
+  }
+
+  *topReturn = top;
+  *genReturn = topCondemnedGen;
+  return ResOK;
+}
+
+
+/* policyCollectChainCapacity - work out generations to collect
  *
- * If successful, set *mortalityReturn to an estimate of the mortality
- * of the condemned parts of this chain and return ResOK.
+ * This is only called if ChainDefferal reutrned a value sufficiently
+ * low that we dedided to start the collection. (Usually such values
+ * are less than zero; see <design/strategy/#policy.start.chain>.)
  *
- * This is only called if ChainDeferral returned a value sufficiently
- * low that we decided to start the collection. (Usually such values
- * are less than zero; see <design/strategy#.policy.start.chain>.)
+ * *genReturn is set to top generation number to collect.
  */
 
-static Res policyCondemnChain(double *mortalityReturn, Chain chain, Trace trace)
+static Res policyCollectChainCapacity(Count *genReturn, Chain chain)
 {
-  size_t topCondemnedGen, i;
+  size_t topCondemnedGen;
   GenDesc gen;
 
-  AVER(mortalityReturn != NULL);
+  AVER(genReturn != NULL);
   AVERT(Chain, chain);
-  AVERT(Trace, trace);
-  AVER(chain->arena == trace->arena);
 
   /* Find the highest generation that's over capacity. We will condemn
    * this and all lower generations in the chain. */
@@ -234,6 +259,30 @@ static Res policyCondemnChain(double *mortalityReturn, Chain chain, Trace trace)
       break;
   }
 
+  *genReturn = topCondemnedGen;
+  return ResOK;
+}
+
+
+/* policyCondemnChain -- condemn approriate parts of this chain
+ *
+ * If successful, set *mortalityReturn to an estimate of the mortality
+ * of the condemned parts of this chain and return ResOK.
+ */
+
+static Res policyCondemnChain(double *mortalityReturn,
+                              Chain chain,
+                              size_t topCondemnedGen,
+                              Trace trace)
+{
+  size_t i;
+  GenDesc gen;
+
+  AVER(mortalityReturn != NULL);
+  AVERT(Chain, chain);
+  AVERT(Trace, trace);
+  AVER(chain->arena == trace->arena);
+
   /* At this point, we've decided to condemn topCondemnedGen and all
    * lower generations. */
   TraceCondemnStart(trace);
@@ -266,6 +315,7 @@ Bool PolicyStartTrace(Trace *traceReturn, Bool *collectWorldReturn,
 {
   Res res;
   Trace trace;
+  Bool dynamicCriterionAllowed = FALSE;
   double TraceWorkFactor = 0.25;
   /* Fix the mortality of the world to avoid runaway feedback between the
      dynamic criterion and the mortality of the arena's top generation,
@@ -276,7 +326,7 @@ Bool PolicyStartTrace(Trace *traceReturn, Bool *collectWorldReturn,
   AVER(traceReturn != NULL);
   AVERT(Arena, arena);
 
-  if (collectWorldAllowed) {
+  if (collectWorldAllowed && dynamicCriterionAllowed) {
     Size sFoundation, sCondemned, sSurvivors, sConsTrace;
     double tTracePerScan; /* tTrace/cScan */
     double dynamicDeferral;
@@ -322,22 +372,45 @@ Bool PolicyStartTrace(Trace *traceReturn, Bool *collectWorldReturn,
     }
 
     /* If one was found, start collection on that chain. */
-    if(firstTime < 0) {
+    if (firstTime < 0) {
       double mortality;
+      size_t topCondemnedGen = 0;
+      size_t topCondemnedGenTime = 0;
+      Bool top = FALSE;
 
-      res = TraceCreate(&trace, arena, TraceStartWhyCHAIN_GEN0CAP);
+      res = policyCollectChainCapacity(&topCondemnedGen, firstChain);
       AVER(res == ResOK);
-      res = policyCondemnChain(&mortality, firstChain, trace);
-      if (res != ResOK) /* should try some other trace, really @@@@ */
-        goto failCondemn;
-      if (TraceIsEmpty(trace))
-        goto nothingCondemned;
-      res = TraceStart(trace, mortality,
-                       (double)trace->condemned * TraceWorkFactor);
-      /* We don't expect normal GC traces to fail to start. */
+
+      res = policyCollectChainTime(&top, &topCondemnedGenTime, firstChain);
       AVER(res == ResOK);
-      *traceReturn = trace;
-      return TRUE;
+
+      if (topCondemnedGenTime > topCondemnedGen)
+        topCondemnedGen = topCondemnedGenTime;
+      if (top && collectWorldAllowed) {
+        /* Start full collection */
+        res = TraceStartCollectAll(&trace, arena, TraceStartWhyCHAINFULL);
+        if (res != ResOK)
+          goto failStart;
+        *collectWorldReturn = TRUE;
+        *traceReturn = trace;
+        return TRUE;
+      } else {
+        res = TraceCreate(&trace, arena, TraceStartWhyCHAIN_GEN0CAP);
+        AVER(res == ResOK);
+        res = policyCondemnChain(&mortality,
+                                 firstChain,
+                                 topCondemnedGen,
+                                 trace);
+        if (res != ResOK) /* Should try some other trace really @@@@ */
+          goto failCondemn;
+        if (TraceIsEmpty(trace))
+          goto nothingCondemned;
+        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;

code/trace.c

@@ -637,9 +637,7 @@ static Res traceFlip(Trace trace)
   /* Update location dependency structures. */
   /* mayMove is a conservative approximation of the zones of objects */
   /* which may move during this collection. */
-  if(trace->mayMove != ZoneSetEMPTY) {
-    LDAge(arena, trace->mayMove);
-  }
+  LDAdvance(arena, trace->mayMove);
 
   /* .root.rank: At the moment we must scan all roots, because we don't have */
   /* a mechanism for shielding them.  There can't be any weak or final roots */