New API function mps_pool_walk

code/amcss.c

@@ -128,6 +128,24 @@ static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pool,
 }
 
 
+/* area_scan -- area scanning function for mps_pool_walk */
+
+static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
+{
+  unsigned long *count = closure;
+  mps_res_t res;
+  while (base < limit) {
+    mps_addr_t prev = base;
+    ++ *count;
+    res = dylan_scan1(ss, &base);
+    if (res != MPS_RES_OK) return res;
+    Insist(prev < base);
+  }
+  Insist(base == limit);
+  return MPS_RES_OK;
+}
+
+
 /* test -- the body of the test */
 
 static void test(mps_pool_class_t pool_class, size_t roots_count)
@@ -225,11 +243,14 @@ static void test(mps_pool_class_t pool_class, size_t roots_count)
            "NULL in arena");
 
       if (collections == collectionsCOUNT / 2) {
-        unsigned long object_count = 0;
+        unsigned long count1 = 0, count2 = 0;
         mps_arena_park(arena);
-        mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
+        mps_arena_formatted_objects_walk(arena, test_stepper, &count1, 0);
+        die(mps_pool_walk(pool, area_scan, &count2), "mps_pool_walk");
         mps_arena_release(arena);
-        printf("stepped on %lu objects.\n", object_count);
+        printf("stepped on %lu objects.\n", count1);
+        printf("walked %lu objects.\n", count2);
+        Insist(count1 == count2);
       }
       if (collections == rampSwitch) {
         int begin_ramp = !ramping

code/amcssth.c

@@ -5,9 +5,9 @@
  * Portions copyright (c) 2002 Global Graphics Software.
  *
  * The main thread parks the arena half way through the test case and
- * runs mps_arena_formatted_objects_walk(). This checks that walking
- * works while the other threads continue to allocate in the
- * background.
+ * runs mps_pool_walk() and mps_arena_formatted_objects_walk(). This
+ * checks that walking works while the other threads continue to
+ * allocate in the background.
  */
 
 #include "fmtdy.h"
@@ -86,6 +86,24 @@ static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pool,
 }
 
 
+/* area_scan -- area scanning function for mps_pool_walk */
+
+static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
+{
+  unsigned long *count = closure;
+  mps_res_t res;
+  while (base < limit) {
+    mps_addr_t prev = base;
+    ++ *count;
+    res = dylan_scan1(ss, &base);
+    if (res != MPS_RES_OK) return res;
+    Insist(prev < base);
+  }
+  Insist(base == limit);
+  return MPS_RES_OK;
+}
+
+
 /* churn -- create an object and install into roots */
 
 static void churn(mps_ap_t ap, size_t roots_count)
@@ -209,11 +227,13 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count)
 
         if (collections >= collectionsCOUNT / 2 && !walked)
         {
-          unsigned long count = 0;
+          unsigned long count1 = 0, count2 = 0;
           mps_arena_park(arena);
-          mps_arena_formatted_objects_walk(arena, test_stepper, &count, 0);
+          mps_arena_formatted_objects_walk(arena, test_stepper, &count1, 0);
+          die(mps_pool_walk(pool, area_scan, &count2), "mps_pool_walk");
           mps_arena_release(arena);
-          printf("stepped on %lu objects.\n", count);
+          printf("stepped on %lu objects.\n", count1);
+          printf("walked %lu objects.\n", count2);
           walked = TRUE;
         }
         if (collections >= rampSwitch && !ramped) {

code/format.c

@@ -40,8 +40,7 @@ Bool FormatCheck(Format format)
 
 /* FormatNo methods -- default values for format keyword arguments */
 
-static mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base,
-                              mps_addr_t limit)
+mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base, mps_addr_t limit)
 {
     UNUSED(mps_ss);
     UNUSED(base);
@@ -191,36 +190,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)

code/locv.c

@@ -42,6 +42,23 @@ static mps_fmt_A_s locv_fmt =
 static mps_addr_t roots[4];
 
 
+/* area_scan -- area scanning function for mps_pool_walk */
+
+static mps_res_t area_scan(mps_ss_t ss, void *base, void *limit, void *closure)
+{
+  unsigned long *count = closure;
+  testlib_unused(ss);
+  while (base < limit) {
+    mps_addr_t prev = base;
+    ++ *count;
+    base = skip(base);
+    Insist(prev < base);
+  }
+  Insist(base == limit);
+  return MPS_RES_OK;
+}
+
+
 int main(int argc, char *argv[])
 {
   mps_arena_t arena;
@@ -85,9 +102,15 @@ int main(int argc, char *argv[])
   *(mps_word_t *)p = sizeof(void *);
   cdie(mps_commit(ap, p, sizeof(void *)), "commit last");
 
+  mps_arena_park(arena);
   {
     size_t count = 0;
     mps_arena_formatted_objects_walk(arena, stepper, &count, 0);
+    cdie(count == 4, "stepped 4 objects");
+  }
+  {
+    size_t count = 0;
+    die(mps_pool_walk(pool, area_scan, &count), "mps_pool_walk");
     cdie(count == 4, "walk 4 objects");
   }
 

code/mpm.h

@@ -354,10 +354,13 @@ 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);
 extern RefSet ScanStateSummary(ScanState ss);
