4 files changed, 89 insertions, 18 deletions

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 263cb795e5d..d9e379a3537 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -378,6 +378,7 @@ extern void TraceStart(Trace trace, double mortality,
                        double finishingTime);
 extern Size TracePoll(Globals globals);
 
+extern Rank TraceRankForAccess(Arena arena, Seg seg);
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
 extern Res TraceFix(ScanState ss, Ref *refIO);
 extern Res TraceFixEmergency(ScanState ss, Ref *refIO);
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 55e70ff1462..ad96054f7f0 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -393,12 +393,10 @@ Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   /* The segment must belong to the pool. */
   AVER(pool == SegPool(seg));
 
-  /* We actually want to check that the rank we are scanning at */
-  /* (ss->rank) is at least as big as all the ranks in */
-  /* the segment (SegRankSet(seg)).  It is tricky to check that, */
-  /* so we only check that either ss->rank is in the segment's */
-  /* ranks, or that ss->rank is exact. */
-  /* See <code/trace.c#scan.conservative> */
+  /* We check that either ss->rank is in the segment's
+   * ranks, or that ss->rank is exact.  The check is more complicated if
+   * we actually have multiple ranks in a seg.
+   * See <code/trace.c#scan.conservative> */
   AVER(ss->rank == RankEXACT || RankSetIsMember(SegRankSet(seg), ss->rank));
 
   /* Should only scan segments which contain grey objects. */
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 80b7f5323be..9834feb711d 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -413,9 +413,12 @@ Res PoolSingleAccess(Pool pool, Seg seg, Addr addr,
       /* Check that the reference is aligned to a word boundary */
       /* (we assume it is not a reference otherwise). */
       if(WordIsAligned((Word)ref, sizeof(Word))) {
-        /* See the note in TraceSegAccess about using RankEXACT here */
+        Rank rank;
+        /* See the note in TraceRankForAccess */
         /* (<code/trace.c#scan.conservative>). */
-        TraceScanSingleRef(arena->flippedTraces, RankEXACT, arena,
+        
+        rank = TraceRankForAccess(arena, seg);
+        TraceScanSingleRef(arena->flippedTraces, rank, arena,
                            seg, (Ref *)addr);
       }
     }
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 0f8d84ba3ac..3fddaec8d33 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -827,7 +827,75 @@ static void traceReclaim(Trace trace)
   (void)TraceIdMessagesCreate(arena, trace->ti);
 }
 
+/* TraceRankForAccess -- Returns rank to scan at if we hit a barrier.
+ * 
+ * We assume a single trace as otherwise we need to implement rank
+ * filters on scanning.
+ *
+ * .scan.conservative: It's safe to scan at EXACT unless the band is
+ * WEAK and in that case the segment should be weak.
+ * 
+ * If the trace band is EXACT then we scan EXACT. This might prevent
+ * finalisation messages and may preserve objects pointed to only by weak
+ * references but tough luck -- the mutator wants to look.
+ * 
+ * If the trace band is FINAL and the segment is FINAL, we scan it FINAL.
+ * Any objects not yet preserved deserve to die, and we're only giving
+ * them a temporary reprieve.  All the objects on the segment should be FINAL,
+ * otherwise they might get sent finalization messages.
+ *
+ * If the trace band is FINAL, and the segment is not FINAL, we scan at EXACT.
+ * This is safe to do for FINAL and WEAK references.
+ * 
+ * If the trace band is WEAK then the segment must be weak only, and we 
+ * scan at WEAK.  All other segments for this trace should be scanned by now.
+ * We must scan at WEAK to avoid bringing any objects back to life.
+ * 
+ * See the message <http://info.ravenbrook.com/mail/2012/08/30/16-46-42/0.txt>
+ * for a description of these semantics.
+ */
+Rank TraceRankForAccess(Arena arena, Seg seg)
+{
+  TraceSet ts;
+  Trace trace;
+  TraceId ti;
+  Rank band;
+  RankSet rankSet;
 
+  AVERT(Arena, arena);
+  AVERT(Seg, seg);
+
+  band = RankAMBIG; /* initialize band to avoid warning */
+  ts = arena->flippedTraces;    
+  AVER(TraceSetIsSingle(ts));
+  TRACE_SET_ITER(ti, trace, ts, arena)
+    band = traceBand(trace);
+  TRACE_SET_ITER_END(ti, trace, ts, arena);
+  rankSet = SegRankSet(seg);
+  switch(band) {
+  case RankAMBIG:
+    NOTREACHED;
+    break;
+  case RankEXACT:
+    return RankEXACT;
+  case RankFINAL:
+    if(rankSet == RankSetSingle(RankFINAL)) {
+      return RankFINAL;
+    }
+    /* It's safe to scan at exact in the final band so do so if there are
+     * any non-final references. */
+    return RankEXACT;
+  case RankWEAK:
+    AVER(rankSet == RankSetSingle(RankWEAK));
+    return RankWEAK;
+  default:
+    NOTREACHED;
+    break;
+  }
+  NOTREACHED;
+  return RankEXACT;
+}
+ 
 /* traceFindGrey -- find a grey segment
  *
  * This function finds the next segment to scan.  It does this according
@@ -870,7 +938,10 @@ static void traceReclaim(Trace trace)
  * whilst working in this band.  That's what we check, although we
  * expect to have to change the check if we introduce more ranks, or
  * start changing the semantics of them.  A flag is used to implement
- * this check.
+ * this check.  See <http://info.ravenbrook.com/project/mps/issue/job001658/>.
+ * 
+ * For further discussion on the semantics of rank based tracing see
+ * <http://info.ravenbrook.com/mail/2007/06/25/11-35-57/0.txt>
  */
 
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
@@ -1131,8 +1202,6 @@ static void traceScanSeg(TraceSet ts, Rank rank, Arena arena, Seg seg)
 
 void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
 {
-  TraceId ti;
-
   AVERT(Arena, arena);
   AVERT(Seg, seg);
 
@@ -1149,13 +1218,15 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
   EVENT_PPU(TraceAccess, arena, seg, mode);
 
   if((mode & SegSM(seg) & AccessREAD) != 0) {   /* read barrier? */
+    Trace trace;
+    TraceId ti;
+    Rank rank;
+    
     /* Pick set of traces to scan for: */
     TraceSet traces = arena->flippedTraces;
-
-    /* .scan.conservative: At the moment we scan at RankEXACT.  Really */
-    /* we should be scanning at the "phase" of the trace, which is the */
-    /* minimum rank of all grey segments. (see request.mps.170160) */
-    traceScanSeg(traces, RankEXACT, arena, seg);
+    
+    rank = TraceRankForAccess(arena, seg);
+    traceScanSeg(traces, rank, arena, seg);      
 
     /* The pool should've done the job of removing the greyness that */
     /* was causing the segment to be protected, so that the mutator */
@@ -1163,8 +1234,6 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
     AVER(TraceSetInter(SegGrey(seg), traces) == TraceSetEMPTY);
 
     STATISTIC_STAT({
-      Trace trace;
-
       TRACE_SET_ITER(ti, trace, traces, arena)
         ++trace->readBarrierHitCount;
       TRACE_SET_ITER_END(ti, trace, traces, arena);