Indirect formatted scanning through the scanstate.

This will allow us to reuse the scanning protocol with an arbitrary area
scanning function (replacing traceFormatScan) in order to implement
formatted object walking without an extra segment method.

Don't insist on scanning only grey segments: we want to be able to
reuse the scan protocol for walking, when the segments are black.

mps/code/format.c

@@ -191,36 +191,6 @@ Arena FormatArena(Format format)
 }
 
 
-/* FormatScan -- scan formatted objects for references
- *
- * This is a wrapper for formatted objects scanning functions, which
- * should not otherwise be called directly from within the MPS.  This
- * function checks arguments and takes care of accounting for the
- * scanned memory.
- *
- * c.f. TraceScanArea()
- */
-
-Res FormatScan(Format format, ScanState ss, Addr base, Addr limit)
-{
-  /* TODO: How critical are these? */
-  AVERT_CRITICAL(Format, format);
-  AVERT_CRITICAL(ScanState, ss);
-  AVER_CRITICAL(base != NULL);
-  AVER_CRITICAL(limit != NULL);
-  AVER_CRITICAL(base < limit);
-
-  /* TODO: EVENT here? */
-
-  /* scannedSize is accumulated whether or not format->scan succeeds,
-     so it's safe to accumulate now so that we can tail-call
-     format->scan. */
-  ss->scannedSize += AddrOffset(base, limit);
-
-  return format->scan(&ss->ss_s, base, limit);
-}
-
-
 /* FormatDescribe -- describe a format */
 
 Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)

mps/code/mpm.h

@@ -354,6 +354,8 @@ extern const char *MessageNoGCStartWhy(Message message);
 
 extern void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
                           Rank rank, ZoneSet white);
+extern void ScanStateInitSeg(ScanState ss, TraceSet ts, Arena arena,
+                             Rank rank, ZoneSet white, Seg seg);
 extern void ScanStateFinish(ScanState ss);
 extern Bool ScanStateCheck(ScanState ss);
 extern void ScanStateSetSummary(ScanState ss, RefSet summary);
@@ -449,6 +451,7 @@ extern void TraceIdMessagesDestroy(Arena arena, TraceId ti);
     } \
   END
 
+extern Res TraceScanFormat(ScanState ss, Addr base, Addr limit);
 extern Res TraceScanArea(ScanState ss, Word *base, Word *limit,
                          mps_area_scan_t scan_area,
                          void *closure);
@@ -808,7 +811,6 @@ extern Res FormatCreate(Format *formatReturn, Arena arena, ArgList args);
 extern void FormatDestroy(Format format);
 extern Arena FormatArena(Format format);
 extern Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth);
-extern Res FormatScan(Format format, ScanState ss, Addr base, Addr limit);
 
 
 /* Reference Interface -- see <code/ref.c> */

mps/code/mpmst.h

