From 27e38efbdaecab003ac7bddfbab8289a6788adae Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Thu, 31 Mar 2016 23:41:46 +0100
Subject: [PATCH] Don't allow pools to whiten segments without condemning
 objects, so that a condemned size of zero implies no white segments, allowing
 quick trace destruction.

Copied from Perforce
 Change: 190607
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolams.c |  8 ++++++--
 mps/code/poolawl.c |  8 ++++++--
 mps/code/trace.c   | 25 ++++++++++++++++++++-----
 3 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 71701be7bee..af9ae20c407 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -1170,9 +1170,13 @@ static Res AMSWhiten(Pool pool, Trace trace, Seg seg)
   amsseg->newGrains = uncondemned;
   amsseg->marksChanged = FALSE; /* <design/poolams/#marked.condemn> */
   amsseg->ambiguousFixes = FALSE;
-  trace->condemned += AMSGrainsSize(ams, amsseg->oldGrains);
 
-  SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+  if (amsseg->oldGrains > 0) {
+    trace->condemned += AMSGrainsSize(ams, amsseg->oldGrains);
+    SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+  } else {
+    amsseg->colourTablesInUse = FALSE;
+  }
 
   return ResOK;
 }
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 42460f97056..eb61281526c 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -791,8 +791,12 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg)
   PoolGenAccountForAge(&awl->pgen, AWLGrainsSize(awl, awlseg->newGrains - uncondemned), FALSE);
   awlseg->oldGrains += awlseg->newGrains - uncondemned;
   awlseg->newGrains = uncondemned;
-  trace->condemned += AWLGrainsSize(awl, awlseg->oldGrains);
-  SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+
+  if (awlseg->oldGrains > 0) {
+    trace->condemned += AWLGrainsSize(awl, awlseg->oldGrains);
+    SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+  }
+  
   return ResOK;
 }
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 10517d89640..17e1061127a 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -339,7 +339,12 @@ static ZoneSet traceSetWhiteUnion(TraceSet ts, Arena arena)
 }
 
 
-/* TraceIsEmpty -- return TRUE if trace has no condemned segments */
+/* TraceIsEmpty -- return TRUE if trace has no condemned segments
+ *
+ * .empty.size: If the trace has a condemned size of zero, then it has
+ * no white segments, because we don't allow pools to whiten segments
+ * with no white objects in.
+ */
 
 Bool TraceIsEmpty(Trace trace)
 {
@@ -354,6 +359,7 @@ Res TraceAddWhite(Trace trace, Seg seg)
 {
   Res res;
   Pool pool;
+  Size condemnedBefore;
 
   AVERT(Trace, trace);
   AVERT(Seg, seg);
@@ -362,18 +368,25 @@ Res TraceAddWhite(Trace trace, Seg seg)
   pool = SegPool(seg);
   AVERT(Pool, pool);
 
+  condemnedBefore = trace->condemned;
+
   /* Give the pool the opportunity to turn the segment white. */
   /* If it fails, unwind. */
   res = PoolWhiten(pool, trace, seg);
   if(res != ResOK)
     return res;
 
-  /* Add the segment to the approximation of the white set if the */
-  /* pool made it white. */
-  if(TraceSetIsMember(SegWhite(seg), trace)) {
+  if (TraceSetIsMember(SegWhite(seg), trace)) {
+    /* Pools must not condemn empty segments, otherwise we can't tell
+       when a trace is empty and safe to destroy.  See .empty.size. */
+    AVER(trace->condemned > condemnedBefore);
+    
+    /* Add the segment to the approximation of the white set if the
+       pool made it white. */
     trace->white = ZoneSetUnion(trace->white, ZoneSetOfSeg(trace->arena, seg));
+
     /* if the pool is a moving GC, then condemned objects may move */
-    if(PoolHasAttr(pool, AttrMOVINGGC)) {
+    if (PoolHasAttr(pool, AttrMOVINGGC)) {
       trace->mayMove = ZoneSetUnion(trace->mayMove,
                                     ZoneSetOfSeg(trace->arena, seg));
     }
@@ -1532,11 +1545,13 @@ static Res traceCondemnAll(Trace trace)
       Ring segNode, nextSegNode;
       RING_FOR(segNode, PoolSegRing(pool), nextSegNode) {
         Seg seg = SegOfPoolRing(segNode);
+
         AVERT(Seg, seg);
 
         res = TraceAddWhite(trace, seg);
         if (res != ResOK)
           goto failBegin;
+
       }
     }
   }