+extern void ScanStateUpdateSummary(ScanState ss, Seg seg, Bool wasTotal);
 
 /* See impl.h.mpmst.ss */
 #define ScanStateZoneShift(ss)             ((Shift)(ss)->ss_s._zs)
@@ -449,6 +452,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 +812,7 @@ 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);
+extern mps_res_t FormatNoScan(mps_ss_t mps_ss, mps_addr_t base, mps_addr_t limit);
 
 
 /* Reference Interface -- see <code/ref.c> */

code/mpmst.h

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

code/mps.h

@@ -498,6 +498,7 @@ extern mps_res_t mps_pool_create_k(mps_pool_t *, mps_arena_t,
 extern void mps_pool_destroy(mps_pool_t);
 extern size_t mps_pool_total_size(mps_pool_t);
 extern size_t mps_pool_free_size(mps_pool_t);
+extern mps_res_t mps_pool_walk(mps_pool_t, mps_area_scan_t, void *);
 
 
 /* Chains */

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;

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,
-                     closure->ss,
-                     AddrAdd(p, format->headerSize),
-                     AddrAdd(next, format->headerSize));
+    res = TraceScanFormat(closure->ss,
+                          AddrAdd(p, 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;

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;

code/poollo.c

@@ -71,6 +71,7 @@ static Bool loSegBufferFill(Addr *baseReturn, Addr *limitReturn,
                             Seg seg, Size size, RankSet rankSet);
 static void loSegBufferEmpty(Seg seg, Buffer buffer);
 static Res loSegWhiten(Seg seg, Trace trace);
+static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss);
 static Res loSegFix(Seg seg, ScanState ss, Ref *refIO);
 static void loSegReclaim(Seg seg, Trace trace);
 static void loSegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
@@ -89,6 +90,7 @@ DEFINE_CLASS(Seg, LOSeg, klass)
   klass->bufferFill = loSegBufferFill;
   klass->bufferEmpty = loSegBufferEmpty;
   klass->whiten = loSegWhiten;
+  klass->scan = loSegScan;
   klass->fix = loSegFix;
   klass->fixEmergency = loSegFix;
   klass->reclaim = loSegReclaim;
@@ -646,6 +648,62 @@ static Res loSegWhiten(Seg seg, Trace trace)
 }
 
 
+static Res loSegScan(Bool *totalReturn, Seg seg, ScanState ss)
+{
+  LOSeg loseg = MustBeA(LOSeg, seg);
+  Pool pool = SegPool(seg);
+  Addr p, base, limit;
+  Buffer buffer;
+  Bool hasBuffer = SegBuffer(&buffer, seg);
+  Format format = NULL; /* suppress "may be used uninitialized" warning */
+  Bool b;
+
+  AVER(totalReturn != NULL);
+  AVERT(Seg, seg);
+  AVERT(ScanState, ss);
+
+  base = SegBase(seg);
+  limit = SegLimit(seg);
+
+  b = PoolFormat(&format, pool);
+  AVER(b);
+
+  p = base;
+  while (p < limit) {
+    Addr q;
+    Index i;
+
+    if (hasBuffer) {
+      if (p == BufferScanLimit(buffer)
+          && BufferScanLimit(buffer) != BufferLimit(buffer)) {
+        /* skip over buffered area */
+        p = BufferLimit(buffer);
+        continue;
+      }
+      /* since we skip over the buffered area we are always */
+      /* either before the buffer, or after it, never in it */
+      AVER(p < BufferGetInit(buffer) || BufferLimit(buffer) <= p);
+    }
+    i = PoolIndexOfAddr(base, pool, p);
+    if (!BTGet(loseg->alloc, i)) {
+      p = AddrAdd(p, PoolAlignment(pool));
+      continue;
+    }
+    q = (*format->skip)(AddrAdd(p, format->headerSize));
+    q = AddrSub(q, format->headerSize);
+    if (BTGet(loseg->mark, i)) {
+      Res res = TraceScanFormat(ss, p, q);
+      if (res != ResOK)
+        return res;
+    }
+    p = q;
+  }
+  AVER(p == limit);
+
+  return ResOK;
+}
+
+
 static Res loSegFix(Seg seg, ScanState ss, Ref *refIO)
 {
   LOSeg loseg = MustBeA_CRITICAL(LOSeg, seg);