@@ -402,6 +402,8 @@ typedef struct ScanStateStruct {
   Sig sig;                      /* <design/sig> */
   struct mps_ss_s ss_s;         /* .ss <http://bash.org/?400459> */
   Arena arena;                  /* owning arena */
+  mps_area_scan_t formatScan;   /* formatted area scanning function */
+  void *formatScanClosure;      /* closure argument for .formatScan */
   SegFixMethod fix;             /* third stage fix function */
   void *fixClosure;             /* see .ss.fix-closure */
   TraceSet traces;              /* traces to scan for */

mps/code/poolamc.c

@@ -1277,7 +1277,7 @@ static Res amcSegScanNailedRange(Bool *totalReturn, Bool *moreReturn,
     Addr q;
     q = (*format->skip)(p);
     if ((*amc->pinned)(amc, board, p, q)) {
-      Res res = FormatScan(format, ss, p, q);
+      Res res = TraceScanFormat(ss, p, q);
       if(res != ResOK) {
         *totalReturn = FALSE;
         *moreReturn = TRUE;
@@ -1425,7 +1425,7 @@ static Res amcSegScan(Bool *totalReturn, Seg seg, ScanState ss)
       *totalReturn = TRUE;
       return ResOK;
     }
-    res = FormatScan(format, ss, base, limit);
+    res = TraceScanFormat(ss, base, limit);
     if(res != ResOK) {
       *totalReturn = FALSE;
       return res;
@@ -1438,7 +1438,7 @@ static Res amcSegScan(Bool *totalReturn, Seg seg, ScanState ss)
   AVER(SegBase(seg) <= base);
   AVER(base <= AddrAdd(SegLimit(seg), format->headerSize));
   if(base < limit) {
-    res = FormatScan(format, ss, base, limit);
+    res = TraceScanFormat(ss, base, limit);
     if(res != ResOK) {
       *totalReturn = FALSE;
       return res;

mps/code/poolams.c

@@ -1305,10 +1305,9 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
 
   /* @@@@ This isn't quite right for multiple traces. */
   if (closure->scanAllObjects || AMS_IS_GREY(seg, i)) {
-    res = FormatScan(format,
+    res = TraceScanFormat(closure->ss,
-                     closure->ss,
+                          AddrAdd(p, format->headerSize),
-                     AddrAdd(p, format->headerSize),
+                          AddrAdd(next, format->headerSize));
-                     AddrAdd(next, format->headerSize));
     if (res != ResOK)
       return res;
     if (!closure->scanAllObjects) {
@@ -1393,7 +1392,7 @@ static Res amsSegScan(Bool *totalReturn, Seg seg, ScanState ss)
             next = AddrAdd(p, alignment);
           }
           j = PoolIndexOfAddr(SegBase(seg), pool, next);
-          res = FormatScan(format, ss, clientP, clientNext);
+          res = TraceScanFormat(ss, clientP, clientNext);
           if (res != ResOK) {
             /* <design/poolams#.marked.scan.fail> */
             amsseg->marksChanged = TRUE;

mps/code/poolawl.c

@@ -852,7 +852,7 @@ static void awlSegBlacken(Seg seg, TraceSet traceSet)
 /* base and limit are both offset by the header size */
 
 static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
-                         Format format, Addr base, Addr limit)
+                         Addr base, Addr limit)
 {
   Res res;
   Bool dependent;       /* is there a dependent object? */
@@ -862,7 +862,6 @@ static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
   AVERT(Arena, arena);
   AVERT(AWL, awl);
   AVERT(ScanState, ss);
-  AVERT(Format, format);
   AVER(base != 0);
   AVER(base < limit);
 
@@ -875,7 +874,7 @@ static Res awlScanObject(Arena arena, AWL awl, ScanState ss,
       SegSetSummary(dependentSeg, RefSetUNIV);
   }
 
-  res = FormatScan(format, ss, base, limit);
+  res = TraceScanFormat(ss, base, limit);
 
   if (dependent)
     ShieldCover(arena, dependentSeg);
@@ -931,7 +930,7 @@ static Res awlSegScanSinglePass(Bool *anyScannedReturn, ScanState ss,
     /* <design/poolawl#.fun.scan.pass.object> */
     if (scanAllObjects
         || (BTGet(awlseg->mark, i) && !BTGet(awlseg->scanned, i))) {
-      Res res = awlScanObject(arena, awl, ss, pool->format,
+      Res res = awlScanObject(arena, awl, ss,
                               hp, objectLimit);
       if (res != ResOK)
         return res;

mps/code/poolsnc.c

@@ -508,19 +508,17 @@ static void sncSegBufferEmpty(Seg seg, Buffer buffer)
 static Res sncSegScan(Bool *totalReturn, Seg seg, ScanState ss)
 {
   Addr base, limit;
-  Format format;
   Res res;
 
   AVER(totalReturn != NULL);
   AVERT(ScanState, ss);
   AVERT(Seg, seg);
 
-  format = SegPool(seg)->format;
   base = SegBase(seg);
   limit = SegBufferScanLimit(seg);
 
   if (base < limit) {
-    res = FormatScan(format, ss, base, limit);
+    res = TraceScanFormat(ss, base, limit);
     if (res != ResOK) {
       *totalReturn = FALSE;
       return res;

mps/code/seg.c

@@ -771,9 +771,6 @@ Res SegScan(Bool *totalReturn, Seg seg, ScanState ss)
    * See <code/trace.c#scan.conservative> */
   AVER(ss->rank == RankEXACT || RankSetIsMember(SegRankSet(seg), ss->rank));
 
-  /* Should only scan segments which contain grey objects. */
-  AVER(TraceSetInter(SegGrey(seg), ss->traces) != TraceSetEMPTY);
-
   EVENT5(SegScan, seg, SegPool(seg), ss->arena, ss->traces, ss->rank);
   return Method(Seg, seg, scan)(totalReturn, seg, ss);
 }

mps/code/trace.c

@@ -37,6 +37,8 @@ Bool ScanStateCheck(ScanState ss)
   ZoneSet white;
 
   CHECKS(ScanState, ss);
+  CHECKL(FUNCHECK(ss->formatScan));
+  /* Can't check ss->formatScanClosure. */
   CHECKL(FUNCHECK(ss->fix));
   /* Can't check ss->fixClosure. */
   CHECKL(ScanStateZoneShift(ss) == ss->arena->zoneShift);
@@ -56,6 +58,23 @@ Bool ScanStateCheck(ScanState ss)
 }
 
 
+/* traceNoScan -- Area scan method that must not be called. */
+
+static mps_res_t traceNoScan(mps_ss_t ss, void *base, void *limit, void *closure)
+{
+  UNUSED(ss);
+
+  AVER(base != NULL);
+  AVER(limit != NULL);
+  AVER(base < limit);
+  AVER(closure == UNUSED_POINTER);
+
+  NOTREACHED;
+
+  return MPS_RES_UNIMPL;
+}
+
+
 /* ScanStateInit -- Initialize a ScanState object */
 
 void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
@@ -91,6 +110,8 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
   if (ss->fix == SegFix && ArenaEmergency(arena))
         ss->fix = SegFixEmergency;
 
+  ss->formatScan = traceNoScan;
+  ss->formatScanClosure = UNUSED_POINTER;
   ss->rank = rank;
   ss->traces = ts;
   ScanStateSetZoneShift(ss, arena->zoneShift);
@@ -114,6 +135,40 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
 }
 
 
+/* traceFormatScan -- Area scan method that dispatches to a format scan.
+ *
+ * This is a wrapper for formatted object scanning functions, which
+ * should not otherwise be called directly from within the MPS.
+ */
+static mps_res_t traceFormatScan(mps_ss_t mps_ss, void *base, void *limit, void *closure)
+{
+  Format format = closure;
+
+  AVER_CRITICAL(base != NULL);
+  AVER_CRITICAL(limit != NULL);
+  AVER_CRITICAL(base < limit);
+  AVERT_CRITICAL(Format, format);
+
+  return format->scan(mps_ss, base, limit);
+}
+
+
+/* ScanStateInitSeg -- Initialize a ScanState object for scanning a segment */
+
+void ScanStateInitSeg(ScanState ss, TraceSet ts, Arena arena,
+                      Rank rank, ZoneSet white, Seg seg)
+{
+  Format format;
+  AVERT(Seg, seg);
+
+  ScanStateInit(ss, ts, arena, rank, white);
+  if (PoolFormat(&format, SegPool(seg))) {
+    ss->formatScan = traceFormatScan;
+    ss->formatScanClosure = format;
+  }
+}
+
+
 /* ScanStateFinish -- Finish a ScanState object */
 
 void ScanStateFinish(ScanState ss)
@@ -1141,7 +1196,7 @@ static Res traceScanSegRes(TraceSet ts, Rank rank, Arena arena, Seg seg)
   } else {      /* scan it */
     ScanStateStruct ssStruct;
     ScanState ss = &ssStruct;
-    ScanStateInit(ss, ts, arena, rank, white);
+    ScanStateInitSeg(ss, ts, arena, rank, white, seg);
 
     /* Expose the segment to make sure we can scan it. */
     ShieldExpose(arena, seg);
@@ -1473,16 +1528,36 @@ void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
 }
 
 
+/* TraceScanFormat -- scan a formatted area of memory for references
+ *
+ * This is a wrapper for format scanning functions, which should not
+ * otherwise be called directly from within the MPS.  This function
+ * checks arguments and takes care of accounting for the scanned
+ * memory.
+ */
+Res TraceScanFormat(ScanState ss, Addr base, Addr limit)
+{
+  AVERT_CRITICAL(ScanState, ss);
+  AVER_CRITICAL(base != NULL);
+  AVER_CRITICAL(limit != NULL);
+  AVER_CRITICAL(base < limit);
+
+  /* scannedSize is accumulated whether or not ss->formatScan
+   * succeeds, so it's safe to accumulate now so that we can tail-call
+   * ss->formatScan. */
+  ss->scannedSize += AddrOffset(base, limit);
+
+  return ss->formatScan(&ss->ss_s, base, limit, ss->formatScanClosure);
+}
+
+
 /* TraceScanArea -- scan an area of memory for references
  *
  * This is a wrapper for area scanning functions, which should not
  * otherwise be called directly from within the MPS.  This function
  * checks arguments and takes care of accounting for the scanned
  * memory.
- *
- * c.f. FormatScan()
  */
-
 Res TraceScanArea(ScanState ss, Word *base, Word *limit,
                   mps_area_scan_t scan_area,
                   void *closure)

mps/design/seg.txt

@@ -312,15 +312,15 @@ called via the generic function ``SegBlacken()``.
 ``typedef Res (*SegScanMethod)(Bool *totalReturn, Seg seg, ScanState ss)``
 
 _`.method.scan`: The ``scan`` method scans all the grey objects on the
-segment ``seg``, passing the scan state ``ss`` to ``FormatScan``. The
+segment ``seg``, passing the scan state ``ss`` to
-segment may additionally accumulate a summary of *all* its objects. If
+``TraceScanFormat()``. The segment may additionally accumulate a
-it succeeds in accumulating such a summary it must indicate that it
+summary of *all* its objects. If it succeeds in accumulating such a
-has done so by setting the ``*totalReturn`` parameter to ``TRUE``.
+summary it must indicate that it has done so by setting the
-Otherwise it must set ``*totalReturn`` to ``FALSE``. Segment classes
+``*totalReturn`` parameter to ``TRUE``. Otherwise it must set
-are not required to provide this method, and not doing so indicates
+``*totalReturn`` to ``FALSE``. Segment classes are not required to
-that all instances of this class will have no fixable or traceable
+provide this method, and not doing so indicates that all instances of
-references in them. This method is called via the generic function
+this class will have no fixable or traceable references in them. This
-``SegScan()``.
+method is called via the generic function ``SegScan()``.
 
 ``typedef Res (*SegFixMethod)(Seg seg, ScanState ss, Ref *refIO)``
 

mps/design/sp.txt

@@ -95,7 +95,8 @@ Args  Locals  Function
    4       9  ``traceScanSegRes()``
    4       0  ``SegScan()``
    4       5  ``amcSegScan()``
-   4       0  ``FormatScan()``
+   3       0  ``TraceScanFormat()``
+   4       1  ``traceFormatScan()``
    3     ≤64  ``format->scan()``
    3       0  ``SegFix()``
    4      15  ``amcSegFix()``
@@ -113,12 +114,12 @@ Args  Locals  Function
    3       7  ``SplaySplay()``
    4       8  ``SplaySplitDown()``
    3       0  ``SplayZig()``
- 112    ≤258  **Total**
+ 115    ≤259  **Total**
 ====  ======  ========================
 
 We expect that a compiler will not need to push all local variables
 onto the stack, but even in the case where it pushes all of them, this
-call requires no more than 370 words of stack space.
+call requires no more than 374 words of stack space.
 
 This isn't necessarily the deepest call into the MPS (the MPS's
 modular design and class system makes it hard to do a complete