3 files changed, 31 insertions, 38 deletions

diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index fc71144ab84..15bbf4aaba4 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -1664,8 +1664,7 @@ static void amcFixInPlace(Pool pool, Seg seg, ScanState ss, Ref *refIO)
     return;
   }
   SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces));
-  if(SegRankSet(seg) != RankSetEMPTY)
-    SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
+  SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
 }
 
 
@@ -1727,9 +1726,6 @@ Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   Buffer buffer;       /* buffer to allocate new copy into */
   amcGen gen;          /* generation of old copy of object */
   TraceSet grey;       /* greyness of object being relocated */
-  TraceSet toGrey;     /* greyness of object's destination */
-  RefSet summary;      /* summary of object being relocated */
-  RefSet toSummary;    /* summary of object's destination */
   Seg toSeg;           /* segment to which object is being relocated */
 
   /* <design/trace/#fix.noaver> */
@@ -1786,9 +1782,7 @@ Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
       /* Segment only needs greying if there are new traces for */
       /* which we are nailing. */
       if(!TraceSetSub(ss->traces, SegNailed(seg))) {
-        if(SegRankSet(seg) != RankSetEMPTY) {
-          SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
-        }
+        SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
         SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces));
       }
       res = ResOK;
@@ -1823,16 +1817,8 @@ Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
       /* Since we're moving an object from one segment to another, */
       /* union the greyness and the summaries together. */
       grey = TraceSetUnion(ss->traces, SegGrey(seg));
-      toGrey = SegGrey(toSeg);
-      if(TraceSetDiff(grey, toGrey) != TraceSetEMPTY
-          && SegRankSet(seg) != RankSetEMPTY) {
-        SegSetGrey(toSeg, TraceSetUnion(toGrey, grey));
-      }
-      summary = SegSummary(seg);
-      toSummary = SegSummary(toSeg);
-      if(RefSetDiff(summary, toSummary) != RefSetEMPTY) {
-        SegSetSummary(toSeg, RefSetUnion(toSummary, summary));
-      }
+      SegSetGrey(toSeg, TraceSetUnion(SegGrey(toSeg), grey));
+      SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
 
       /* <design/trace/#fix.copy> */
       (void)AddrCopy(newRef, ref, length);  /* .exposed.seg */
@@ -1877,9 +1863,6 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   Buffer buffer;       /* buffer to allocate new copy into */
   amcGen gen;          /* generation of old copy of object */
   TraceSet grey;       /* greyness of object being relocated */
-  TraceSet toGrey;     /* greyness of object's destination */
-  RefSet summary;      /* summary of object being relocated */
-  RefSet toSummary;    /* summary of object's destination */
   Seg toSeg;           /* segment to which object is being relocated */
 
   /* <design/trace/#fix.noaver> */
@@ -1937,8 +1920,7 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
       /* Segment only needs greying if there are new traces for */
       /* which we are nailing. */
       if(!TraceSetSub(ss->traces, SegNailed(seg))) {
-        if(SegRankSet(seg) != RankSetEMPTY)
-          SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
+        SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
         SegSetNailed(seg, TraceSetUnion(SegNailed(seg), ss->traces));
       }
       res = ResOK;
@@ -1976,14 +1958,8 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
       /* Since we're moving an object from one segment to another, */
       /* union the greyness and the summaries together. */
       grey = TraceSetUnion(ss->traces, SegGrey(seg));
-      toGrey = SegGrey(toSeg);
-      if(TraceSetDiff(grey, toGrey) != TraceSetEMPTY
-          && SegRankSet(seg) != RankSetEMPTY)
-        SegSetGrey(toSeg, TraceSetUnion(toGrey, grey));
-      summary = SegSummary(seg);
-      toSummary = SegSummary(toSeg);
-      if(RefSetDiff(summary, toSummary) != RefSetEMPTY)
-        SegSetSummary(toSeg, RefSetUnion(toSummary, summary));
+      SegSetGrey(toSeg, TraceSetUnion(SegGrey(toSeg), grey));
+      SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
 
       /* <design/trace/#fix.copy> */
       (void)AddrCopy(newBase, AddrSub(ref, headerSize), length);  /* .exposed.seg */
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 36952dc9e99..051abc03c79 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -267,7 +267,12 @@ void SegSetGrey(Seg seg, TraceSet grey)
 {
   AVERT(Seg, seg);
   AVER(TraceSetCheck(grey));
-  seg->class->setGrey(seg, grey);
+  AVER(SegRankSet(seg) != RankSetEMPTY);
+
+  /* Don't dispatch to the class method if there's no actual change in
+     greyness, or if the segment doesn't contain any references. */
+  if (grey != SegGrey(seg) && SegRankSet(seg) != RankSetEMPTY)
+    seg->class->setGrey(seg, grey);
 }
 
 
@@ -295,6 +300,7 @@ void SegSetRankSet(Seg seg, RankSet rankSet)
 {
   AVERT(Seg, seg);
   AVER(RankSetCheck(rankSet));
+  AVER(rankSet != RankSetEMPTY || SegSummary(seg) == RefSetEMPTY);
   seg->class->setRankSet(seg, rankSet);
 }
 
@@ -304,11 +310,13 @@ void SegSetRankSet(Seg seg, RankSet rankSet)
 void SegSetSummary(Seg seg, RefSet summary)
 {
   AVERT(Seg, seg);
+  AVER(summary == RefSetEMPTY || SegRankSet(seg) != RankSetEMPTY);
 
 #ifdef PROTECTION_NONE
   summary = RefSetUNIV;
 #endif
-  seg->class->setSummary(seg, summary);
+  if (summary != SegSummary(seg))
+    seg->class->setSummary(seg, summary);
 }
 
 
@@ -1150,6 +1158,10 @@ static void gcSegSetGreyInternal(Seg seg, TraceSet oldGrey, TraceSet grey)
       AVER(RankSetIsSingle(seg->rankSet));
       for(rank = 0; rank < RankLIMIT; ++rank)
         if (RankSetIsMember(seg->rankSet, rank)) {
+          /* NOTE: We push the segment onto the front of the queue, so that
+             we preserve some locality of scanning, and so that we tend to
+             forward objects that are closely linked to the same or nearby
+             segments. */
           RingInsert(ArenaGreyRing(arena, rank), &gcseg->greyRing);
           break;
         }
diff --git a/mps/code/trace.c b/mps/code/trace.c
index bb4d4f1cd99..e7ab41c8d80 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -525,13 +525,15 @@ static Res rootFlip(Root root, void *p)
  * The main job of traceFlip is to scan references which can't be protected
  * from the mutator, changing the colour of the mutator from grey to black
  * with respect to a trace.  The mutator threads are suspended while this
- * is happening, and the mutator perceives and instantaneous change in all
+ * is happening, and the mutator perceives an instantaneous change in all
  * the references, enforced by the shield (barrier) system.
  *
  * NOTE: We don't have a way to shield the roots, so they are all scanned
- * here.  This is a coincidence.  There is no particular reason that the
- * roots have to be scanned at flip time.  (The thread registers are unlikely
- * ever to be protectable on stock hardware, however.)
+ * here.  This is a coincidence.  There is no theoretical reason that the
+ * roots have to be scanned at flip time, provided we could protect them
+ * from the mutator.  (The thread registers are unlikely ever to be
+ * protectable on stock hardware, however, as they were -- kind of -- on
+ * Lisp machines.)
  *
  * NOTE: Ambiguous references may only exist in roots, because we can't
  * shield the exact roots and defer them for later scanning (after ambiguous
@@ -1254,9 +1256,12 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
     Trace trace;
     TraceId ti;
     Rank rank;
+    TraceSet traces;
+
+    AVER(SegRankSet(seg) != RankSetEMPTY);
     
     /* Pick set of traces to scan for: */
-    TraceSet traces = arena->flippedTraces;
+    traces = arena->flippedTraces;
     rank = TraceRankForAccess(arena, seg);
     res = traceScanSeg(traces, rank, arena, seg);