From b6b306bb484970bbc949529b576f7ec4911eed06 Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Mon, 24 Feb 2014 23:40:50 +0000
Subject: [PATCH 01/70] Pass range bases directly as treekeys, speeding up
 cbscompare and most cbs operations.

Copied from Perforce
 Change: 184500
 ServerID: perforce.ravenbrook.com
---
 mps/code/cbs.c | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index f20896b97b7..1938e74683d 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -31,7 +31,14 @@ typedef struct CBSBlockStruct *CBSBlock;
 #define cbsBlockOfNode(_node) PARENT(CBSBlockStruct, node, (_node))
 #define treeOfCBS(cbs) (&((cbs)->tree))
 #define nodeOfCBSBlock(block) (&((block)->node))
-#define keyOfCBSBlock(block) (&((block)->base))
+
+/* We pass the block base directly as a TreeKey (void *) assuming that
+   Addr can be encoded, and possibly breaking <design/type/#addr.use>.
+   On an exotic platform where this isn't true, pass the address of base.
+   i.e. add an & */
+#define keyOfCBSBlock(block)  ((TreeKey)(block)->base)
+#define keyOfBaseVar(baseVar) ((TreeKey)(baseVar))
+#define baseOfKey(key)        ((Addr)(key))
 
 
 /* cbsEnter, cbsLeave -- Avoid re-entrance
@@ -102,9 +109,10 @@ static Compare cbsCompare(Tree node, TreeKey key)
   Addr base1, base2, limit2;
   CBSBlock cbsBlock;
 
-  AVER(node != NULL);
+  AVERT_CRITICAL(Tree, node);
+  AVER_CRITICAL(key != NULL);
 
-  base1 = *(Addr *)key;
+  base1 = baseOfKey(key);
   cbsBlock = cbsBlockOfNode(node);
   base2 = cbsBlock->base;
   limit2 = cbsBlock->limit;
@@ -410,7 +418,7 @@ static Res cbsInsertIntoTree(Range rangeReturn, CBS cbs, Range range)
   limit = RangeLimit(range);
 
   METER_ACC(cbs->treeSearch, cbs->treeSize);
-  b = SplayTreeNeighbours(&leftSplay, &rightSplay, treeOfCBS(cbs), &base);
+  b = SplayTreeNeighbours(&leftSplay, &rightSplay, treeOfCBS(cbs), keyOfBaseVar(base));
   if (!b) {
     res = ResFAIL;
     goto fail;
@@ -528,7 +536,7 @@ static Res cbsDeleteFromTree(Range rangeReturn, CBS cbs, Range range)
   limit = RangeLimit(range);
 
   METER_ACC(cbs->treeSearch, cbs->treeSize);
-  if (!SplayTreeFind(&node, treeOfCBS(cbs), (void *)&base)) {
+  if (!SplayTreeFind(&node, treeOfCBS(cbs), keyOfBaseVar(base))) {
     res = ResFAIL;
     goto failSplayTreeSearch;
   }

From c859df7e49fcc8bc0efc9971c28daae8e2ddbcaa Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 15 Apr 2014 13:05:10 +0100
Subject: [PATCH 02/70] Branching master to branch/2014-04-15/mvffnoseg.

Copied from Perforce
 Change: 185560
 ServerID: perforce.ravenbrook.com

From 4b49fc7d579cac77ca8a8fdb1a5b2b19f79289ca Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 15 Apr 2014 17:52:14 +0100
Subject: [PATCH 03/70] Mvff no longer uses segments, but instead maintains the
 address ranges it has acquired from the arena in a cbs.

Copied from Perforce
 Change: 185574
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c     | 275 +++++++++++++++++++---------------------
 mps/design/poolmvff.txt |  26 ++--
 2 files changed, 143 insertions(+), 158 deletions(-)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 4fb5c5ce724..365f4f02595 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -6,8 +6,7 @@
  *
  * .purpose: This is a pool class for manually managed objects of
  * variable size where address-ordered first fit is an appropriate
- * policy.  Provision is made to allocate in reverse.  This pool
- * can allocate across segment boundaries.
+ * policy.  Provision is made to allocate in reverse.
  *
  * .design: <design/poolmvff>
  *
@@ -43,12 +42,11 @@ extern PoolClass PoolClassMVFF(void);
 typedef struct MVFFStruct *MVFF;
 typedef struct MVFFStruct {     /* MVFF pool outer structure */
   PoolStruct poolStruct;        /* generic structure */
-  SegPref segPref;              /* the preferences for segments */
-  Size extendBy;                /* segment size to extend pool by */
-  Size minSegSize;              /* minimum size of segment */
+  SegPref segPref;              /* the preferences for allocation */
+  Size extendBy;                /* size of range to extend pool by */
   Size avgSize;                 /* client estimate of allocation size */
-  Size total;                   /* total bytes in pool */
-  CBSStruct cbsStruct;          /* free list */
+  CBSStruct allocCBSStruct;     /* allocated memory ranges */
+  CBSStruct freeCBSStruct;      /* free list */
   FreelistStruct flStruct;      /* emergency free list */
   FailoverStruct foStruct;      /* fail-over mechanism */
   Bool firstFit;                /* as opposed to last fit */
@@ -59,7 +57,8 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
 
 #define Pool2MVFF(pool)   PARENT(MVFFStruct, poolStruct, pool)
 #define MVFF2Pool(mvff)       (&((mvff)->poolStruct))
-#define CBSOfMVFF(mvff)      (&((mvff)->cbsStruct.landStruct))
+#define AllocCBSOfMVFF(mvff) (&((mvff)->allocCBSStruct.landStruct))
+#define FreeCBSOfMVFF(mvff)  (&((mvff)->freeCBSStruct.landStruct))
 #define FreelistOfMVFF(mvff) (&((mvff)->flStruct.landStruct))
 #define FailoverOfMVFF(mvff) (&((mvff)->foStruct.landStruct))
 
@@ -83,8 +82,8 @@ typedef MVFFDebugStruct *MVFFDebug;
 /* MVFFInsert -- add given range to free lists
  *
  * Updates MVFF counters for additional free space. Returns maximally
- * coalesced range containing given range. Does not attempt to free
- * segments (see MVFFFreeSegs).
+ * coalesced range containing given range. Does not attempt to return
+ * memory to the arena (see MVFFFreeTracts).
  */
 static Res MVFFInsert(Range rangeIO, MVFF mvff) {
   AVERT(Range, rangeIO);
@@ -94,89 +93,67 @@ static Res MVFFInsert(Range rangeIO, MVFF mvff) {
 }
 
 
-/* MVFFFreeSegs -- free segments from given range
+/* MVFFFreeTracts -- free tracts from given range
  *
- * Given a free range, attempts to find entire segments within it, and
- * returns them to the arena, updating total size counter.
+ * Given a free range, attempts to find entire tracts within it, and
+ * returns them to the arena.
  *
  * This is usually called immediately after MVFFInsert. It is not
  * combined with MVFFInsert because the latter is also called when new
  * segments are added under MVFFAlloc.
  */
-static void MVFFFreeSegs(MVFF mvff, Range range)
+static void MVFFFreeTracts(MVFF mvff, Range range)
 {
-  Seg seg = NULL;       /* suppress "may be used uninitialized" */
+  Pool pool;
   Arena arena;
-  Bool b;
-  Addr segLimit;  /* limit of the current segment when iterating */
-  Addr segBase;   /* base of the current segment when iterating */
+  RangeStruct freeRange, oldRange;
   Res res;
 
   AVERT(MVFF, mvff);
   AVERT(Range, range);
-  /* Could profitably AVER that the given range is free, */
-  /* but the CBS doesn't provide that facility. */
+  /* Could profitably AVER that the given range is free,
+   * but lands don't provide that facility. */
 
-  if (RangeSize(range) < mvff->minSegSize)
-    return; /* not large enough for entire segments */
+  if (RangeSize(range) < mvff->extendBy)
+    return; /* not large enough to be worth returning */
 
-  arena = PoolArena(MVFF2Pool(mvff));
-  b = SegOfAddr(&seg, arena, RangeBase(range));
-  AVER(b);
+  pool = MVFF2Pool(mvff);
+  arena = PoolArena(pool);
+  RangeInit(&freeRange, AddrAlignUp(RangeBase(range), ArenaAlign(arena)),
+            AddrAlignDown(RangeLimit(range), ArenaAlign(arena)));
+  if (RangeIsEmpty(&freeRange))
+    return;
 
-  segBase = SegBase(seg);
-  segLimit = SegLimit(seg);
+  /* Delete range from allocated list. */
+  res = LandDelete(&oldRange, AllocCBSOfMVFF(mvff), &freeRange);
+  if (res != ResOK)
+    /* Can't delete the range, so postpone returning it to the arena. */
+    return;
+  ArenaFree(RangeBase(&freeRange), RangeSize(&freeRange), pool);
 
-  while(segLimit <= RangeLimit(range)) { /* segment ends in range */
-    if (segBase >= RangeBase(range)) { /* segment starts in range */
-      RangeStruct delRange, oldRange;
-      RangeInit(&delRange, segBase, segLimit);
-
-      res = LandDelete(&oldRange, FailoverOfMVFF(mvff), &delRange);
-      AVER(res == ResOK);
-      AVER(RangesNest(&oldRange, &delRange));
-
-      /* Can't free the segment earlier, because if it was on the
-       * Freelist rather than the CBS then it likely contains data
-       * that needs to be read in order to update the Freelist. */
-      SegFree(seg);
-
-      AVER(mvff->total >= RangeSize(&delRange));
-      mvff->total -= RangeSize(&delRange);
-    }
-
-    /* Avoid calling SegNext if the next segment would fail */
-    /* the loop test, mainly because there might not be a */
-    /* next segment. */
-    if (segLimit == RangeLimit(range)) /* segment ends at end of range */
-      break;
-
-    b = SegFindAboveAddr(&seg, arena, segBase);
-    AVER(b);
-    segBase = SegBase(seg);
-    segLimit = SegLimit(seg);
-  }
-
-  return;
+  /* ... and from the free list too. */
+  res = LandDelete(&oldRange, FailoverOfMVFF(mvff), &freeRange);
+  AVER(res == ResOK);
 }
 
 
-/* MVFFAddSeg -- Allocates a new segment from the arena
+/* MVFFAddRange -- allocate a new range from the arena
  *
- * Allocates a new segment from the arena (with the given
+ * Allocate a new range from the arena (with the given
  * withReservoirPermit flag) of at least the specified size. The
- * specified size should be pool-aligned. Adds it to the free lists.
+ * specified size should be pool-aligned. Add it to the allocated and
+ * free lists.
  */
-static Res MVFFAddSeg(Seg *segReturn,
-                      MVFF mvff, Size size, Bool withReservoirPermit)
+static Res MVFFAddRange(Range rangeReturn, MVFF mvff, Size size,
+                        Bool withReservoirPermit)
 {
   Pool pool;
   Arena arena;
-  Size segSize;
-  Seg seg;
-  Res res;
+  Size allocSize;
   Align align;
-  RangeStruct range;
+  RangeStruct range, coalescedRange;
+  Addr base;
+  Res res;
 
   AVERT(MVFF, mvff);
   AVER(size > 0);
@@ -191,36 +168,38 @@ static Res MVFFAddSeg(Seg *segReturn,
   /* Use extendBy unless it's too small (see */
   /* <design/poolmvff/#design.seg-size>). */
   if (size <= mvff->extendBy)
-    segSize = mvff->extendBy;
+    allocSize = mvff->extendBy;
   else
-    segSize = size;
+    allocSize = size;
 
-  segSize = SizeAlignUp(segSize, align);
+  allocSize = SizeAlignUp(allocSize, align);
 
-  res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool,
-                 withReservoirPermit, argsNone);
+  res = ArenaAlloc(&base, mvff->segPref, allocSize, pool, withReservoirPermit);
   if (res != ResOK) {
-    /* try again for a seg just large enough for object */
+    /* try again with a range just large enough for object */
     /* see <design/poolmvff/#design.seg-fail> */
-    segSize = SizeAlignUp(size, align);
-    res = SegAlloc(&seg, SegClassGet(), mvff->segPref, segSize, pool,
-                   withReservoirPermit, argsNone);
-    if (res != ResOK) {
+    allocSize = SizeAlignUp(size, align);
+    res = ArenaAlloc(&base, mvff->segPref, allocSize, pool,
+                     withReservoirPermit);
+    if (res != ResOK)
       return res;
-    }
   }
 
-  mvff->total += segSize;
-  RangeInitSize(&range, SegBase(seg), segSize);
+  RangeInitSize(&range, base, allocSize);
+  res = LandInsert(&coalescedRange, AllocCBSOfMVFF(mvff), &range);
+  if (res != ResOK) {
+    /* Can't record this memory, so return it to the arena and fail. */
+    ArenaFree(base, allocSize, pool);
+    return res;
+  }
+
   DebugPoolFreeSplat(pool, RangeBase(&range), RangeLimit(&range));
   res = MVFFInsert(&range, mvff);
   AVER(res == ResOK);
-  AVER(RangeBase(&range) <= SegBase(seg));
-  if (mvff->minSegSize > segSize) mvff->minSegSize = segSize;
 
-  /* Don't call MVFFFreeSegs; that would be silly. */
+  /* Don't call MVFFFreeTracts; that would be silly. */
 
-  *segReturn = seg;
+  RangeCopy(rangeReturn, &range);
   return ResOK;
 }
 
@@ -278,21 +257,16 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
 
   foundBlock = MVFFFindFree(&range, mvff, size);
   if (!foundBlock) {
-    Seg seg;
+    RangeStruct addRange;
 
-    res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit);
+    res = MVFFAddRange(&addRange, mvff, size, withReservoirPermit);
     if (res != ResOK)
       return res;
     foundBlock = MVFFFindFree(&range, mvff, size);
 
     /* We know that the found range must intersect the new segment. */
     /* In particular, it doesn't necessarily lie entirely within it. */
-    /* The next two AVERs test for intersection of two intervals. */
-    AVER(RangeBase(&range) < SegLimit(seg));
-    AVER(SegBase(seg) < RangeLimit(&range));
-
-    /* We also know that the found range is no larger than the segment. */
-    AVER(SegSize(seg) >= RangeSize(&range));
+    AVER(foundBlock && RangesOverlap(&range, &addRange));
   }
   AVER(foundBlock);
   AVER(RangeSize(&range) == size);
@@ -324,15 +298,14 @@ static void MVFFFree(Pool pool, Addr old, Size size)
   res = MVFFInsert(&range, mvff);
   AVER(res == ResOK);
   if (res == ResOK)
-    MVFFFreeSegs(mvff, &range);
-
-  return;
+    MVFFFreeTracts(mvff, &range);
 }
 
 
 /* MVFFBufferFill -- Fill the buffer
  *
- * Fill it with the largest block we can find.
+ * Fill it with the largest block we can find. This is worst-fit
+ * allocation policy; see <design/poolmvff/#over.buffer>.
  */
 static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
                           Pool pool, Buffer buffer, Size size,
@@ -340,9 +313,8 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
 {
   Res res;
   MVFF mvff;
-  RangeStruct range, oldRange;
+  RangeStruct range, oldRange, newRange;
   Bool found;
-  Seg seg = NULL;
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
@@ -353,13 +325,16 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(SizeIsAligned(size, PoolAlignment(pool)));
   AVERT(Bool, withReservoirPermit);
 
-  found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE);
+  found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size,
+                          FindDeleteENTIRE);
   if (!found) {
-    /* Add a new segment to the free lists and try again. */
-    res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit);
+    /* Add a new range to the free lists and try again. */
+    res = MVFFAddRange(&newRange, mvff, size, withReservoirPermit);
     if (res != ResOK)
       return res;
-    found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE);
+    found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size,
+                            FindDeleteENTIRE);
+    AVER(found && RangesOverlap(&range, &newRange));
   }
   AVER(found);
 
@@ -393,9 +368,7 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer,
   res = MVFFInsert(&range, mvff);
   AVER(res == ResOK);
   if (res == ResOK)
-    MVFFFreeSegs(mvff, &range);
-
-  return;
+    MVFFFreeTracts(mvff, &range);
 }
 
 
@@ -485,9 +458,7 @@ static Res MVFFInit(Pool pool, ArgList args)
 
   mvff->extendBy = extendBy;
   if (extendBy < ArenaAlign(arena))
-    mvff->minSegSize = ArenaAlign(arena);
-  else
-    mvff->minSegSize = extendBy;
+    mvff->extendBy = ArenaAlign(arena);
   mvff->avgSize = avgSize;
   pool->alignment = align;
   mvff->slotHigh = slotHigh;
@@ -501,20 +472,23 @@ static Res MVFFInit(Pool pool, ArgList args)
   SegPrefInit(mvff->segPref);
   SegPrefExpress(mvff->segPref, arenaHigh ? SegPrefHigh : SegPrefLow, NULL);
 
-  mvff->total = 0;
+  res = LandInit(AllocCBSOfMVFF(mvff), CBSFastLandClassGet(), arena, align,
+                 mvff, mps_args_none);
+  if (res != ResOK)
+    goto failAllocCBSInit;
 
   res = LandInit(FreelistOfMVFF(mvff), FreelistLandClassGet(), arena, align,
                  mvff, mps_args_none);
   if (res != ResOK)
     goto failFreelistInit;
 
-  res = LandInit(CBSOfMVFF(mvff), CBSFastLandClassGet(), arena, align, mvff,
-                 mps_args_none);
+  res = LandInit(FreeCBSOfMVFF(mvff), CBSFastLandClassGet(), arena, align,
+                 mvff, mps_args_none);
   if (res != ResOK)
-    goto failCBSInit;
+    goto failFreeCBSInit;
 
   MPS_ARGS_BEGIN(foArgs) {
-    MPS_ARGS_ADD(foArgs, FailoverPrimary, CBSOfMVFF(mvff));
+    MPS_ARGS_ADD(foArgs, FailoverPrimary, FreeCBSOfMVFF(mvff));
     MPS_ARGS_ADD(foArgs, FailoverSecondary, FreelistOfMVFF(mvff));
     res = LandInit(FailoverOfMVFF(mvff), FailoverLandClassGet(), arena, align,
                    mvff, foArgs);
@@ -529,10 +503,12 @@ static Res MVFFInit(Pool pool, ArgList args)
   return ResOK;
 
 failFailoverInit:
-  LandFinish(CBSOfMVFF(mvff));
-failCBSInit:
+  LandFinish(FreeCBSOfMVFF(mvff));
+failFreeCBSInit:
   LandFinish(FreelistOfMVFF(mvff));
 failFreelistInit:
+  LandFinish(AllocCBSOfMVFF(mvff));
+failAllocCBSInit:
   ControlFree(arena, p, sizeof(SegPrefStruct));
   return res;
 }
@@ -540,38 +516,45 @@ failFreelistInit:
 
 /* MVFFFinish -- finish method for MVFF */
 
+static Bool mvffFinishVisitor(Bool *deleteReturn, Land land, Range range,
+                              void *closureP, Size closureS)
+{
+  Pool pool;
+  AVER(deleteReturn != NULL);
+  AVERT(Land, land);
+  AVERT(Range, range);
+  AVER(closureP != NULL);
+  pool = closureP;
+  AVERT(Pool, pool);
+  UNUSED(closureS);
+
+  ArenaFree(RangeBase(range), RangeSize(range), pool);
+  *deleteReturn = FALSE;
+  return TRUE;
+}
+
 static void MVFFFinish(Pool pool)
 {
   MVFF mvff;
   Arena arena;
-  Ring ring, node, nextNode;
 
   AVERT(Pool, pool);
   mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
+  mvff->sig = SigInvalid;
 
-  ring = PoolSegRing(pool);
-  RING_FOR(node, ring, nextNode) {
-    Size size;
-    Seg seg;
-    seg = SegOfPoolRing(node);
-    AVER(SegPool(seg) == pool);
-    size = AddrOffset(SegBase(seg), SegLimit(seg));
-    AVER(size <= mvff->total);
-    mvff->total -= size;
-    SegFree(seg);
-  }
+  LandIterate(AllocCBSOfMVFF(mvff), mvffFinishVisitor, pool, 0);
 
-  AVER(mvff->total == 0);
-
-  arena = PoolArena(pool);
-  ControlFree(arena, mvff->segPref, sizeof(SegPrefStruct));
+  /* Would like to check that LandSize(AllocCBSOfMVFF(mvff)) == 0 now,
+   * but CBS doesn't support deletion while iterating. */
 
   LandFinish(FailoverOfMVFF(mvff));
   LandFinish(FreelistOfMVFF(mvff));
-  LandFinish(CBSOfMVFF(mvff));
+  LandFinish(FreeCBSOfMVFF(mvff));
+  LandFinish(AllocCBSOfMVFF(mvff));
 
-  mvff->sig = SigInvalid;
+  arena = PoolArena(pool);
+  ControlFree(arena, mvff->segPref, sizeof(SegPrefStruct));
 }
 
 
@@ -607,12 +590,17 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
                (WriteFP)pool, (WriteFU)pool->serial,
                "  extendBy  $W\n",  (WriteFW)mvff->extendBy,
                "  avgSize   $W\n",  (WriteFW)mvff->avgSize,
-               "  total     $U\n",  (WriteFU)mvff->total,
+               "  firstFit  $U\n",  (WriteFU)mvff->firstFit,
+               "  slotHigh  $U\n",  (WriteFU)mvff->slotHigh,
                NULL);
   if (res != ResOK)
     return res;
 
-  res = LandDescribe(CBSOfMVFF(mvff), stream);
+  res = LandDescribe(AllocCBSOfMVFF(mvff), stream);
+  if (res != ResOK)
+    return res;
+
+  res = LandDescribe(FreeCBSOfMVFF(mvff), stream);
   if (res != ResOK)
     return res;
 
@@ -685,15 +673,13 @@ size_t mps_mvff_free_size(mps_pool_t mps_pool)
 {
   Pool pool;
   MVFF mvff;
-  Land land;
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
   mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
-  land = FailoverOfMVFF(mvff);
 
-  return (size_t)LandSize(land);
+  return (size_t)LandSize(FailoverOfMVFF(mvff));
 }
 
 /* Total owned bytes. See <design/poolmvff/#design.arena-enter> */
@@ -708,7 +694,7 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
   mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
-  return (size_t)mvff->total;
+  return (size_t)LandSize(AllocCBSOfMVFF(mvff));
 }
 
 
@@ -720,15 +706,14 @@ static Bool MVFFCheck(MVFF mvff)
   CHECKD(Pool, MVFF2Pool(mvff));
   CHECKL(IsSubclassPoly(MVFF2Pool(mvff)->class, MVFFPoolClassGet()));
   CHECKD(SegPref, mvff->segPref);
-  CHECKL(mvff->extendBy > 0);                   /* see .arg.check */
-  CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFF2Pool(mvff))));
+  CHECKL(mvff->extendBy >= ArenaAlign(PoolArena(MVFF2Pool(mvff))));
   CHECKL(mvff->avgSize > 0);                    /* see .arg.check */
   CHECKL(mvff->avgSize <= mvff->extendBy);      /* see .arg.check */
-  CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFF2Pool(mvff)))));
-  CHECKD(CBS, &mvff->cbsStruct);
+  CHECKD(CBS, &mvff->allocCBSStruct);
+  CHECKD(CBS, &mvff->freeCBSStruct);
   CHECKD(Freelist, &mvff->flStruct);
   CHECKD(Failover, &mvff->foStruct);
-  CHECKL(mvff->total >= LandSize(FailoverOfMVFF(mvff)));
+  CHECKL(LandSize(AllocCBSOfMVFF(mvff)) >= LandSize(FailoverOfMVFF(mvff)));
   CHECKL(BoolCheck(mvff->slotHigh));
   CHECKL(BoolCheck(mvff->firstFit));
   return TRUE;
@@ -745,7 +730,7 @@ Land _mps_mvff_cbs(Pool pool) {
   mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
-  return CBSOfMVFF(mvff);
+  return FreeCBSOfMVFF(mvff);
 }
 
 
diff --git a/mps/design/poolmvff.txt b/mps/design/poolmvff.txt
index c842fe03a6c..b46cace73ae 100644
--- a/mps/design/poolmvff.txt
+++ b/mps/design/poolmvff.txt
@@ -44,9 +44,6 @@ BufferClass. This is appropriate since these buffers don't attach to
 segments, and hence don't constrain buffered regions to lie within
 segment boundaries.
 
-_`.over.segments`: The pool uses the simplest segment class
-(SegClass). There's no need for anything more complex.
-
 
 Methods
 -------
@@ -89,14 +86,10 @@ _`.method.init.epdr`: To simulate the EPDR pool, specify ``extendBy``,
 _`.method.init.other`: The performance characteristics of other
 combinations are unknown.
 
-_`.method.finish`: The ``PoolFinish()`` method,
-
 _`.method.alloc`: ``PoolAlloc()`` and ``PoolFree()`` methods are
 supported, implementing the policy set by the pool params (see
 `.method.init`_).
 
-_`.method.describe`: The usual describe method.
-
 _`.method.buffer`: The buffer methods implement a worst-fit fill
 strategy.
 
@@ -119,6 +112,9 @@ the pool class, to be used in pool creation.
 Implementation
 --------------
 
+_`.impl.alloc_list`: The pool stores the address ranges that it has
+acquired from the arena in a CBS (see design.mps.cbs_).
+
 _`.impl.free-list`: The pool stores its free list in a CBS (see
 design.mps.cbs_), failing over in emergencies to a Freelist (see
 design.mps.freelist_) when the CBS cannot allocate new control
@@ -131,13 +127,14 @@ structures. This is the reason for the alignment restriction above.
 Details
 -------
 
-_`.design.seg-size`: When adding a segment, we use extendBy as the
-segment size unless the object won't fit, in which case we use the
-object size (in both cases we align up).
+_`.design.acquire-size`: When acquiring memory from the arena, we use
+``extendBy`` as the unit of allocation unless the object won't fit, in
+which case we use the object size (in both cases we align up to the
+arena alignment).
 
-_`.design.seg-fail`: If allocating a segment fails, we try again with
-a segment size just large enough for the object we're allocating. This
-is in response to request.mps.170186_.
+_`.design.acquire-fail`: If allocating ``extendBy``, we try again with
+an aligned size just large enough for the object we're allocating.
+This is in response to request.mps.170186_.
 
 .. _request.mps.170186: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/mps/170186
 
@@ -162,6 +159,9 @@ Document History
 - 2013-06-04 GDR_ The CBS module no longer maintains its own emergency
   list, so MVFF handles the fail-over from its CBS to a Freelist.
 
+- 2014-04-15 GDR_ The address ranges acquired from the arena are now
+  stored in a CBS; segments are no longer used for this purpose.
+
 .. _RB: http://www.ravenbrook.com/consultants/rb/
 .. _GDR: http://www.ravenbrook.com/consultants/gdr/
 

From 8ebb89ef191cba78e7c07ca323f837922ab92707 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 12:15:18 +0100
Subject: [PATCH 04/70] Branching master to branch/2014-04-17/describe.

Copied from Perforce
 Change: 185623
 ServerID: perforce.ravenbrook.com

From 6721c2b913db892ad5b77851c975064c1299b467 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 13:36:42 +0100
Subject: [PATCH 05/70] Correct indentation of describe output.

Copied from Perforce
 Change: 185626
 ServerID: perforce.ravenbrook.com
---
 mps/code/abq.c       |  8 +++----
 mps/code/arena.c     | 28 +++++++++-------------
 mps/code/arenavm.c   |  6 ++---
 mps/code/buffer.c    | 35 +++++++++++++--------------
 mps/code/cbs.c       | 12 +++++-----
 mps/code/event.c     | 12 +++++-----
 mps/code/format.c    | 14 +++++------
 mps/code/freelist.c  |  6 ++---
 mps/code/global.c    | 57 ++++++++++++++++++++++++--------------------
 mps/code/mpm.c       | 23 ++++++++++++++++++
 mps/code/nailboard.c | 16 ++++++-------
 mps/code/pool.c      | 22 ++++++++---------
 mps/code/poolabs.c   |  2 +-
 mps/code/poolamc.c   | 28 ++++++++++------------
 mps/code/poolams.c   | 30 +++++++++++------------
 mps/code/poolmfs.c   | 10 ++++----
 mps/code/poolmrg.c   |  8 ++++---
 mps/code/poolmv.c    | 36 +++++++++++++++-------------
 mps/code/poolmv2.c   | 32 ++++++++++++-------------
 mps/code/poolmvff.c  | 12 +++++-----
 mps/code/range.c     |  6 ++---
 mps/code/root.c      | 24 +++++++++----------
 mps/code/seg.c       | 35 ++++++++++++---------------
 mps/code/splay.c     |  4 ++--
 mps/code/than.c      |  2 +-
 mps/code/thix.c      |  4 ++--
 mps/code/thw3.c      |  6 ++---
 mps/code/thxc.c      |  4 ++--
 28 files changed, 251 insertions(+), 231 deletions(-)

diff --git a/mps/code/abq.c b/mps/code/abq.c
index 22286354c77..869b0676bdd 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -166,10 +166,10 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
 
   res = WriteF(stream,
                "ABQ $P\n{\n", (WriteFP)abq,
-               "  elements: $U \n", (WriteFU)abq->elements,
-               "  in: $U \n", (WriteFU)abq->in,
-               "  out: $U \n", (WriteFU)abq->out,
-               "  queue: \n",
+               "elements: $U \n", (WriteFU)abq->elements,
+               "in: $U \n", (WriteFU)abq->in,
+               "out: $U \n", (WriteFU)abq->out,
+               "queue: \n",
                NULL);
   if(res != ResOK)
     return res;
diff --git a/mps/code/arena.c b/mps/code/arena.c
index 30f7687ce81..d61f7da106f 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -47,8 +47,7 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream)
    * subclass describe method should avoid invoking 
    * ARENA_SUPERCLASS()->describe.  RHSK 2007-04-27.
    */
-  return WriteF(stream,
-    "  No class-specific description available.\n", NULL);
+  return WriteF(stream, "No class-specific description available.\n", NULL);
 }
 
 
@@ -437,14 +436,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   res = WriteF(stream, "Arena $P {\n", (WriteFP)arena,
-               "  class $P (\"$S\")\n",
+               "class $P (\"$S\")\n",
                (WriteFP)arena->class, arena->class->name,
                NULL);
   if (res != ResOK) return res;
 
   if (arena->poolReady) {
     res = WriteF(stream,
-                 "  controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
+                 "controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
                  NULL);
     if (res != ResOK) return res;
   }
@@ -452,26 +451,26 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   /* Note: this Describe clause calls a function */
   reserved = ArenaReserved(arena);
   res = WriteF(stream,
-               "  reserved         $W  <-- "
+               "reserved         $W  <-- "
                "total size of address-space reserved\n",
                (WriteFW)reserved,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "  committed        $W  <-- "
+               "committed        $W  <-- "
                "total bytes currently stored (in RAM or swap)\n",
                (WriteFW)arena->committed,
-               "  commitLimit      $W\n", (WriteFW)arena->commitLimit,
-               "  spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
-               "  spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
-               "  zoneShift $U\n", (WriteFU)arena->zoneShift,
-               "  alignment $W\n", (WriteFW)arena->alignment,
+               "commitLimit      $W\n", (WriteFW)arena->commitLimit,
+               "spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
+               "spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
+               "zoneShift $U\n", (WriteFU)arena->zoneShift,
+               "alignment $W\n", (WriteFW)arena->alignment,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "  droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
+               "droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
                (arena->droppedMessages == 0 ? "" : "  -- MESSAGES DROPPED!"),
                NULL);
   if (res != ResOK) return res;
@@ -479,13 +478,8 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   res = (*arena->class->describe)(arena, stream);
   if (res != ResOK) return res;
 
-  /* Do not call GlobalsDescribe: it makes too much output, thanks.
-   * RHSK 2007-04-27
-   */
-#if 0
   res = GlobalsDescribe(ArenaGlobals(arena), stream);
   if (res != ResOK) return res;
-#endif
 
   res = WriteF(stream,
                "} Arena $P ($U)\n", (WriteFP)arena,
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 81e0684c436..ea0fcb812e5 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -205,13 +205,13 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
   */
 
   res = WriteF(stream,
-               "  spareSize:     $U\n", (WriteFU)vmArena->spareSize,
+               "spareSize $U\n", (WriteFU)vmArena->spareSize,
+               "extendBy $U\n", (WriteFU)vmArena->extendBy,
+               "extendMin $U\n", (WriteFU)vmArena->extendMin,
                NULL);
   if(res != ResOK)
     return res;
 
-  /* (incomplete: some fields are not Described) */
-
   return ResOK;
 }
 
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index 27314924600..ee25847b3b6 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -163,23 +163,22 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
   res = WriteF(stream,
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
-               "  class $P (\"$S\")\n",
+               "class $P (\"$S\")\n",
                (WriteFP)buffer->class, buffer->class->name,
-               "  Arena $P\n",       (WriteFP)buffer->arena,
-               "  Pool $P\n",        (WriteFP)buffer->pool,
-               buffer->isMutator ?
-                 "  Mutator Buffer\n" : "  Internal Buffer\n",
-               "  mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
-                       (WriteFS)abzMode,
-               "  fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
-               "  emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
-               "  alignment $W\n",   (WriteFW)buffer->alignment,
-               "  base $A\n",        buffer->base,
-               "  initAtFlip $A\n",  buffer->initAtFlip,
-               "  init $A\n",        buffer->ap_s.init,
-               "  alloc $A\n",       buffer->ap_s.alloc,
-               "  limit $A\n",       buffer->ap_s.limit,
-               "  poolLimit $A\n",   buffer->poolLimit,
+               "Arena $P\n",       (WriteFP)buffer->arena,
+               "Pool $P\n",        (WriteFP)buffer->pool,
+               buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
+               "mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+               (WriteFS)abzMode,
+               "fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
+               "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
+               "alignment $W\n",   (WriteFW)buffer->alignment,
+               "base $A\n",        buffer->base,
+               "initAtFlip $A\n",  buffer->initAtFlip,
+               "init $A\n",        buffer->ap_s.init,
+               "alloc $A\n",       buffer->ap_s.alloc,
+               "limit $A\n",       buffer->ap_s.limit,
+               "poolLimit $A\n",   buffer->poolLimit,
                NULL);
   if (res != ResOK) return res;
 
@@ -1444,8 +1443,8 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream)
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "  Seg $P\n",         (WriteFP)segbuf->seg,
-               "  rankSet $U\n",     (WriteFU)segbuf->rankSet,
+               "Seg $P\n",         (WriteFP)segbuf->seg,
+               "rankSet $U\n",     (WriteFU)segbuf->rankSet,
                NULL);
 
   return res;
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 118d226a603..6335f581fc2 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -1066,11 +1066,11 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "CBS $P {\n", (WriteFP)cbs,
-               "  alignment: $U\n", (WriteFU)cbs->alignment,
-               "  blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
-               "  fastFind: $U\n", (WriteFU)cbs->fastFind,
-               "  inCBS: $U\n", (WriteFU)cbs->inCBS,
-               "  treeSize: $U\n", (WriteFU)cbs->treeSize,
+               "alignment: $U\n", (WriteFU)cbs->alignment,
+               "blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
+               "fastFind:  $U\n", (WriteFU)cbs->fastFind,
+               "inCBS:     $U\n", (WriteFU)cbs->inCBS,
+               "treeSize:  $U\n", (WriteFU)cbs->treeSize,
                NULL);
   if (res != ResOK) return res;
 
@@ -1079,7 +1079,7 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
 
   METER_WRITE(cbs->treeSearch, stream);
 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(stream, "} CBS $P\n",  (WriteFP)cbs, NULL);
   return res;
 }
 
diff --git a/mps/code/event.c b/mps/code/event.c
index 475fa4f875c..558d874a0f5 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -331,24 +331,24 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Event $P {\n", (WriteFP)event,
-               "  code $U\n", (WriteFU)event->any.code,
-               "  clock ", NULL);
+               "code $U\n", (WriteFU)event->any.code,
+               "clock ", NULL);
   if (res != ResOK) return res;
   res = EVENT_CLOCK_WRITE(stream, event->any.clock);
   if (res != ResOK) return res;
-  res = WriteF(stream, "\n  size $U\n", (WriteFU)event->any.size, NULL);
+  res = WriteF(stream, "\nsize $U\n", (WriteFU)event->any.size, NULL);
   if (res != ResOK) return res;
 
   switch (event->any.code) {
 
 #define EVENT_DESC_PARAM(name, index, sort, ident) \
-                 "\n  $S", (WriteFS)#ident, \
+                 "\n$S", (WriteFS)#ident, \
                  EVENT_WRITE_PARAM_##sort(name, index, sort, ident)
 
 #define EVENT_DESC(X, name, _code, always, kind) \
   case _code: \
     res = WriteF(stream, \
-                 "  event \"$S\"", (WriteFS)#name, \
+                 "event \"$S\"", (WriteFS)#name, \
                  EVENT_##name##_PARAMS(EVENT_DESC_PARAM, name) \
                  NULL); \
     if (res != ResOK) return res; \
@@ -357,7 +357,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
   EVENT_LIST(EVENT_DESC, X)
 
   default:
-    res = WriteF(stream, "  event type unknown", NULL);
+    res = WriteF(stream, "event type unknown", NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
diff --git a/mps/code/format.c b/mps/code/format.c
index 88a86283ef8..9d74d541921 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -199,14 +199,14 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial,
-               "  arena $P ($U)\n",
+               "arena     $P ($U)\n",
                (WriteFP)format->arena, (WriteFU)format->arena->serial,
-               "  alignment $W\n", (WriteFW)format->alignment,
-               "  scan $F\n", (WriteFF)format->scan,
-               "  skip $F\n", (WriteFF)format->skip,
-               "  move $F\n", (WriteFF)format->move,
-               "  isMoved $F\n", (WriteFF)format->isMoved,
-               "  pad $F\n", (WriteFF)format->pad,
+               "alignment $W\n", (WriteFW)format->alignment,
+               "scan      $F\n", (WriteFF)format->scan,
+               "skip      $F\n", (WriteFF)format->skip,
+               "move      $F\n", (WriteFF)format->move,
+               "isMoved   $F\n", (WriteFF)format->isMoved,
+               "pad       $F\n", (WriteFF)format->pad,
                "} Format $P ($U)\n", (WriteFP)format, (WriteFU)format->serial,
                NULL);
   if (res != ResOK) return res;
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 6260451ff59..24df0645ecf 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -558,7 +558,7 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
   UNUSED(closureS);
 
   res = WriteF(stream,
-               "  [$P,", (WriteFP)RangeBase(range),
+               "[$P,", (WriteFP)RangeBase(range),
                "$P)", (WriteFP)RangeLimit(range),
                " {$U}\n", (WriteFU)RangeSize(range),
                NULL);
@@ -577,8 +577,8 @@ Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Freelist $P {\n", (WriteFP)fl,
-               "  alignment = $U\n", (WriteFU)fl->alignment,
-               "  listSize = $U\n", (WriteFU)fl->listSize,
+               "alignment $U\n", (WriteFU)fl->alignment,
+               "listSize  $U\n", (WriteFU)fl->listSize,
                NULL);
 
   FreelistIterate(fl, freelistDescribeIterateMethod, stream, 0);
diff --git a/mps/code/global.c b/mps/code/global.c
index 5f635206bd9..58cc3e8fcbd 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1046,51 +1046,54 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
 
   arena = GlobalsArena(arenaGlobals);
   res = WriteF(stream,
-               "  mpsVersion $S\n", arenaGlobals->mpsVersionString,
-               "  lock $P\n", (WriteFP)arenaGlobals->lock,
-               "  pollThreshold $U kB\n",
+               "Globals $P {\n", (WriteFP)arenaGlobals,
+               "mpsVersion $S\n", arenaGlobals->mpsVersionString,
+               "lock $P\n", (WriteFP)arenaGlobals->lock,
+               "pollThreshold $U kB\n",
                (WriteFU)(arenaGlobals->pollThreshold / 1024),
                arenaGlobals->insidePoll ? "inside poll\n" : "outside poll\n",
                arenaGlobals->clamped ? "clamped\n" : "released\n",
-               "  fillMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
-               "  emptyMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
-               "  allocMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
-               "  fillInternalSize $U kB\n",
-                 (WriteFU)(arenaGlobals->fillInternalSize / 1024),
-               "  emptyInternalSize $U kB\n",
-                 (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
-               "  poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
-               "  rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
-               "  formatSerial $U\n", (WriteFU)arena->formatSerial,
-               "  threadSerial $U\n", (WriteFU)arena->threadSerial,
+               "fillMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
+               "emptyMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
+               "allocMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
+               "fillInternalSize $U kB\n",
+               (WriteFU)(arenaGlobals->fillInternalSize / 1024),
+               "emptyInternalSize $U kB\n",
+               (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
+               "poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
+               "rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
+               "formatSerial $U\n", (WriteFU)arena->formatSerial,
+               "threadSerial $U\n", (WriteFU)arena->threadSerial,
                arena->insideShield ? "inside shield\n" : "outside shield\n",
-               "  busyTraces    $B\n", (WriteFB)arena->busyTraces,
-               "  flippedTraces $B\n", (WriteFB)arena->flippedTraces,
+               "busyTraces    $B\n", (WriteFB)arena->busyTraces,
+               "flippedTraces $B\n", (WriteFB)arena->flippedTraces,
                /* @@@@ no TraceDescribe function */
-               "  epoch $U\n", (WriteFU)arena->epoch,
+               "epoch $U\n", (WriteFU)arena->epoch,
+               "history {\n",
                NULL);
   if (res != ResOK) return res;
 
   for(i=0; i < LDHistoryLENGTH; ++ i) {
     res = WriteF(stream,
-                 "    history[$U] = $B\n", i, arena->history[i],
+                 "[$U] = $B\n", i, arena->history[i],
                  NULL);
     if (res != ResOK) return res;
   }
 
   res = WriteF(stream,
-               "    [note: indices are raw, not rotated]\n"
-               "    prehistory = $B\n", (WriteFB)arena->prehistory,
+               "[note: indices are raw, not rotated]\n"
+               "prehistory = $B\n", (WriteFB)arena->prehistory,
+               "}\n",
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "  suspended $S\n", arena->suspended ? "YES" : "NO",
-               "  shDepth $U\n", arena->shDepth,
-               "  shCacheI $U\n", arena->shCacheI,
+               "suspended $S\n", arena->suspended ? "YES" : "NO",
+               "shDepth $U\n", arena->shDepth,
+               "shCacheI $U\n", arena->shCacheI,
                /* @@@@ should SegDescribe the cached segs? */
                NULL);
   if (res != ResOK) return res;
@@ -1117,6 +1120,8 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
   }
 
   /* @@@@ What about grey rings? */
+
+  res = WriteF(stream, "} Globals $P\n", (WriteFP)arenaGlobals, NULL);
   return res;
 }
 
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index a46fdf5fb10..99cccb2ae4f 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -454,6 +454,8 @@ Res WriteF_v(mps_lib_FILE *stream, va_list args)
 Res WriteF_firstformat_v(mps_lib_FILE *stream, 
                          const char *firstformat, va_list args)
 {
+  static size_t depth = 0;
+  static Bool line_start = TRUE;
   const char *format;
   int r;
   size_t i;
@@ -468,9 +470,30 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
       break;
 
     while(*format != '\0') {
+      if (*format == '}') {
+        AVER(depth > 0);
+        -- depth;
+      }
+      if (line_start) {
+        for (i = 0; i < depth; ++i) {
+          r = mps_lib_fputs("  ", stream);
+          if (r == mps_lib_EOF) return ResIO;
+        }
+        line_start = FALSE;
+      }
       if (*format != '$') {
         r = mps_lib_fputc(*format, stream); /* Could be more efficient */
         if (r == mps_lib_EOF) return ResIO;
+        switch (*format) {
+        case '{':
+          ++ depth;
+          break;
+        case '\n':
+          line_start = TRUE;
+          break;
+        default:
+          break;
+        }
       } else {
         ++format;
         AVER(*format != '\0');
diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index 852c98949e7..1783bca27c1 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -414,12 +414,12 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
     return ResFAIL;
 
   res = WriteF(stream,
-               "Nailboard $P\n{\n", (WriteFP)board,
-               "  base: $P\n", (WriteFP)RangeBase(&board->range),
-               "  limit: $P\n", (WriteFP)RangeLimit(&board->range),
-               "  levels: $U\n", (WriteFU)board->levels,
-               "  newNails: $S\n", board->newNails ? "TRUE" : "FALSE",
-               "  alignShift: $U\n", (WriteFU)board->alignShift,
+               "Nailboard $P {\n", (WriteFP)board,
+               "base       $P\n", (WriteFP)RangeBase(&board->range),
+               "limit      $P\n", (WriteFP)RangeLimit(&board->range),
+               "levels     $U\n", (WriteFU)board->levels,
+               "newNails   $S\n", board->newNails ? "TRUE" : "FALSE",
+               "alignShift $U\n", (WriteFU)board->alignShift,
                NULL);
   if (res != ResOK)
     return res;
@@ -427,7 +427,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
   for(i = 0; i < board->levels; ++i) {
     Count levelNails = nailboardLevelBits(nailboardNails(board), i);
     Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
-    res = WriteF(stream, "  Level $U ($U bits, $U set): ",
+    res = WriteF(stream, "Level $U ($U bits, $U set): ",
                  i, levelNails, levelNails - resetNails, NULL);
     if (res != ResOK)
       return res;
@@ -441,7 +441,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
     if (res != ResOK)
       return res;
   }
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(stream, "} Nailboard $P\n", (WriteFP)board, NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 5741470457a..606acb82b15 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -532,11 +532,11 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
-               "  class $P (\"$S\")\n",
+               "class $P (\"$S\")\n",
                (WriteFP)pool->class, pool->class->name,
-               "  arena $P ($U)\n",
+               "arena $P ($U)\n",
                (WriteFP)pool->arena, (WriteFU)pool->arena->serial,
-               "  alignment $W\n", (WriteFW)pool->alignment,
+               "alignment $W\n", (WriteFW)pool->alignment,
                NULL);
   if (res != ResOK) return res;
   if (NULL != pool->format) {
@@ -544,14 +544,14 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
     if (res != ResOK) return res;
   }
   res = WriteF(stream,
-               "  fillMutatorSize $UKb\n",
-                 (WriteFU)(pool->fillMutatorSize / 1024),
-               "  emptyMutatorSize $UKb\n",
-                 (WriteFU)(pool->emptyMutatorSize / 1024),
-               "  fillInternalSize $UKb\n",
-                 (WriteFU)(pool->fillInternalSize / 1024),
-               "  emptyInternalSize $UKb\n",
-                 (WriteFU)(pool->emptyInternalSize / 1024),
+               "fillMutatorSize $UKb\n",
+               (WriteFU)(pool->fillMutatorSize / 1024),
+               "emptyMutatorSize $UKb\n",
+               (WriteFU)(pool->emptyMutatorSize / 1024),
+               "fillInternalSize $UKb\n",
+               (WriteFU)(pool->fillInternalSize / 1024),
+               "emptyInternalSize $UKb\n",
+               (WriteFU)(pool->emptyInternalSize / 1024),
                NULL);
   if (res != ResOK) return res;
 
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index aa2ee5adcbd..6f08703d126 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -315,7 +315,7 @@ Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream)
 {
   AVERT(Pool, pool);
   AVER(stream != NULL);
-  return WriteF(stream, "  No class-specific description available.\n", NULL);
+  return WriteF(stream, "No class-specific description available.\n", NULL);
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index aeb04454efe..8cb6b38cf03 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -259,23 +259,23 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
   limit = SegLimit(seg);
 
   res = WriteF(stream,
-               "AMC seg $P [$A,$A){\n",
+               "AMC seg $P [$A,$A) {\n",
                (WriteFP)seg, (WriteFA)base, (WriteFA)limit,
                NULL);
   if(res != ResOK)
     return res;
 
   if(amcSegHasNailboard(seg)) {
-    res = WriteF(stream, "  Boarded\n", NULL);
+    res = WriteF(stream, "Boarded\n", NULL);
   } else if(SegNailed(seg) == TraceSetEMPTY) {
-    res = WriteF(stream, "  Mobile\n", NULL);
+    res = WriteF(stream, "Mobile\n", NULL);
   } else {
-    res = WriteF(stream, "  Stuck\n", NULL);
+    res = WriteF(stream, "Stuck\n", NULL);
   }
   if(res != ResOK)
     return res;
 
-  res = WriteF(stream, "  Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
+  res = WriteF(stream, "Map:  *===:object  @+++:nails  bbbb:buffer {\n", NULL);
   if(res != ResOK)
     return res;
 
@@ -288,7 +288,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
     Addr j;
     char c;
 
-    res = WriteF(stream, "    $A  ", i, NULL);
+    res = WriteF(stream, "$A  ", i, NULL);
     if(res != ResOK)
       return res;
 
@@ -319,7 +319,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
   }
 
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
-  res = WriteF(stream, "  Sketch: $S\n", (WriteFS)abzSketch, NULL);
+  res = WriteF(stream, "}\nSketch: $S\n", (WriteFS)abzSketch, NULL);
   if(res != ResOK)
     return res;
 
@@ -715,14 +715,14 @@ static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream)
     return ResFAIL;
 
   res = WriteF(stream,
-               "  amcGen $P ($U) {\n",
+               "amcGen $P ($U) {\n",
                (WriteFP)gen, (WriteFU)amcGenNr(gen),
-               "   buffer $P\n", gen->forward,
-               "   segs $U, totalSize $U, newSize $U\n",
+               "buffer $P\n", gen->forward,
+               "segs $U, totalSize $U, newSize $U\n",
                (WriteFU)gen->segs,
                (WriteFU)gen->pgen.totalSize,
                (WriteFU)gen->pgen.newSize,
-               "  } amcGen\n", NULL);
+               "} amcGen\n", NULL);
   return res;
 }
 
@@ -2279,7 +2279,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
-               " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
+               " $P {\n", (WriteFP)amc, "pool $P ($U)\n",
                (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial,
                NULL);
   if(res != ResOK)
@@ -2300,9 +2300,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
       break;
 
   }
-  res = WriteF(stream,
-               "  ", rampmode, " ($U)\n", (WriteFU)amc->rampCount,
-               NULL);
+  res = WriteF(stream, rampmode, " ($U)\n", (WriteFU)amc->rampCount, NULL);
   if(res != ResOK)
     return res;
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 65b2dcf754f..135c308b92c 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -551,24 +551,24 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
   buffer = SegBuffer(seg);
 
   res = WriteF(stream,
-               "  AMS $P\n", (WriteFP)amsseg->ams,
-               "  grains $W\n", (WriteFW)amsseg->grains,
+               "AMS $P\n", (WriteFP)amsseg->ams,
+               "grains $W\n", (WriteFW)amsseg->grains,
                NULL);
   if (res != ResOK) return res;
   if (amsseg->allocTableInUse)
     res = WriteF(stream,
-                 "  alloctable $P\n", (WriteFP)amsseg->allocTable,
+                 "alloctable $P\n", (WriteFP)amsseg->allocTable,
                  NULL);
   else
     res = WriteF(stream,
-                 "  firstFree $W\n", (WriteFW)amsseg->firstFree,
+                 "firstFree $W\n", (WriteFW)amsseg->firstFree,
                  NULL);
   if (res != ResOK) return res;
   res = WriteF(stream,
-               "  tables: nongrey $P, nonwhite $P\n",
+               "tables: nongrey $P, nonwhite $P\n",
                (WriteFP)amsseg->nongreyTable,
                (WriteFP)amsseg->nonwhiteTable,
-               "  map: \n",
+               "map: {\n",
                NULL);
   if (res != ResOK) return res;
 
@@ -576,7 +576,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     char c = 0;
 
     if (i % 64 == 0) {
-      res = WriteF(stream, "\n  ", NULL);
+      res = WriteF(stream, "\n", NULL);
       if (res != ResOK) return res;
     }
 
@@ -606,7 +606,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]");
   }
 
-  res = WriteF(stream, "\n", NULL);
+  res = WriteF(stream, "}\n", NULL);
   return res;
 }
 
@@ -1661,21 +1661,21 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "AMS $P {\n", (WriteFP)ams,
-               "  pool $P ($U)\n",
+               "pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
-               "  size $W\n",
+               "size $W\n",
                (WriteFW)ams->size,
-               "  grain shift $U\n", (WriteFU)ams->grainShift,
-               "  chain $P\n",
+               "grain shift $U\n", (WriteFU)ams->grainShift,
+               "chain $P\n",
                (WriteFP)ams->chain,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "  segments\n"
+               "segments\n"
                "    * = black, + = grey, - = white, . = alloc, ! = bad\n"
-               "    buffers: [ = base, < = scan limit, | = init,\n"
-               "             > = alloc, ] = limit\n",
+               "    buffers: [ = base, < = scan limit, | = init,"
+               " > = alloc, ] = limit\n",
                NULL);
   if (res != ResOK) return res;
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 214b2b232d3..54ebbffeff0 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -323,11 +323,11 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream)
   AVER(stream != NULL);
 
   res = WriteF(stream,
-               "  unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
-               "  unit size $W\n",           (WriteFW)mfs->unitSize,
-               "  extent size $W\n",         (WriteFW)mfs->extendBy,
-               "  free list begins at $P\n", (WriteFP)mfs->freeList,
-               "  tract list begin at $P\n", (WriteFP)mfs->tractList,
+               "unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
+               "unit size $W\n",           (WriteFW)mfs->unitSize,
+               "extent size $W\n",         (WriteFW)mfs->extendBy,
+               "free list begins at $P\n", (WriteFP)mfs->freeList,
+               "tract list begin at $P\n", (WriteFP)mfs->tractList,
                NULL);
   if(res != ResOK) return res;
 
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 93d9f8bd25e..36850e62b21 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -806,17 +806,19 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   arena = PoolArena(pool);
-  res = WriteF(stream, "  extendBy $W\n", mrg->extendBy, NULL);
+  res = WriteF(stream, "extendBy $W\n", mrg->extendBy, NULL);
   if (res != ResOK) return res;
-  res = WriteF(stream, "  Entry queue:\n", NULL);
+  res = WriteF(stream, "Entry queue {\n", NULL);
   if (res != ResOK) return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
-    res = WriteF(stream, "    at $A Ref $A\n",
+    res = WriteF(stream, "at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
     if (res != ResOK) return res;
   }
+  res = WriteF(stream, "}\n", NULL);
+  if (res != ResOK) return res;
 
   return ResOK;
 }
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 0ce4f28c95d..71058cef712 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -688,18 +688,18 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
   if(stream == NULL) return ResFAIL;
 
   res = WriteF(stream,
-               "  blockPool $P ($U)\n",
+               "blockPool $P ($U)\n",
                (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
-               "  spanPool  $P ($U)\n",
+               "spanPool  $P ($U)\n",
                (WriteFP)mvSpanPool(mv), (WriteFU)mvSpanPool(mv)->serial,
-               "  extendBy  $W\n",  (WriteFW)mv->extendBy,
-               "  avgSize   $W\n",  (WriteFW)mv->avgSize,
-               "  maxSize   $W\n",  (WriteFW)mv->maxSize,
-               "  space     $P\n",  (WriteFP)mv->space,
+               "extendBy  $W\n",  (WriteFW)mv->extendBy,
+               "avgSize   $W\n",  (WriteFW)mv->avgSize,
+               "maxSize   $W\n",  (WriteFW)mv->maxSize,
+               "space     $P\n",  (WriteFP)mv->space,
                NULL);
   if(res != ResOK) return res;              
 
-  res = WriteF(stream, "  Spans\n", NULL);
+  res = WriteF(stream, "Spans {\n", NULL);
   if(res != ResOK) return res;
 
   spans = &mv->spans;
@@ -708,11 +708,11 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     AVERT(MVSpan, span);
 
     res = WriteF(stream,
-                 "    span $P",   (WriteFP)span,
-                 "  tract $P",    (WriteFP)span->tract,
-                 "  space $W",    (WriteFW)span->space,
-                 "  blocks $U",   (WriteFU)span->blockCount,
-                 "  largest ",
+                 "span $P ",   (WriteFP)span,
+                 "tract $P ",  (WriteFP)span->tract,
+                 "space $W ",  (WriteFW)span->space,
+                 "blocks $U ", (WriteFU)span->blockCount,
+                 "largest ",
                  NULL);
     if(res != ResOK) return res;
 
@@ -720,11 +720,10 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
       res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL);
     else
       res = WriteF(stream, "unknown\n", NULL);
-   
     if(res != ResOK) return res;
   }
 
-  res = WriteF(stream, "  Span allocation maps\n", NULL);
+  res = WriteF(stream, "}\nSpan allocation maps {\n", NULL);
   if(res != ResOK) return res;
 
   step = pool->alignment;
@@ -735,13 +734,13 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     Addr i, j;
     MVBlock block;
     span = RING_ELT(MVSpan, spans, node);
-    res = WriteF(stream, "    MVSpan $P\n", (WriteFP)span, NULL);
+    res = WriteF(stream, "MVSpan $P {\n", (WriteFP)span, NULL);
     if(res != ResOK) return res;
 
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
-      res = WriteF(stream, "    $A ", i, NULL);
+      res = WriteF(stream, "$A ", i, NULL);
       if(res != ResOK) return res;
 
       for(j = i;
@@ -770,8 +769,13 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
       res = WriteF(stream, "\n", NULL);
       if(res != ResOK) return res;
     }
+
+    res = WriteF(stream, "} MVSpan $P\n", (WriteFP)span, NULL);
+    if(res != ResOK) return res;
   }
 
+  res = WriteF(stream, "}\n", NULL);
+  if(res != ResOK) return res;
   return ResOK;
 }
 
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index f6d85b1b134..207624c6dea 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -1015,21 +1015,21 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "MVT $P\n{\n", (WriteFP)mvt,
-               "  minSize: $U \n", (WriteFU)mvt->minSize,
-               "  meanSize: $U \n", (WriteFU)mvt->meanSize,
-               "  maxSize: $U \n", (WriteFU)mvt->maxSize,
-               "  fragLimit: $U \n", (WriteFU)mvt->fragLimit,
-               "  reuseSize: $U \n", (WriteFU)mvt->reuseSize,
-               "  fillSize: $U \n", (WriteFU)mvt->fillSize,
-               "  availLimit: $U \n", (WriteFU)mvt->availLimit,
-               "  abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
-               "  splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
-               "  splinterBase: $A \n", (WriteFA)mvt->splinterBase,
-               "  splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
-               "  size: $U \n", (WriteFU)mvt->size,
-               "  allocated: $U \n", (WriteFU)mvt->allocated,
-               "  available: $U \n", (WriteFU)mvt->available,
-               "  unavailable: $U \n", (WriteFU)mvt->unavailable,
+               "minSize: $U \n", (WriteFU)mvt->minSize,
+               "meanSize: $U \n", (WriteFU)mvt->meanSize,
+               "maxSize: $U \n", (WriteFU)mvt->maxSize,
+               "fragLimit: $U \n", (WriteFU)mvt->fragLimit,
+               "reuseSize: $U \n", (WriteFU)mvt->reuseSize,
+               "fillSize: $U \n", (WriteFU)mvt->fillSize,
+               "availLimit: $U \n", (WriteFU)mvt->availLimit,
+               "abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
+               "splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
+               "splinterBase: $A \n", (WriteFA)mvt->splinterBase,
+               "splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
+               "size: $U \n", (WriteFU)mvt->size,
+               "allocated: $U \n", (WriteFU)mvt->allocated,
+               "available: $U \n", (WriteFU)mvt->available,
+               "unavailable: $U \n", (WriteFU)mvt->unavailable,
                NULL);
   if(res != ResOK) return res;
 
@@ -1074,7 +1074,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
   METER_WRITE(mvt->exceptionSplinters, stream);
   METER_WRITE(mvt->exceptionReturns, stream);
  
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(stream, "} MVT $P\n", (WriteFP)mvt, NULL);
   return res;
 }
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index fc4307d50a2..892cd175d31 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -681,12 +681,12 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "MVFF $P {\n", (WriteFP)mvff,
-               "  pool $P ($U)\n",
+               "pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
-               "  extendBy  $W\n",  (WriteFW)mvff->extendBy,
-               "  avgSize   $W\n",  (WriteFW)mvff->avgSize,
-               "  total     $U\n",  (WriteFU)mvff->total,
-               "  free      $U\n",  (WriteFU)mvff->free,
+               "extendBy  $W\n",  (WriteFW)mvff->extendBy,
+               "avgSize   $W\n",  (WriteFW)mvff->avgSize,
+               "total     $U\n",  (WriteFU)mvff->total,
+               "free      $U\n",  (WriteFU)mvff->free,
                NULL);
   if (res != ResOK)
     return res;
@@ -699,7 +699,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   if (res != ResOK)
     return res;
 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(stream, "} MVFF $P\n", (WriteFP)mvff, NULL);
 
   return res;
 }
diff --git a/mps/code/range.c b/mps/code/range.c
index b54a001db2f..7f562bfb688 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -48,9 +48,9 @@ Res RangeDescribe(Range range, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Range $P\n{\n", (WriteFP)range,
-               "  base: $P\n", (WriteFP)RangeBase(range),
-               "  limit: $P\n", (WriteFP)RangeLimit(range),
-               "  size: $U\n", (WriteFU)RangeSize(range),
+               "base  $P\n", (WriteFP)RangeBase(range),
+               "limit $P\n", (WriteFP)RangeLimit(range),
+               "size  $U\n", (WriteFU)RangeSize(range),
                "}\n", NULL);
   if (res != ResOK) {
     return res;
diff --git a/mps/code/root.c b/mps/code/root.c
index 4277550a7fb..fcf7d88ba80 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -589,25 +589,25 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial,
-               "  arena $P ($U)\n", (WriteFP)root->arena,
+               "arena $P ($U)\n", (WriteFP)root->arena,
                (WriteFU)root->arena->serial,
-               "  rank $U\n", (WriteFU)root->rank,
-               "  grey $B\n", (WriteFB)root->grey,
-               "  summary $B\n", (WriteFB)root->summary,
+               "rank $U\n", (WriteFU)root->rank,
+               "grey $B\n", (WriteFB)root->grey,
+               "summary $B\n", (WriteFB)root->summary,
                NULL);
   if (res != ResOK) return res;
 
   switch(root->var) {
     case RootTABLE:
     res = WriteF(stream,
-                 "  table base $A limit $A\n",
+                 "table base $A limit $A\n",
                  root->the.table.base, root->the.table.limit,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootTABLE_MASKED:
-    res = WriteF(stream, "  table base $A limit $A mask $B\n",
+    res = WriteF(stream, "table base $A limit $A mask $B\n",
                  root->the.tableMasked.base, root->the.tableMasked.limit,
                  root->the.tableMasked.mask,
                  NULL);
@@ -616,8 +616,8 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
     case RootFUN:
     res = WriteF(stream,
-                 "  scan function $F\n", (WriteFF)root->the.fun.scan,
-                 "  environment p $P s $W\n",
+                 "scan function $F\n", (WriteFF)root->the.fun.scan,
+                 "environment p $P s $W\n",
                  root->the.fun.p, (WriteFW)root->the.fun.s,
                  NULL);
     if (res != ResOK) return res;
@@ -625,16 +625,16 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
     case RootREG:
     res = WriteF(stream,
-                 "  thread $P\n", (WriteFP)root->the.reg.thread,
-                 "  environment p $P", root->the.reg.p,
+                 "thread $P\n", (WriteFP)root->the.reg.thread,
+                 "environment p $P", root->the.reg.p,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootFMT:
     res = WriteF(stream,
-                 "  scan function $F\n", (WriteFF)root->the.fmt.scan,
-                 "  format base $A limit $A\n",
+                 "scan function $F\n", (WriteFF)root->the.fmt.scan,
+                 "format base $A limit $A\n",
                  root->the.fmt.base, root->the.fmt.limit,
                  NULL);
     if (res != ResOK) return res;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 31dd0759ff9..1302cd4cd3e 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -368,9 +368,9 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
   res = WriteF(stream,
                "Segment $P [$A,$A) {\n", (WriteFP)seg,
                (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
-               "  class $P (\"$S\")\n",
+               "class $P (\"$S\")\n",
                (WriteFP)seg->class, seg->class->name,
-               "  pool $P ($U)\n",
+               "pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
                NULL);
   if (res != ResOK) return res;
@@ -378,8 +378,7 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
   res = seg->class->describe(seg, stream);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "\n",
-               "} Segment $P\n", (WriteFP)seg, NULL);
+  res = WriteF(stream, "} Segment $P\n", (WriteFP)seg, NULL);
   return res;
 }
 
@@ -1031,8 +1030,8 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   res = WriteF(stream,
-               "  shield depth $U\n", (WriteFU)seg->depth,
-               "  protection mode:",
+               "shield depth $U\n", (WriteFU)seg->depth,
+               "protection mode:",
                NULL);
   if (res != ResOK) return res;
   if (SegPM(seg) & AccessREAD) {
@@ -1043,7 +1042,7 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " write", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\n  shield mode:", NULL);
+  res = WriteF(stream, "\nshield mode:", NULL);
   if (res != ResOK) return res;
   if (SegSM(seg) & AccessREAD) {
      res = WriteF(stream, " read", NULL);
@@ -1053,7 +1052,7 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " write", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\n  ranks:", NULL);
+  res = WriteF(stream, "\nranks:", NULL);
   if (res != ResOK) return res;
   /* This bit ought to be in a RankSetDescribe in ref.c. */
   if (RankSetIsMember(seg->rankSet, RankAMBIG)) {
@@ -1072,10 +1071,10 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " weak", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\n",
-               "  white  $B\n", (WriteFB)seg->white,
-               "  grey   $B\n", (WriteFB)seg->grey,
-               "  nailed $B\n", (WriteFB)seg->nailed,
+  res = WriteF(stream, "\n"
+               "white  $B\n", (WriteFB)seg->white,
+               "grey   $B\n", (WriteFB)seg->grey,
+               "nailed $B\n", (WriteFB)seg->nailed,
                NULL);
   return res;
 }
@@ -1627,17 +1626,13 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream)
   res = super->describe(seg, stream);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  summary $W\n", (WriteFW)gcseg->summary,
-               NULL);
+  res = WriteF(stream, "summary $W\n", (WriteFW)gcseg->summary, NULL);
   if (res != ResOK) return res;
 
-  if (gcseg->buffer == NULL) {
-    res = WriteF(stream, "  buffer: NULL\n", NULL);
-  }
-  else {
+  if (gcseg->buffer == NULL)
+    res = WriteF(stream, "buffer: NULL\n", NULL);
+  else
     res = BufferDescribe(gcseg->buffer, stream);
-  }
   if (res != ResOK) return res;
 
   return ResOK;
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 7e061cd14f4..b0fbeb4d326 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -1335,7 +1335,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
 
   res = WriteF(stream,
                "Splay $P {\n", (WriteFP)splay,
-               "  compare $F\n", (WriteFF)splay->compare,
+               "compare $F\n", (WriteFF)splay->compare,
                NULL);
   if (res != ResOK) return res;
 
@@ -1344,7 +1344,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, "\n}\n", NULL);
+  res = WriteF(stream, "\n} Splay $P\n", (WriteFP)splay, NULL);
   return res;
 }
 
diff --git a/mps/code/than.c b/mps/code/than.c
index a1dab12adc8..199f2321e4d 100644
--- a/mps/code/than.c
+++ b/mps/code/than.c
@@ -134,7 +134,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "  arena $P ($U)\n", 
+               "arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
diff --git a/mps/code/thix.c b/mps/code/thix.c
index cc380dd040f..3bd4b1fb846 100644
--- a/mps/code/thix.c
+++ b/mps/code/thix.c
@@ -278,9 +278,9 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "  arena $P ($U)\n",
+               "arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "  id $U\n",          (WriteFU)thread->id,
+               "id $U\n",          (WriteFU)thread->id,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/thw3.c b/mps/code/thw3.c
index 701ffc53cdd..c2c0988bb91 100644
--- a/mps/code/thw3.c
+++ b/mps/code/thw3.c
@@ -218,10 +218,10 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "  arena $P ($U)\n", 
+               "arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "  handle $W\n",      (WriteFW)thread->handle,
-               "  id $U\n",          (WriteFU)thread->id,
+               "handle $W\n",      (WriteFW)thread->handle,
+               "id $U\n",          (WriteFU)thread->id,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/thxc.c b/mps/code/thxc.c
index 9e6a6bd325c..48d497d67f0 100644
--- a/mps/code/thxc.c
+++ b/mps/code/thxc.c
@@ -254,9 +254,9 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "  arena $P ($U)\n",
+               "arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "  port $U\n", (WriteFU)thread->port,
+               "port $U\n", (WriteFU)thread->port,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK) return res;

From a4253ed48469c52060ca5a5eb406b7bf2d461fce Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 14:21:15 +0100
Subject: [PATCH 06/70] Don't aver in writef: typically called from debugger
 where we want a best effort.

Copied from Perforce
 Change: 185629
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 99cccb2ae4f..155235e83d0 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -470,10 +470,8 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
       break;
 
     while(*format != '\0') {
-      if (*format == '}') {
-        AVER(depth > 0);
+      if (*format == '}' && depth > 0)
         -- depth;
-      }
       if (line_start) {
         for (i = 0; i < depth; ++i) {
           r = mps_lib_fputs("  ", stream);
@@ -516,7 +514,7 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
           case 'F': {                   /* function */
             WriteFF f = va_arg(args, WriteFF);
             Byte *b = (Byte *)&f;
-            /* ISO C forbits casting function pointers to integer, so
+            /* ISO C forbids casting function pointers to integer, so
                decode bytes (see design.writef.f). 
                TODO: Be smarter about endianness. */
             for(i=0; i < sizeof(WriteFF); i++) {

From d56e9abfe3d42b1c04e9b337878758e97499ef9e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 14:21:46 +0100
Subject: [PATCH 07/70] Better mvspan descriptions.

Copied from Perforce
 Change: 185630
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmv.c | 44 +++++++++++++++-----------------------------
 1 file changed, 15 insertions(+), 29 deletions(-)

diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 71058cef712..3974fb4e04b 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -699,33 +699,6 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
                NULL);
   if(res != ResOK) return res;              
 
-  res = WriteF(stream, "Spans {\n", NULL);
-  if(res != ResOK) return res;
-
-  spans = &mv->spans;
-  RING_FOR(node, spans, nextNode) {
-    span = RING_ELT(MVSpan, spans, node);
-    AVERT(MVSpan, span);
-
-    res = WriteF(stream,
-                 "span $P ",   (WriteFP)span,
-                 "tract $P ",  (WriteFP)span->tract,
-                 "space $W ",  (WriteFW)span->space,
-                 "blocks $U ", (WriteFU)span->blockCount,
-                 "largest ",
-                 NULL);
-    if(res != ResOK) return res;
-
-    if (span->largestKnown) /* .design.largest */
-      res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL);
-    else
-      res = WriteF(stream, "unknown\n", NULL);
-    if(res != ResOK) return res;
-  }
-
-  res = WriteF(stream, "}\nSpan allocation maps {\n", NULL);
-  if(res != ResOK) return res;
-
   step = pool->alignment;
   length = 0x40 * step;
 
@@ -737,6 +710,21 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     res = WriteF(stream, "MVSpan $P {\n", (WriteFP)span, NULL);
     if(res != ResOK) return res;
 
+    res = WriteF(stream,
+                 "span    $P\n", (WriteFP)span,
+                 "tract   $P\n", (WriteFP)span->tract,
+                 "space   $W\n", (WriteFW)span->space,
+                 "blocks  $U\n", (WriteFU)span->blockCount,
+                 "largest ",
+                 NULL);
+    if(res != ResOK) return res;
+
+    if (span->largestKnown) /* .design.largest */
+      res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL);
+    else
+      res = WriteF(stream, "unknown\n", NULL);
+    if(res != ResOK) return res;
+
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
@@ -774,8 +762,6 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     if(res != ResOK) return res;
   }
 
-  res = WriteF(stream, "}\n", NULL);
-  if(res != ResOK) return res;
   return ResOK;
 }
 

From e65a085be9d83bef278c63ab31f9063418663d31 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 14:22:19 +0100
Subject: [PATCH 08/70] New function tracedescribe.

Copied from Perforce
 Change: 185631
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 10 +++++++++-
 mps/code/mpm.h    |  1 +
 mps/code/trace.c  | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 56 insertions(+), 1 deletion(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index 58cc3e8fcbd..d9820e19981 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1040,6 +1040,8 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
   Arena arena;
   Ring node, nextNode;
   Index i;
+  TraceId ti;
+  Trace trace;
 
   if (!TESTT(Globals, arenaGlobals)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
@@ -1070,7 +1072,6 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
                arena->insideShield ? "inside shield\n" : "outside shield\n",
                "busyTraces    $B\n", (WriteFB)arena->busyTraces,
                "flippedTraces $B\n", (WriteFB)arena->flippedTraces,
-               /* @@@@ no TraceDescribe function */
                "epoch $U\n", (WriteFU)arena->epoch,
                "history {\n",
                NULL);
@@ -1119,6 +1120,13 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
     if (res != ResOK) return res;
   }
 
+  TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
+    if (TraceSetIsMember(arena->busyTraces, trace)) {
+      res = TraceDescribe(trace, stream);
+      if (res != ResOK) return res;
+    }
+  TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
+
   /* @@@@ What about grey rings? */
 
   res = WriteF(stream, "} Globals $P\n", (WriteFP)arenaGlobals, NULL);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 0cbad2b0f1c..14bd71be909 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -397,6 +397,7 @@ extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
 
 extern void TraceQuantum(Trace trace);
 extern Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why);
+extern Res TraceDescribe(Trace trace, mps_lib_FILE *stream);
 
 /* traceanc.c -- Trace Ancillary */
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 61e9d396155..91004bf65aa 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1899,6 +1899,52 @@ failStart:
 }
 
 
+/* TraceDescribe -- describe a trace */
+
+Res TraceDescribe(Trace trace, mps_lib_FILE *stream)
+{
+  Res res;
+  const char *state;
+
+  if (!TESTT(Trace, trace)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  switch (trace->state) {
+  case TraceINIT:      state = "INIT";      break;
+  case TraceUNFLIPPED: state = "UNFLIPPED"; break;
+  case TraceFLIPPED:   state = "FLIPPED";   break;
+  case TraceRECLAIM:   state = "RECLAIM";   break;
+  case TraceFINISHED:  state = "FINISHED";  break;
+  default:             state = "unknown";   break;
+  }
+
+  res = WriteF(stream, "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
+               "arena $P ($U)\n", (WriteFP)trace->arena,
+               (WriteFU)trace->arena->serial,
+               "why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why),
+               "state $S\n", (WriteFS)state,
+               "band $U\n", (WriteFU)trace->band,
+               "white   $B\n", (WriteFB)trace->white,
+               "mayMove $B\n", (WriteFB)trace->mayMove,
+               "chain $P\n", (WriteFP)trace->chain,
+               "condemned $U\n", (WriteFU)trace->condemned,
+               "notCondemned $U\n", (WriteFU)trace->notCondemned,
+               "foundation $U\n", (WriteFU)trace->foundation,
+               "rate $U\n", (WriteFU)trace->rate,
+               "rootScanSize $U\n", (WriteFU)trace->rootScanSize,
+               "rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize,
+               "segScanSize $U\n", (WriteFU)trace->segScanSize,
+               "segCopiedSize $U\n", (WriteFU)trace->segCopiedSize,
+               "forwardedSize $U\n", (WriteFU)trace->forwardedSize,
+               "preservedInPlaceSize $U\n", (WriteFU)trace->preservedInPlaceSize,
+               NULL);
+  if (res != ResOK) return res;
+
+  res = WriteF(stream, "} Trace $P\n", (WriteFP)trace, NULL);
+  return res;
+}
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2014 Ravenbrook Limited

From a8aee50de6e14dd190ef5c6ca46695d0923515a8 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 17 Apr 2014 14:24:03 +0100
Subject: [PATCH 09/70] Simpler bufferdescribe.

Update design.mps.writef with indentation feature and updated BufferDescribe.

Copied from Perforce
 Change: 185632
 ServerID: perforce.ravenbrook.com
---
 mps/code/buffer.c     | 14 ++++------
 mps/design/writef.txt | 64 +++++++++++++++++++++++++++----------------
 2 files changed, 45 insertions(+), 33 deletions(-)

diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index ee25847b3b6..638ed127168 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -149,17 +149,10 @@ Bool BufferCheck(Buffer buffer)
 Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
 {
   Res res;
-  char abzMode[5];
 
   if (!TESTT(Buffer, buffer)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  abzMode[0] = (char)( (buffer->mode & BufferModeTRANSITION)  ? 't' : '_' );
-  abzMode[1] = (char)( (buffer->mode & BufferModeLOGGED)      ? 'l' : '_' );
-  abzMode[2] = (char)( (buffer->mode & BufferModeFLIPPED)     ? 'f' : '_' );
-  abzMode[3] = (char)( (buffer->mode & BufferModeATTACHED)    ? 'a' : '_' );
-  abzMode[4] = '\0';
-
   res = WriteF(stream,
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
@@ -168,8 +161,11 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
                "Arena $P\n",       (WriteFP)buffer->arena,
                "Pool $P\n",        (WriteFP)buffer->pool,
                buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
-               "mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
-               (WriteFS)abzMode,
+               "mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+               (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'),
+               (WriteFC)((buffer->mode & BufferModeLOGGED)     ? 'l' : '_'),
+               (WriteFC)((buffer->mode & BufferModeFLIPPED)    ? 'f' : '_'),
+               (WriteFC)((buffer->mode & BufferModeATTACHED)   ? 'a' : '_'),
                "fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
                "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
                "alignment $W\n",   (WriteFW)buffer->alignment,
diff --git a/mps/design/writef.txt b/mps/design/writef.txt
index 9e5558b675a..dcbbbb78f83 100644
--- a/mps/design/writef.txt
+++ b/mps/design/writef.txt
@@ -34,9 +34,9 @@ depends on ``fputc()`` and ``fputs()``, via the Library Interface
 freestanding environment. This is achieved by implementing our own
 internal output routines in mpm.c.
 
-Our output requirements are few, so the code is short. The only output
-function which should be used in the rest of the MPM is ``WriteF()``,
-which is similar to ``fprintf()``:
+_`.writef`: Our output requirements are few, so the code is short. The
+only output function which should be used in the rest of the MPM is
+``WriteF()``.
 
 ``Res WriteF(mps_lib_FILE *stream, ...)``
 
@@ -44,27 +44,41 @@ which is similar to ``fprintf()``:
 insert into the output, followed by another format string, more items,
 and so on, and finally a ``NULL`` format string. For example::
 
-    WriteF(stream,
-           "Hello: $A\n", address,
-           "Spong: $U ($S)\n", number, string,
-           NULL);
+    res = WriteF(stream,
+                 "Hello: $A\n", address,
+                 "Spong: $U ($S)\n", number, string,
+                 NULL);
+    if (res != ResOK) return res;
 
-This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` might contain the following code::
+This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` contains the following code::
 
-    WriteF(stream,
-           "Buffer $P ($U) {\n", (WriteFP)buffer, (WriteFU)buffer->serial,
-           "  base $A  init $A  alloc $A  limit $A\n",
-           (WriteFA)buffer->base, (WriteFA)buffer->ap.init, 
-           (WriteFA)buffer->ap.alloc, (WriteFA)buffer->ap.limit,
-           "  Pool $P\n",        (WriteFP)buffer->pool,
-           "  Seg $P\n",         (WriteFP)buffer->seg,
-           "  rank $U\n",        (WriteFU)buffer->rank,
-           "  alignment $W\n",   (WriteFW)buffer->alignment,
-           "  grey $B\n",        (WriteFB)buffer->grey,
-           "  shieldMode $B\n",  (WriteFB)buffer->shieldMode,
-           "  p $P  i $U\n",     (WriteFP)buffer->p, (WriteFU)buffer->i,
-           "} Buffer $P ($U)\n", (WriteFP)buffer, (WriteFU)buffer->serial,
-           NULL);
+    res = WriteF(stream,
+                 "Buffer $P ($U) {\n",
+                 (WriteFP)buffer, (WriteFU)buffer->serial,
+                 "class $P (\"$S\")\n",
+                 (WriteFP)buffer->class, buffer->class->name,
+                 "Arena $P\n",       (WriteFP)buffer->arena,
+                 "Pool $P\n",        (WriteFP)buffer->pool,
+                 buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
+                 "mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+                 (WriteFS)abzMode,
+                 "fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
+                 "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
+                 "alignment $W\n",   (WriteFW)buffer->alignment,
+                 "base $A\n",        buffer->base,
+                 "initAtFlip $A\n",  buffer->initAtFlip,
+                 "init $A\n",        buffer->ap_s.init,
+                 "alloc $A\n",       buffer->ap_s.alloc,
+                 "limit $A\n",       buffer->ap_s.limit,
+                 "poolLimit $A\n",   buffer->poolLimit,
+                 NULL);
+    if (res != ResOK) return res;
+
+_`.indent`: ``WriteF()`` maintains the indentation of nested
+structures automatically. In a format string, ``{`` increases the
+indentation level by one, and ``}`` decreases it by one. Before
+emitting the first character on a line (but after updating the depth),
+``WriteF()`` emits the indentation whitespace for the current depth.
 
 _`.types`: For each format ``$X`` that ``WriteF()`` supports, there is a
 type defined in impl.h.mpmtypes ``WriteFX()`` which is the promoted
@@ -97,8 +111,8 @@ promotion of a ``char`` (see `.types`_).
 
 _`.snazzy`: We should resist the temptation to make ``WriteF()`` an
 incredible snazzy output engine. We only need it for ``Describe()``
-methods and assertion messages. At the moment it's a very simple bit
-of code -- let's keep it that way.
+methods. At the moment it's a very simple bit of code -- let's keep it
+that way.
 
 _`.f`: The ``F`` code is used for function pointers. ISO C forbids casting
 function pointers to other types, so the bytes of their representation are
@@ -115,6 +129,8 @@ Document History
 
 - 2013-05-22 GDR_ Converted to reStructuredText.
 
+- 2014-04-17 GDR_ Add design for maintaining indentation.
+
 .. _RB: http://www.ravenbrook.com/consultants/rb/
 .. _GDR: http://www.ravenbrook.com/consultants/gdr/
 

From 3f46ffffd37695793d49cf97f9c12ef7255117d5 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 22 Apr 2014 00:53:18 +0100
Subject: [PATCH 10/70] New function chaindescribe describes a chain.

Also GenDescDescribe and PoolGenDescribe.
GlobalsDescribe now describes chains.

Copied from Perforce
 Change: 185727
 ServerID: perforce.ravenbrook.com
---
 mps/code/chain.h  |  4 +++
 mps/code/global.c |  6 ++++
 mps/code/locus.c  | 83 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 93 insertions(+)

diff --git a/mps/code/chain.h b/mps/code/chain.h
index e47f8000c0b..d3df265a0f2 100644
--- a/mps/code/chain.h
+++ b/mps/code/chain.h
@@ -74,6 +74,8 @@ typedef struct mps_chain_s {
 } ChainStruct;
 
 
+extern Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream);
+
 extern Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
                        GenParamStruct *params);
 extern void ChainDestroy(Chain chain);
@@ -88,12 +90,14 @@ extern size_t ChainGens(Chain chain);
 extern Res ChainAlloc(Seg *segReturn, Chain chain, Serial genNr,
                       SegClass class, Size size, Pool pool,
                       Bool withReservoirPermit, ArgList args);
+extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream);
 
 extern Bool PoolGenCheck(PoolGen gen);
 extern Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool);
 extern void PoolGenFinish(PoolGen gen);
 extern void PoolGenFlip(PoolGen gen);
 #define PoolGenNr(gen) ((gen)->nr)
+extern Res PoolGenDescribe(PoolGen gen, mps_lib_FILE *stream);
 
 
 #endif /* chain_h */
diff --git a/mps/code/global.c b/mps/code/global.c
index d9820e19981..3cb232124fd 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1120,6 +1120,12 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
     if (res != ResOK) return res;
   }
 
+  RING_FOR(node, &arena->chainRing, nextNode) {
+    Chain chain = RING_ELT(Chain, chainRing, node);
+    res = ChainDescribe(chain, stream);
+    if (res != ResOK) return res;
+  }
+
   TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
     if (TraceSetIsMember(arena->busyTraces, trace)) {
       res = TraceDescribe(trace, stream);
diff --git a/mps/code/locus.c b/mps/code/locus.c
index a704c8b820b..f90e146f675 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -126,6 +126,36 @@ static Size GenDescTotalSize(GenDesc gen)
 }
 
 
+/* GenDescDescribe -- describe a generation in a chain */
+
+Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream)
+{
+  Res res;
+  Ring node, nextNode;
+
+  if (!TESTT(GenDesc, gen)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  res = WriteF(stream,
+               "GenDesc $P {\n", (WriteFP)gen,
+               "zones $B\n", (WriteFB)gen->zones,
+               "capacity $U\n", (WriteFU)gen->capacity,
+               "mortality $D\n", (WriteFD)gen->mortality,
+               "proflow $D\n", (WriteFD)gen->proflow,
+               NULL);
+  if (res != ResOK) return res;
+
+  RING_FOR(node, &gen->locusRing, nextNode) {
+    PoolGen pgen = RING_ELT(PoolGen, genRing, node);
+    res = PoolGenDescribe(pgen, stream);
+    if (res != ResOK) return res;
+  }
+
+  res = WriteF(stream, "} GenDesc $P\n", (WriteFP)gen, NULL);
+  return res;
+}
+
+
 /* ChainCreate -- create a generation chain */
 
 Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
@@ -411,6 +441,35 @@ void ChainEndGC(Chain chain, Trace trace)
 }
 
 
+/* ChainDescribe -- describe a chain */
+
+Res ChainDescribe(Chain chain, mps_lib_FILE *stream)
+{
+  Res res;
+  size_t i;
+
+  if (!TESTT(Chain, chain)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  res = WriteF(stream,
+               "Chain $P {\n", (WriteFP)chain,
+               "arena $P\n", (WriteFP)chain->arena,
+               "activeTraces $B\n", (WriteFB)chain->activeTraces,
+               NULL);
+  if (res != ResOK) return res;
+
+  for (i = 0; i < chain->genCount; ++i) {
+    res = GenDescDescribe(&chain->gens[i], stream);
+    if (res != ResOK) return res;
+  }
+
+  res = WriteF(stream,
+               "} Chain $P\n", (WriteFP)chain,
+               NULL);
+  return res;
+}
+
+
 /* PoolGenInit -- initialize a PoolGen */
 
 Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool)
@@ -464,6 +523,30 @@ Bool PoolGenCheck(PoolGen gen)
 }
 
 
+/* PoolGenDescribe -- describe a PoolGen */
+
+Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream)
+{
+  Res res;
+
+  if (!TESTT(PoolGen, pgen)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+  
+  res = WriteF(stream,
+               "PoolGen $P ($U) {\n", (WriteFP)pgen, (WriteFU)pgen->nr,
+               "pool $P ($U) \"$S\"\n",
+               (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
+               (WriteFS)pgen->pool->class->name,
+               "chain $P\n", (WriteFP)pgen->chain,
+               "totalSize $U\n", (WriteFU)pgen->totalSize,
+               "newSize $U\n", (WriteFU)pgen->newSize,
+               "newSizeAtCreate $U\n", (WriteFU)pgen->newSizeAtCreate,
+               "} PoolGen $P\n", (WriteFP)pgen,
+               NULL);
+  return res;
+}
+
+
 /* LocusInit -- initialize the locus module */
 
 void LocusInit(Arena arena)

From d1b44a4f050d271740082576714f85be1702a653 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 May 2014 12:44:31 +0100
Subject: [PATCH 11/70] Back out change 185626 (violates the
 design.mps.writef.snazzy).

Copied from Perforce
 Change: 185941
 ServerID: perforce.ravenbrook.com
---
 mps/code/abq.c       |  8 +++----
 mps/code/arena.c     | 28 +++++++++++++---------
 mps/code/arenavm.c   |  6 ++---
 mps/code/buffer.c    | 32 ++++++++++++-------------
 mps/code/cbs.c       | 12 +++++-----
 mps/code/event.c     | 12 +++++-----
 mps/code/format.c    | 14 +++++------
 mps/code/freelist.c  |  6 ++---
 mps/code/global.c    | 57 ++++++++++++++++++++------------------------
 mps/code/mpm.c       | 21 ----------------
 mps/code/nailboard.c | 16 ++++++-------
 mps/code/pool.c      | 22 ++++++++---------
 mps/code/poolabs.c   |  2 +-
 mps/code/poolamc.c   | 28 ++++++++++++----------
 mps/code/poolams.c   | 30 +++++++++++------------
 mps/code/poolmfs.c   | 10 ++++----
 mps/code/poolmrg.c   |  8 +++----
 mps/code/poolmv.c    | 28 ++++++++++------------
 mps/code/poolmv2.c   | 32 ++++++++++++-------------
 mps/code/poolmvff.c  | 12 +++++-----
 mps/code/range.c     |  6 ++---
 mps/code/root.c      | 24 +++++++++----------
 mps/code/seg.c       | 35 +++++++++++++++------------
 mps/code/splay.c     |  4 ++--
 mps/code/than.c      |  2 +-
 mps/code/thix.c      |  4 ++--
 mps/code/thw3.c      |  6 ++---
 mps/code/thxc.c      |  4 ++--
 28 files changed, 226 insertions(+), 243 deletions(-)

diff --git a/mps/code/abq.c b/mps/code/abq.c
index 869b0676bdd..22286354c77 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -166,10 +166,10 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
 
   res = WriteF(stream,
                "ABQ $P\n{\n", (WriteFP)abq,
-               "elements: $U \n", (WriteFU)abq->elements,
-               "in: $U \n", (WriteFU)abq->in,
-               "out: $U \n", (WriteFU)abq->out,
-               "queue: \n",
+               "  elements: $U \n", (WriteFU)abq->elements,
+               "  in: $U \n", (WriteFU)abq->in,
+               "  out: $U \n", (WriteFU)abq->out,
+               "  queue: \n",
                NULL);
   if(res != ResOK)
     return res;
diff --git a/mps/code/arena.c b/mps/code/arena.c
index d61f7da106f..30f7687ce81 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -47,7 +47,8 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream)
    * subclass describe method should avoid invoking 
    * ARENA_SUPERCLASS()->describe.  RHSK 2007-04-27.
    */
-  return WriteF(stream, "No class-specific description available.\n", NULL);
+  return WriteF(stream,
+    "  No class-specific description available.\n", NULL);
 }
 
 
@@ -436,14 +437,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   res = WriteF(stream, "Arena $P {\n", (WriteFP)arena,
-               "class $P (\"$S\")\n",
+               "  class $P (\"$S\")\n",
                (WriteFP)arena->class, arena->class->name,
                NULL);
   if (res != ResOK) return res;
 
   if (arena->poolReady) {
     res = WriteF(stream,
-                 "controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
+                 "  controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
                  NULL);
     if (res != ResOK) return res;
   }
@@ -451,26 +452,26 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   /* Note: this Describe clause calls a function */
   reserved = ArenaReserved(arena);
   res = WriteF(stream,
-               "reserved         $W  <-- "
+               "  reserved         $W  <-- "
                "total size of address-space reserved\n",
                (WriteFW)reserved,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "committed        $W  <-- "
+               "  committed        $W  <-- "
                "total bytes currently stored (in RAM or swap)\n",
                (WriteFW)arena->committed,
-               "commitLimit      $W\n", (WriteFW)arena->commitLimit,
-               "spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
-               "spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
-               "zoneShift $U\n", (WriteFU)arena->zoneShift,
-               "alignment $W\n", (WriteFW)arena->alignment,
+               "  commitLimit      $W\n", (WriteFW)arena->commitLimit,
+               "  spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
+               "  spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
+               "  zoneShift $U\n", (WriteFU)arena->zoneShift,
+               "  alignment $W\n", (WriteFW)arena->alignment,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
+               "  droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
                (arena->droppedMessages == 0 ? "" : "  -- MESSAGES DROPPED!"),
                NULL);
   if (res != ResOK) return res;
@@ -478,8 +479,13 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   res = (*arena->class->describe)(arena, stream);
   if (res != ResOK) return res;
 
+  /* Do not call GlobalsDescribe: it makes too much output, thanks.
+   * RHSK 2007-04-27
+   */
+#if 0
   res = GlobalsDescribe(ArenaGlobals(arena), stream);
   if (res != ResOK) return res;
+#endif
 
   res = WriteF(stream,
                "} Arena $P ($U)\n", (WriteFP)arena,
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index ea0fcb812e5..81e0684c436 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -205,13 +205,13 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
   */
 
   res = WriteF(stream,
-               "spareSize $U\n", (WriteFU)vmArena->spareSize,
-               "extendBy $U\n", (WriteFU)vmArena->extendBy,
-               "extendMin $U\n", (WriteFU)vmArena->extendMin,
+               "  spareSize:     $U\n", (WriteFU)vmArena->spareSize,
                NULL);
   if(res != ResOK)
     return res;
 
+  /* (incomplete: some fields are not Described) */
+
   return ResOK;
 }
 
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index 638ed127168..eefbd5088cc 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -156,25 +156,25 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
   res = WriteF(stream,
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
-               "class $P (\"$S\")\n",
+               "  class $P (\"$S\")\n",
                (WriteFP)buffer->class, buffer->class->name,
-               "Arena $P\n",       (WriteFP)buffer->arena,
-               "Pool $P\n",        (WriteFP)buffer->pool,
-               buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
-               "mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+               "  Arena $P\n",       (WriteFP)buffer->arena,
+               "  Pool $P\n",        (WriteFP)buffer->pool,
+               "  ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
+               "  mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
                (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'),
                (WriteFC)((buffer->mode & BufferModeLOGGED)     ? 'l' : '_'),
                (WriteFC)((buffer->mode & BufferModeFLIPPED)    ? 'f' : '_'),
                (WriteFC)((buffer->mode & BufferModeATTACHED)   ? 'a' : '_'),
-               "fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
-               "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
-               "alignment $W\n",   (WriteFW)buffer->alignment,
-               "base $A\n",        buffer->base,
-               "initAtFlip $A\n",  buffer->initAtFlip,
-               "init $A\n",        buffer->ap_s.init,
-               "alloc $A\n",       buffer->ap_s.alloc,
-               "limit $A\n",       buffer->ap_s.limit,
-               "poolLimit $A\n",   buffer->poolLimit,
+               "  fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
+               "  emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
+               "  alignment $W\n",   (WriteFW)buffer->alignment,
+               "  base $A\n",        buffer->base,
+               "  initAtFlip $A\n",  buffer->initAtFlip,
+               "  init $A\n",        buffer->ap_s.init,
+               "  alloc $A\n",       buffer->ap_s.alloc,
+               "  limit $A\n",       buffer->ap_s.limit,
+               "  poolLimit $A\n",   buffer->poolLimit,
                NULL);
   if (res != ResOK) return res;
 
@@ -1439,8 +1439,8 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream)
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "Seg $P\n",         (WriteFP)segbuf->seg,
-               "rankSet $U\n",     (WriteFU)segbuf->rankSet,
+               "  Seg $P\n",         (WriteFP)segbuf->seg,
+               "  rankSet $U\n",     (WriteFU)segbuf->rankSet,
                NULL);
 
   return res;
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 6335f581fc2..118d226a603 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -1066,11 +1066,11 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "CBS $P {\n", (WriteFP)cbs,
-               "alignment: $U\n", (WriteFU)cbs->alignment,
-               "blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
-               "fastFind:  $U\n", (WriteFU)cbs->fastFind,
-               "inCBS:     $U\n", (WriteFU)cbs->inCBS,
-               "treeSize:  $U\n", (WriteFU)cbs->treeSize,
+               "  alignment: $U\n", (WriteFU)cbs->alignment,
+               "  blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
+               "  fastFind: $U\n", (WriteFU)cbs->fastFind,
+               "  inCBS: $U\n", (WriteFU)cbs->inCBS,
+               "  treeSize: $U\n", (WriteFU)cbs->treeSize,
                NULL);
   if (res != ResOK) return res;
 
@@ -1079,7 +1079,7 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
 
   METER_WRITE(cbs->treeSearch, stream);
 
-  res = WriteF(stream, "} CBS $P\n",  (WriteFP)cbs, NULL);
+  res = WriteF(stream, "}\n", NULL);
   return res;
 }
 
diff --git a/mps/code/event.c b/mps/code/event.c
index 558d874a0f5..475fa4f875c 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -331,24 +331,24 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Event $P {\n", (WriteFP)event,
-               "code $U\n", (WriteFU)event->any.code,
-               "clock ", NULL);
+               "  code $U\n", (WriteFU)event->any.code,
+               "  clock ", NULL);
   if (res != ResOK) return res;
   res = EVENT_CLOCK_WRITE(stream, event->any.clock);
   if (res != ResOK) return res;
-  res = WriteF(stream, "\nsize $U\n", (WriteFU)event->any.size, NULL);
+  res = WriteF(stream, "\n  size $U\n", (WriteFU)event->any.size, NULL);
   if (res != ResOK) return res;
 
   switch (event->any.code) {
 
 #define EVENT_DESC_PARAM(name, index, sort, ident) \
-                 "\n$S", (WriteFS)#ident, \
+                 "\n  $S", (WriteFS)#ident, \
                  EVENT_WRITE_PARAM_##sort(name, index, sort, ident)
 
 #define EVENT_DESC(X, name, _code, always, kind) \
   case _code: \
     res = WriteF(stream, \
-                 "event \"$S\"", (WriteFS)#name, \
+                 "  event \"$S\"", (WriteFS)#name, \
                  EVENT_##name##_PARAMS(EVENT_DESC_PARAM, name) \
                  NULL); \
     if (res != ResOK) return res; \
@@ -357,7 +357,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
   EVENT_LIST(EVENT_DESC, X)
 
   default:
-    res = WriteF(stream, "event type unknown", NULL);
+    res = WriteF(stream, "  event type unknown", NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
diff --git a/mps/code/format.c b/mps/code/format.c
index 9d74d541921..88a86283ef8 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -199,14 +199,14 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial,
-               "arena     $P ($U)\n",
+               "  arena $P ($U)\n",
                (WriteFP)format->arena, (WriteFU)format->arena->serial,
-               "alignment $W\n", (WriteFW)format->alignment,
-               "scan      $F\n", (WriteFF)format->scan,
-               "skip      $F\n", (WriteFF)format->skip,
-               "move      $F\n", (WriteFF)format->move,
-               "isMoved   $F\n", (WriteFF)format->isMoved,
-               "pad       $F\n", (WriteFF)format->pad,
+               "  alignment $W\n", (WriteFW)format->alignment,
+               "  scan $F\n", (WriteFF)format->scan,
+               "  skip $F\n", (WriteFF)format->skip,
+               "  move $F\n", (WriteFF)format->move,
+               "  isMoved $F\n", (WriteFF)format->isMoved,
+               "  pad $F\n", (WriteFF)format->pad,
                "} Format $P ($U)\n", (WriteFP)format, (WriteFU)format->serial,
                NULL);
   if (res != ResOK) return res;
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 24df0645ecf..6260451ff59 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -558,7 +558,7 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
   UNUSED(closureS);
 
   res = WriteF(stream,
-               "[$P,", (WriteFP)RangeBase(range),
+               "  [$P,", (WriteFP)RangeBase(range),
                "$P)", (WriteFP)RangeLimit(range),
                " {$U}\n", (WriteFU)RangeSize(range),
                NULL);
@@ -577,8 +577,8 @@ Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Freelist $P {\n", (WriteFP)fl,
-               "alignment $U\n", (WriteFU)fl->alignment,
-               "listSize  $U\n", (WriteFU)fl->listSize,
+               "  alignment = $U\n", (WriteFU)fl->alignment,
+               "  listSize = $U\n", (WriteFU)fl->listSize,
                NULL);
 
   FreelistIterate(fl, freelistDescribeIterateMethod, stream, 0);
diff --git a/mps/code/global.c b/mps/code/global.c
index 3cb232124fd..8fe6d7b51aa 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1048,53 +1048,50 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
 
   arena = GlobalsArena(arenaGlobals);
   res = WriteF(stream,
-               "Globals $P {\n", (WriteFP)arenaGlobals,
-               "mpsVersion $S\n", arenaGlobals->mpsVersionString,
-               "lock $P\n", (WriteFP)arenaGlobals->lock,
-               "pollThreshold $U kB\n",
+               "  mpsVersion $S\n", arenaGlobals->mpsVersionString,
+               "  lock $P\n", (WriteFP)arenaGlobals->lock,
+               "  pollThreshold $U kB\n",
                (WriteFU)(arenaGlobals->pollThreshold / 1024),
                arenaGlobals->insidePoll ? "inside poll\n" : "outside poll\n",
                arenaGlobals->clamped ? "clamped\n" : "released\n",
-               "fillMutatorSize $U kB\n",
-               (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
-               "emptyMutatorSize $U kB\n",
-               (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
-               "allocMutatorSize $U kB\n",
-               (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
-               "fillInternalSize $U kB\n",
-               (WriteFU)(arenaGlobals->fillInternalSize / 1024),
-               "emptyInternalSize $U kB\n",
-               (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
-               "poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
-               "rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
-               "formatSerial $U\n", (WriteFU)arena->formatSerial,
-               "threadSerial $U\n", (WriteFU)arena->threadSerial,
+               "  fillMutatorSize $U kB\n",
+                 (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
+               "  emptyMutatorSize $U kB\n",
+                 (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
+               "  allocMutatorSize $U kB\n",
+                 (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
+               "  fillInternalSize $U kB\n",
+                 (WriteFU)(arenaGlobals->fillInternalSize / 1024),
+               "  emptyInternalSize $U kB\n",
+                 (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
+               "  poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
+               "  rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
+               "  formatSerial $U\n", (WriteFU)arena->formatSerial,
+               "  threadSerial $U\n", (WriteFU)arena->threadSerial,
                arena->insideShield ? "inside shield\n" : "outside shield\n",
-               "busyTraces    $B\n", (WriteFB)arena->busyTraces,
-               "flippedTraces $B\n", (WriteFB)arena->flippedTraces,
-               "epoch $U\n", (WriteFU)arena->epoch,
-               "history {\n",
+               "  busyTraces    $B\n", (WriteFB)arena->busyTraces,
+               "  flippedTraces $B\n", (WriteFB)arena->flippedTraces,
+               "  epoch $U\n", (WriteFU)arena->epoch,
                NULL);
   if (res != ResOK) return res;
 
   for(i=0; i < LDHistoryLENGTH; ++ i) {
     res = WriteF(stream,
-                 "[$U] = $B\n", i, arena->history[i],
+                 "    history[$U] = $B\n", i, arena->history[i],
                  NULL);
     if (res != ResOK) return res;
   }
 
   res = WriteF(stream,
-               "[note: indices are raw, not rotated]\n"
-               "prehistory = $B\n", (WriteFB)arena->prehistory,
-               "}\n",
+               "    [note: indices are raw, not rotated]\n"
+               "    prehistory = $B\n", (WriteFB)arena->prehistory,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "suspended $S\n", arena->suspended ? "YES" : "NO",
-               "shDepth $U\n", arena->shDepth,
-               "shCacheI $U\n", arena->shCacheI,
+               "  suspended $S\n", arena->suspended ? "YES" : "NO",
+               "  shDepth $U\n", arena->shDepth,
+               "  shCacheI $U\n", arena->shCacheI,
                /* @@@@ should SegDescribe the cached segs? */
                NULL);
   if (res != ResOK) return res;
@@ -1134,8 +1131,6 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
   TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
 
   /* @@@@ What about grey rings? */
-
-  res = WriteF(stream, "} Globals $P\n", (WriteFP)arenaGlobals, NULL);
   return res;
 }
 
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 155235e83d0..5584e0aa00e 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -454,8 +454,6 @@ Res WriteF_v(mps_lib_FILE *stream, va_list args)
 Res WriteF_firstformat_v(mps_lib_FILE *stream, 
                          const char *firstformat, va_list args)
 {
-  static size_t depth = 0;
-  static Bool line_start = TRUE;
   const char *format;
   int r;
   size_t i;
@@ -470,28 +468,9 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
       break;
 
     while(*format != '\0') {
-      if (*format == '}' && depth > 0)
-        -- depth;
-      if (line_start) {
-        for (i = 0; i < depth; ++i) {
-          r = mps_lib_fputs("  ", stream);
-          if (r == mps_lib_EOF) return ResIO;
-        }
-        line_start = FALSE;
-      }
       if (*format != '$') {
         r = mps_lib_fputc(*format, stream); /* Could be more efficient */
         if (r == mps_lib_EOF) return ResIO;
-        switch (*format) {
-        case '{':
-          ++ depth;
-          break;
-        case '\n':
-          line_start = TRUE;
-          break;
-        default:
-          break;
-        }
       } else {
         ++format;
         AVER(*format != '\0');
diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index 1783bca27c1..852c98949e7 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -414,12 +414,12 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
     return ResFAIL;
 
   res = WriteF(stream,
-               "Nailboard $P {\n", (WriteFP)board,
-               "base       $P\n", (WriteFP)RangeBase(&board->range),
-               "limit      $P\n", (WriteFP)RangeLimit(&board->range),
-               "levels     $U\n", (WriteFU)board->levels,
-               "newNails   $S\n", board->newNails ? "TRUE" : "FALSE",
-               "alignShift $U\n", (WriteFU)board->alignShift,
+               "Nailboard $P\n{\n", (WriteFP)board,
+               "  base: $P\n", (WriteFP)RangeBase(&board->range),
+               "  limit: $P\n", (WriteFP)RangeLimit(&board->range),
+               "  levels: $U\n", (WriteFU)board->levels,
+               "  newNails: $S\n", board->newNails ? "TRUE" : "FALSE",
+               "  alignShift: $U\n", (WriteFU)board->alignShift,
                NULL);
   if (res != ResOK)
     return res;
@@ -427,7 +427,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
   for(i = 0; i < board->levels; ++i) {
     Count levelNails = nailboardLevelBits(nailboardNails(board), i);
     Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
-    res = WriteF(stream, "Level $U ($U bits, $U set): ",
+    res = WriteF(stream, "  Level $U ($U bits, $U set): ",
                  i, levelNails, levelNails - resetNails, NULL);
     if (res != ResOK)
       return res;
@@ -441,7 +441,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
     if (res != ResOK)
       return res;
   }
-  res = WriteF(stream, "} Nailboard $P\n", (WriteFP)board, NULL);
+  res = WriteF(stream, "}\n", NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 606acb82b15..5741470457a 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -532,11 +532,11 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
-               "class $P (\"$S\")\n",
+               "  class $P (\"$S\")\n",
                (WriteFP)pool->class, pool->class->name,
-               "arena $P ($U)\n",
+               "  arena $P ($U)\n",
                (WriteFP)pool->arena, (WriteFU)pool->arena->serial,
-               "alignment $W\n", (WriteFW)pool->alignment,
+               "  alignment $W\n", (WriteFW)pool->alignment,
                NULL);
   if (res != ResOK) return res;
   if (NULL != pool->format) {
@@ -544,14 +544,14 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
     if (res != ResOK) return res;
   }
   res = WriteF(stream,
-               "fillMutatorSize $UKb\n",
-               (WriteFU)(pool->fillMutatorSize / 1024),
-               "emptyMutatorSize $UKb\n",
-               (WriteFU)(pool->emptyMutatorSize / 1024),
-               "fillInternalSize $UKb\n",
-               (WriteFU)(pool->fillInternalSize / 1024),
-               "emptyInternalSize $UKb\n",
-               (WriteFU)(pool->emptyInternalSize / 1024),
+               "  fillMutatorSize $UKb\n",
+                 (WriteFU)(pool->fillMutatorSize / 1024),
+               "  emptyMutatorSize $UKb\n",
+                 (WriteFU)(pool->emptyMutatorSize / 1024),
+               "  fillInternalSize $UKb\n",
+                 (WriteFU)(pool->fillInternalSize / 1024),
+               "  emptyInternalSize $UKb\n",
+                 (WriteFU)(pool->emptyInternalSize / 1024),
                NULL);
   if (res != ResOK) return res;
 
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 6f08703d126..aa2ee5adcbd 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -315,7 +315,7 @@ Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream)
 {
   AVERT(Pool, pool);
   AVER(stream != NULL);
-  return WriteF(stream, "No class-specific description available.\n", NULL);
+  return WriteF(stream, "  No class-specific description available.\n", NULL);
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 8cb6b38cf03..aeb04454efe 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -259,23 +259,23 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
   limit = SegLimit(seg);
 
   res = WriteF(stream,
-               "AMC seg $P [$A,$A) {\n",
+               "AMC seg $P [$A,$A){\n",
                (WriteFP)seg, (WriteFA)base, (WriteFA)limit,
                NULL);
   if(res != ResOK)
     return res;
 
   if(amcSegHasNailboard(seg)) {
-    res = WriteF(stream, "Boarded\n", NULL);
+    res = WriteF(stream, "  Boarded\n", NULL);
   } else if(SegNailed(seg) == TraceSetEMPTY) {
-    res = WriteF(stream, "Mobile\n", NULL);
+    res = WriteF(stream, "  Mobile\n", NULL);
   } else {
-    res = WriteF(stream, "Stuck\n", NULL);
+    res = WriteF(stream, "  Stuck\n", NULL);
   }
   if(res != ResOK)
     return res;
 
-  res = WriteF(stream, "Map:  *===:object  @+++:nails  bbbb:buffer {\n", NULL);
+  res = WriteF(stream, "  Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
   if(res != ResOK)
     return res;
 
@@ -288,7 +288,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
     Addr j;
     char c;
 
-    res = WriteF(stream, "$A  ", i, NULL);
+    res = WriteF(stream, "    $A  ", i, NULL);
     if(res != ResOK)
       return res;
 
@@ -319,7 +319,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
   }
 
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
-  res = WriteF(stream, "}\nSketch: $S\n", (WriteFS)abzSketch, NULL);
+  res = WriteF(stream, "  Sketch: $S\n", (WriteFS)abzSketch, NULL);
   if(res != ResOK)
     return res;
 
@@ -715,14 +715,14 @@ static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream)
     return ResFAIL;
 
   res = WriteF(stream,
-               "amcGen $P ($U) {\n",
+               "  amcGen $P ($U) {\n",
                (WriteFP)gen, (WriteFU)amcGenNr(gen),
-               "buffer $P\n", gen->forward,
-               "segs $U, totalSize $U, newSize $U\n",
+               "   buffer $P\n", gen->forward,
+               "   segs $U, totalSize $U, newSize $U\n",
                (WriteFU)gen->segs,
                (WriteFU)gen->pgen.totalSize,
                (WriteFU)gen->pgen.newSize,
-               "} amcGen\n", NULL);
+               "  } amcGen\n", NULL);
   return res;
 }
 
@@ -2279,7 +2279,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
-               " $P {\n", (WriteFP)amc, "pool $P ($U)\n",
+               " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
                (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial,
                NULL);
   if(res != ResOK)
@@ -2300,7 +2300,9 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
       break;
 
   }
-  res = WriteF(stream, rampmode, " ($U)\n", (WriteFU)amc->rampCount, NULL);
+  res = WriteF(stream,
+               "  ", rampmode, " ($U)\n", (WriteFU)amc->rampCount,
+               NULL);
   if(res != ResOK)
     return res;
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 135c308b92c..65b2dcf754f 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -551,24 +551,24 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
   buffer = SegBuffer(seg);
 
   res = WriteF(stream,
-               "AMS $P\n", (WriteFP)amsseg->ams,
-               "grains $W\n", (WriteFW)amsseg->grains,
+               "  AMS $P\n", (WriteFP)amsseg->ams,
+               "  grains $W\n", (WriteFW)amsseg->grains,
                NULL);
   if (res != ResOK) return res;
   if (amsseg->allocTableInUse)
     res = WriteF(stream,
-                 "alloctable $P\n", (WriteFP)amsseg->allocTable,
+                 "  alloctable $P\n", (WriteFP)amsseg->allocTable,
                  NULL);
   else
     res = WriteF(stream,
-                 "firstFree $W\n", (WriteFW)amsseg->firstFree,
+                 "  firstFree $W\n", (WriteFW)amsseg->firstFree,
                  NULL);
   if (res != ResOK) return res;
   res = WriteF(stream,
-               "tables: nongrey $P, nonwhite $P\n",
+               "  tables: nongrey $P, nonwhite $P\n",
                (WriteFP)amsseg->nongreyTable,
                (WriteFP)amsseg->nonwhiteTable,
-               "map: {\n",
+               "  map: \n",
                NULL);
   if (res != ResOK) return res;
 
@@ -576,7 +576,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     char c = 0;
 
     if (i % 64 == 0) {
-      res = WriteF(stream, "\n", NULL);
+      res = WriteF(stream, "\n  ", NULL);
       if (res != ResOK) return res;
     }
 
@@ -606,7 +606,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]");
   }
 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(stream, "\n", NULL);
   return res;
 }
 
@@ -1661,21 +1661,21 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "AMS $P {\n", (WriteFP)ams,
-               "pool $P ($U)\n",
+               "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
-               "size $W\n",
+               "  size $W\n",
                (WriteFW)ams->size,
-               "grain shift $U\n", (WriteFU)ams->grainShift,
-               "chain $P\n",
+               "  grain shift $U\n", (WriteFU)ams->grainShift,
+               "  chain $P\n",
                (WriteFP)ams->chain,
                NULL);
   if (res != ResOK) return res;
 
   res = WriteF(stream,
-               "segments\n"
+               "  segments\n"
                "    * = black, + = grey, - = white, . = alloc, ! = bad\n"
-               "    buffers: [ = base, < = scan limit, | = init,"
-               " > = alloc, ] = limit\n",
+               "    buffers: [ = base, < = scan limit, | = init,\n"
+               "             > = alloc, ] = limit\n",
                NULL);
   if (res != ResOK) return res;
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 54ebbffeff0..214b2b232d3 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -323,11 +323,11 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream)
   AVER(stream != NULL);
 
   res = WriteF(stream,
-               "unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
-               "unit size $W\n",           (WriteFW)mfs->unitSize,
-               "extent size $W\n",         (WriteFW)mfs->extendBy,
-               "free list begins at $P\n", (WriteFP)mfs->freeList,
-               "tract list begin at $P\n", (WriteFP)mfs->tractList,
+               "  unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
+               "  unit size $W\n",           (WriteFW)mfs->unitSize,
+               "  extent size $W\n",         (WriteFW)mfs->extendBy,
+               "  free list begins at $P\n", (WriteFP)mfs->freeList,
+               "  tract list begin at $P\n", (WriteFP)mfs->tractList,
                NULL);
   if(res != ResOK) return res;
 
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 36850e62b21..93d9f8bd25e 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -806,19 +806,17 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   arena = PoolArena(pool);
-  res = WriteF(stream, "extendBy $W\n", mrg->extendBy, NULL);
+  res = WriteF(stream, "  extendBy $W\n", mrg->extendBy, NULL);
   if (res != ResOK) return res;
-  res = WriteF(stream, "Entry queue {\n", NULL);
+  res = WriteF(stream, "  Entry queue:\n", NULL);
   if (res != ResOK) return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
-    res = WriteF(stream, "at $A Ref $A\n",
+    res = WriteF(stream, "    at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
     if (res != ResOK) return res;
   }
-  res = WriteF(stream, "}\n", NULL);
-  if (res != ResOK) return res;
 
   return ResOK;
 }
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 3974fb4e04b..d345141ecf0 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -688,14 +688,14 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
   if(stream == NULL) return ResFAIL;
 
   res = WriteF(stream,
-               "blockPool $P ($U)\n",
+               "  blockPool $P ($U)\n",
                (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
-               "spanPool  $P ($U)\n",
+               "  spanPool  $P ($U)\n",
                (WriteFP)mvSpanPool(mv), (WriteFU)mvSpanPool(mv)->serial,
-               "extendBy  $W\n",  (WriteFW)mv->extendBy,
-               "avgSize   $W\n",  (WriteFW)mv->avgSize,
-               "maxSize   $W\n",  (WriteFW)mv->maxSize,
-               "space     $P\n",  (WriteFP)mv->space,
+               "  extendBy  $W\n",  (WriteFW)mv->extendBy,
+               "  avgSize   $W\n",  (WriteFW)mv->avgSize,
+               "  maxSize   $W\n",  (WriteFW)mv->maxSize,
+               "  space     $P\n",  (WriteFP)mv->space,
                NULL);
   if(res != ResOK) return res;              
 
@@ -711,11 +711,11 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     if(res != ResOK) return res;
 
     res = WriteF(stream,
-                 "span    $P\n", (WriteFP)span,
-                 "tract   $P\n", (WriteFP)span->tract,
-                 "space   $W\n", (WriteFW)span->space,
-                 "blocks  $U\n", (WriteFU)span->blockCount,
-                 "largest ",
+                 "  span    $P\n", (WriteFP)span,
+                 "  tract   $P\n", (WriteFP)span->tract,
+                 "  space   $W\n", (WriteFW)span->space,
+                 "  blocks  $U\n", (WriteFU)span->blockCount,
+                 "  largest ",
                  NULL);
     if(res != ResOK) return res;
 
@@ -723,12 +723,13 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
       res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL);
     else
       res = WriteF(stream, "unknown\n", NULL);
+   
     if(res != ResOK) return res;
 
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
-      res = WriteF(stream, "$A ", i, NULL);
+      res = WriteF(stream, "    $A ", i, NULL);
       if(res != ResOK) return res;
 
       for(j = i;
@@ -757,9 +758,6 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
       res = WriteF(stream, "\n", NULL);
       if(res != ResOK) return res;
     }
-
-    res = WriteF(stream, "} MVSpan $P\n", (WriteFP)span, NULL);
-    if(res != ResOK) return res;
   }
 
   return ResOK;
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 207624c6dea..f6d85b1b134 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -1015,21 +1015,21 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "MVT $P\n{\n", (WriteFP)mvt,
-               "minSize: $U \n", (WriteFU)mvt->minSize,
-               "meanSize: $U \n", (WriteFU)mvt->meanSize,
-               "maxSize: $U \n", (WriteFU)mvt->maxSize,
-               "fragLimit: $U \n", (WriteFU)mvt->fragLimit,
-               "reuseSize: $U \n", (WriteFU)mvt->reuseSize,
-               "fillSize: $U \n", (WriteFU)mvt->fillSize,
-               "availLimit: $U \n", (WriteFU)mvt->availLimit,
-               "abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
-               "splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
-               "splinterBase: $A \n", (WriteFA)mvt->splinterBase,
-               "splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
-               "size: $U \n", (WriteFU)mvt->size,
-               "allocated: $U \n", (WriteFU)mvt->allocated,
-               "available: $U \n", (WriteFU)mvt->available,
-               "unavailable: $U \n", (WriteFU)mvt->unavailable,
+               "  minSize: $U \n", (WriteFU)mvt->minSize,
+               "  meanSize: $U \n", (WriteFU)mvt->meanSize,
+               "  maxSize: $U \n", (WriteFU)mvt->maxSize,
+               "  fragLimit: $U \n", (WriteFU)mvt->fragLimit,
+               "  reuseSize: $U \n", (WriteFU)mvt->reuseSize,
+               "  fillSize: $U \n", (WriteFU)mvt->fillSize,
+               "  availLimit: $U \n", (WriteFU)mvt->availLimit,
+               "  abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
+               "  splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
+               "  splinterBase: $A \n", (WriteFA)mvt->splinterBase,
+               "  splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
+               "  size: $U \n", (WriteFU)mvt->size,
+               "  allocated: $U \n", (WriteFU)mvt->allocated,
+               "  available: $U \n", (WriteFU)mvt->available,
+               "  unavailable: $U \n", (WriteFU)mvt->unavailable,
                NULL);
   if(res != ResOK) return res;
 
@@ -1074,7 +1074,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
   METER_WRITE(mvt->exceptionSplinters, stream);
   METER_WRITE(mvt->exceptionReturns, stream);
  
-  res = WriteF(stream, "} MVT $P\n", (WriteFP)mvt, NULL);
+  res = WriteF(stream, "}\n", NULL);
   return res;
 }
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 892cd175d31..fc4307d50a2 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -681,12 +681,12 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "MVFF $P {\n", (WriteFP)mvff,
-               "pool $P ($U)\n",
+               "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
-               "extendBy  $W\n",  (WriteFW)mvff->extendBy,
-               "avgSize   $W\n",  (WriteFW)mvff->avgSize,
-               "total     $U\n",  (WriteFU)mvff->total,
-               "free      $U\n",  (WriteFU)mvff->free,
+               "  extendBy  $W\n",  (WriteFW)mvff->extendBy,
+               "  avgSize   $W\n",  (WriteFW)mvff->avgSize,
+               "  total     $U\n",  (WriteFU)mvff->total,
+               "  free      $U\n",  (WriteFU)mvff->free,
                NULL);
   if (res != ResOK)
     return res;
@@ -699,7 +699,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   if (res != ResOK)
     return res;
 
-  res = WriteF(stream, "} MVFF $P\n", (WriteFP)mvff, NULL);
+  res = WriteF(stream, "}\n", NULL);
 
   return res;
 }
diff --git a/mps/code/range.c b/mps/code/range.c
index 7f562bfb688..b54a001db2f 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -48,9 +48,9 @@ Res RangeDescribe(Range range, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Range $P\n{\n", (WriteFP)range,
-               "base  $P\n", (WriteFP)RangeBase(range),
-               "limit $P\n", (WriteFP)RangeLimit(range),
-               "size  $U\n", (WriteFU)RangeSize(range),
+               "  base: $P\n", (WriteFP)RangeBase(range),
+               "  limit: $P\n", (WriteFP)RangeLimit(range),
+               "  size: $U\n", (WriteFU)RangeSize(range),
                "}\n", NULL);
   if (res != ResOK) {
     return res;
diff --git a/mps/code/root.c b/mps/code/root.c
index fcf7d88ba80..4277550a7fb 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -589,25 +589,25 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial,
-               "arena $P ($U)\n", (WriteFP)root->arena,
+               "  arena $P ($U)\n", (WriteFP)root->arena,
                (WriteFU)root->arena->serial,
-               "rank $U\n", (WriteFU)root->rank,
-               "grey $B\n", (WriteFB)root->grey,
-               "summary $B\n", (WriteFB)root->summary,
+               "  rank $U\n", (WriteFU)root->rank,
+               "  grey $B\n", (WriteFB)root->grey,
+               "  summary $B\n", (WriteFB)root->summary,
                NULL);
   if (res != ResOK) return res;
 
   switch(root->var) {
     case RootTABLE:
     res = WriteF(stream,
-                 "table base $A limit $A\n",
+                 "  table base $A limit $A\n",
                  root->the.table.base, root->the.table.limit,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootTABLE_MASKED:
-    res = WriteF(stream, "table base $A limit $A mask $B\n",
+    res = WriteF(stream, "  table base $A limit $A mask $B\n",
                  root->the.tableMasked.base, root->the.tableMasked.limit,
                  root->the.tableMasked.mask,
                  NULL);
@@ -616,8 +616,8 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
     case RootFUN:
     res = WriteF(stream,
-                 "scan function $F\n", (WriteFF)root->the.fun.scan,
-                 "environment p $P s $W\n",
+                 "  scan function $F\n", (WriteFF)root->the.fun.scan,
+                 "  environment p $P s $W\n",
                  root->the.fun.p, (WriteFW)root->the.fun.s,
                  NULL);
     if (res != ResOK) return res;
@@ -625,16 +625,16 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
     case RootREG:
     res = WriteF(stream,
-                 "thread $P\n", (WriteFP)root->the.reg.thread,
-                 "environment p $P", root->the.reg.p,
+                 "  thread $P\n", (WriteFP)root->the.reg.thread,
+                 "  environment p $P", root->the.reg.p,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootFMT:
     res = WriteF(stream,
-                 "scan function $F\n", (WriteFF)root->the.fmt.scan,
-                 "format base $A limit $A\n",
+                 "  scan function $F\n", (WriteFF)root->the.fmt.scan,
+                 "  format base $A limit $A\n",
                  root->the.fmt.base, root->the.fmt.limit,
                  NULL);
     if (res != ResOK) return res;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 1302cd4cd3e..31dd0759ff9 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -368,9 +368,9 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
   res = WriteF(stream,
                "Segment $P [$A,$A) {\n", (WriteFP)seg,
                (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
-               "class $P (\"$S\")\n",
+               "  class $P (\"$S\")\n",
                (WriteFP)seg->class, seg->class->name,
-               "pool $P ($U)\n",
+               "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
                NULL);
   if (res != ResOK) return res;
@@ -378,7 +378,8 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
   res = seg->class->describe(seg, stream);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "} Segment $P\n", (WriteFP)seg, NULL);
+  res = WriteF(stream, "\n",
+               "} Segment $P\n", (WriteFP)seg, NULL);
   return res;
 }
 
@@ -1030,8 +1031,8 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   res = WriteF(stream,
-               "shield depth $U\n", (WriteFU)seg->depth,
-               "protection mode:",
+               "  shield depth $U\n", (WriteFU)seg->depth,
+               "  protection mode:",
                NULL);
   if (res != ResOK) return res;
   if (SegPM(seg) & AccessREAD) {
@@ -1042,7 +1043,7 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " write", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\nshield mode:", NULL);
+  res = WriteF(stream, "\n  shield mode:", NULL);
   if (res != ResOK) return res;
   if (SegSM(seg) & AccessREAD) {
      res = WriteF(stream, " read", NULL);
@@ -1052,7 +1053,7 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " write", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\nranks:", NULL);
+  res = WriteF(stream, "\n  ranks:", NULL);
   if (res != ResOK) return res;
   /* This bit ought to be in a RankSetDescribe in ref.c. */
   if (RankSetIsMember(seg->rankSet, RankAMBIG)) {
@@ -1071,10 +1072,10 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
      res = WriteF(stream, " weak", NULL);
      if (res != ResOK) return res;
   }
-  res = WriteF(stream, "\n"
-               "white  $B\n", (WriteFB)seg->white,
-               "grey   $B\n", (WriteFB)seg->grey,
-               "nailed $B\n", (WriteFB)seg->nailed,
+  res = WriteF(stream, "\n",
+               "  white  $B\n", (WriteFB)seg->white,
+               "  grey   $B\n", (WriteFB)seg->grey,
+               "  nailed $B\n", (WriteFB)seg->nailed,
                NULL);
   return res;
 }
@@ -1626,13 +1627,17 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream)
   res = super->describe(seg, stream);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "summary $W\n", (WriteFW)gcseg->summary, NULL);
+  res = WriteF(stream,
+               "  summary $W\n", (WriteFW)gcseg->summary,
+               NULL);
   if (res != ResOK) return res;
 
-  if (gcseg->buffer == NULL)
-    res = WriteF(stream, "buffer: NULL\n", NULL);
-  else
+  if (gcseg->buffer == NULL) {
+    res = WriteF(stream, "  buffer: NULL\n", NULL);
+  }
+  else {
     res = BufferDescribe(gcseg->buffer, stream);
+  }
   if (res != ResOK) return res;
 
   return ResOK;
diff --git a/mps/code/splay.c b/mps/code/splay.c
index b0fbeb4d326..7e061cd14f4 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -1335,7 +1335,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
 
   res = WriteF(stream,
                "Splay $P {\n", (WriteFP)splay,
-               "compare $F\n", (WriteFF)splay->compare,
+               "  compare $F\n", (WriteFF)splay->compare,
                NULL);
   if (res != ResOK) return res;
 
@@ -1344,7 +1344,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, "\n} Splay $P\n", (WriteFP)splay, NULL);
+  res = WriteF(stream, "\n}\n", NULL);
   return res;
 }
 
diff --git a/mps/code/than.c b/mps/code/than.c
index 199f2321e4d..a1dab12adc8 100644
--- a/mps/code/than.c
+++ b/mps/code/than.c
@@ -134,7 +134,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "arena $P ($U)\n", 
+               "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
diff --git a/mps/code/thix.c b/mps/code/thix.c
index 3bd4b1fb846..cc380dd040f 100644
--- a/mps/code/thix.c
+++ b/mps/code/thix.c
@@ -278,9 +278,9 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "arena $P ($U)\n",
+               "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "id $U\n",          (WriteFU)thread->id,
+               "  id $U\n",          (WriteFU)thread->id,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/thw3.c b/mps/code/thw3.c
index c2c0988bb91..701ffc53cdd 100644
--- a/mps/code/thw3.c
+++ b/mps/code/thw3.c
@@ -218,10 +218,10 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
  
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "arena $P ($U)\n", 
+               "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "handle $W\n",      (WriteFW)thread->handle,
-               "id $U\n",          (WriteFU)thread->id,
+               "  handle $W\n",      (WriteFW)thread->handle,
+               "  id $U\n",          (WriteFU)thread->id,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/thxc.c b/mps/code/thxc.c
index 48d497d67f0..9e6a6bd325c 100644
--- a/mps/code/thxc.c
+++ b/mps/code/thxc.c
@@ -254,9 +254,9 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
 
   res = WriteF(stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
-               "arena $P ($U)\n",
+               "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
-               "port $U\n", (WriteFU)thread->port,
+               "  port $U\n", (WriteFU)thread->port,
                "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial,
                NULL);
   if(res != ResOK) return res;

From 2493f121dc0767b8d757c729e76166a5c5b6c804 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 18:20:38 +0100
Subject: [PATCH 12/70] Correct indentation of describe output by passing depth
 parameter to describe functions and to writef.

Call Describe functions from test cases so that we get coverage.

Copied from Perforce
 Change: 186000
 ServerID: perforce.ravenbrook.com
---
 mps/code/abq.c           |  22 ++++----
 mps/code/abq.h           |   4 +-
 mps/code/amcss.c         |   3 ++
 mps/code/amsss.c         |   3 ++
 mps/code/arena.c         |  61 +++++++++++-----------
 mps/code/arenacv.c       |   5 +-
 mps/code/arenavm.c       |   4 +-
 mps/code/buffer.c        |  21 ++++----
 mps/code/cbs.c           |  15 +++---
 mps/code/cbs.h           |   2 +-
 mps/code/chain.h         |   6 +--
 mps/code/clock.h         |  16 +++---
 mps/code/event.c         |  28 +++++-----
 mps/code/event.h         |   2 +-
 mps/code/fbmtest.c       |  10 ++--
 mps/code/format.c        |   4 +-
 mps/code/freelist.c      |  14 ++---
 mps/code/freelist.h      |   2 +-
 mps/code/global.c        |  78 ++++++++++++++--------------
 mps/code/locus.c         |  32 ++++++------
 mps/code/meter.c         |  12 ++---
 mps/code/meter.h         |   8 +--
 mps/code/mpm.c           |  20 +++++--
 mps/code/mpm.h           |  30 +++++------
 mps/code/mpmtypes.h      |   8 +--
 mps/code/mv2test.c       |  18 +++----
 mps/code/nailboard.c     |  12 ++---
 mps/code/nailboard.h     |   2 +-
 mps/code/nailboardtest.c |   2 +
 mps/code/pool.c          |  30 +++++------
 mps/code/poolabs.c       |   6 ++-
 mps/code/poolamc.c       |  55 ++++++++++----------
 mps/code/poolams.c       |  53 +++++++++----------
 mps/code/poolmfs.c       |  14 ++---
 mps/code/poolmrg.c       |   8 +--
 mps/code/poolmv.c        |  43 +++++++--------
 mps/code/poolmv2.c       | 109 ++++++++++++++++++++-------------------
 mps/code/poolmvff.c      |  10 ++--
 mps/code/pooln.c         |   3 +-
 mps/code/poolncv.c       |   5 +-
 mps/code/range.c         |   6 +--
 mps/code/range.h         |   2 +-
 mps/code/root.c          |  35 +++++++------
 mps/code/seg.c           |  92 ++++++++++++---------------------
 mps/code/splay.c         |  22 ++++----
 mps/code/splay.h         |   1 +
 mps/code/th.h            |   2 +-
 mps/code/than.c          |   4 +-
 mps/code/thix.c          |   4 +-
 mps/code/thw3.c          |   4 +-
 mps/code/thxc.c          |   4 +-
 mps/code/trace.c         |   7 +--
 mps/design/buffer.txt    |   4 +-
 mps/design/cbs.txt       |  15 +++---
 mps/design/diag.txt      |  32 ++++++------
 mps/design/freelist.txt  |   4 +-
 mps/design/poolawl.txt   |   2 +-
 mps/design/poolmrg.txt   |   3 +-
 mps/design/splay.txt     |  23 +++++----
 mps/design/telemetry.txt |   2 +-
 mps/design/writef.txt    |  51 ++++++++++--------
 61 files changed, 554 insertions(+), 545 deletions(-)

diff --git a/mps/code/abq.c b/mps/code/abq.c
index 22286354c77..63abd1e5725 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -156,7 +156,7 @@ Bool ABQPeek(ABQ abq, void *elementReturn)
 
 
 /* ABQDescribe -- Describe an ABQ */
-Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream)
+Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Index index;
@@ -164,8 +164,8 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
   if (!TESTT(ABQ, abq)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
-               "ABQ $P\n{\n", (WriteFP)abq,
+  res = WriteF(depth, stream,
+               "ABQ $P {\n", (WriteFP)abq,
                "  elements: $U \n", (WriteFU)abq->elements,
                "  in: $U \n", (WriteFU)abq->in,
                "  out: $U \n", (WriteFU)abq->out,
@@ -175,22 +175,18 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
     return res;
 
   for (index = abq->out; index != abq->in; ) {
-    res = (*describeElement)(ABQElement(abq, index), stream);
+    res = (*describeElement)(ABQElement(abq, index), stream, depth + 2);
     if(res != ResOK)
       return res;
     index = ABQNextIndex(abq, index);
   }
 
-  res = WriteF(stream, "\n", NULL);
-  if(res != ResOK)
-    return res;
+  METER_WRITE(abq->push, stream, depth + 2);
+  METER_WRITE(abq->pop, stream, depth + 2);
+  METER_WRITE(abq->peek, stream, depth + 2);
+  METER_WRITE(abq->delete, stream, depth + 2);
 
-  METER_WRITE(abq->push, stream);
-  METER_WRITE(abq->pop, stream);
-  METER_WRITE(abq->peek, stream);
-  METER_WRITE(abq->delete, stream);
- 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} ABQ $P\n", (WriteFP)abq, NULL);
   if(res != ResOK)
     return res;
  
diff --git a/mps/code/abq.h b/mps/code/abq.h
index 022fc7e5301..ec37cbfaa31 100644
--- a/mps/code/abq.h
+++ b/mps/code/abq.h
@@ -23,7 +23,7 @@
 /* Prototypes  */
 
 typedef struct ABQStruct *ABQ;
-typedef Res (*ABQDescribeElement)(void *element, mps_lib_FILE *stream);
+typedef Res (*ABQDescribeElement)(void *element, mps_lib_FILE *stream, Count depth);
 typedef Bool (*ABQIterateMethod)(Bool *deleteReturn, void *element, void *closureP, Size closureS);
 
 extern Res ABQInit(Arena arena, ABQ abq, void *owner, Count elements, Size elementSize);
@@ -32,7 +32,7 @@ extern void ABQFinish(Arena arena, ABQ abq);
 extern Bool ABQPush(ABQ abq, void *element);
 extern Bool ABQPop(ABQ abq, void *elementReturn);
 extern Bool ABQPeek(ABQ abq, void *elementReturn);
-extern Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream);
+extern Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *stream, Count depth);
 extern Bool ABQIsEmpty(ABQ abq);
 extern Bool ABQIsFull(ABQ abq);
 extern Count ABQDepth(ABQ abq);
diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 48892a45830..1b50268e88a 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -8,6 +8,7 @@
 #include "fmtdy.h"
 #include "fmtdytst.h"
 #include "testlib.h"
+#include "mpm.h"
 #include "mpslib.h"
 #include "mpscamc.h"
 #include "mpsavm.h"
@@ -274,6 +275,8 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
     ++objs;
   }
 
+  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "PoolDescribe");
+
   (void)mps_commit(busy_ap, busy_init, 64);
   mps_ap_destroy(busy_ap);
   mps_ap_destroy(ap);
diff --git a/mps/code/amsss.c b/mps/code/amsss.c
index 1d04f199349..95d735aae1c 100644
--- a/mps/code/amsss.c
+++ b/mps/code/amsss.c
@@ -16,6 +16,7 @@
 #include "mpsavm.h"
 #include "mpstd.h"
 #include "mps.h"
+#include "mpm.h"
 
 #include <stdio.h> /* fflush, printf */
 
@@ -141,6 +142,8 @@ static void *test(void *arg, size_t haveAmbigous)
   /* create an ap, and leave it busy */
   die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
 
+  die(PoolDescribe(pool, mps_lib_get_stdout(), 0), "PoolDescribe");
+
   objs = 0; totalSize = 0;
   while(totalSize < totalSizeMAX) {
     if (totalSize > lastStep + totalSizeSTEP) {
diff --git a/mps/code/arena.c b/mps/code/arena.c
index 30f7687ce81..b344b3a6129 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -30,7 +30,7 @@ static void arenaFreePage(Arena arena, Addr base, Pool pool);
 
 /* ArenaTrivDescribe -- produce trivial description of an arena */
 
-static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream)
+static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 {
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
@@ -47,8 +47,8 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream)
    * subclass describe method should avoid invoking 
    * ARENA_SUPERCLASS()->describe.  RHSK 2007-04-27.
    */
-  return WriteF(stream,
-    "  No class-specific description available.\n", NULL);
+  return WriteF(depth, stream,
+                "  No class-specific description available.\n", NULL);
 }
 
 
@@ -428,7 +428,7 @@ void ControlFinish(Arena arena)
 
 /* ArenaDescribe -- describe the arena */
 
-Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
+Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Size reserved;
@@ -436,58 +436,57 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream, "Arena $P {\n", (WriteFP)arena,
+  res = WriteF(depth, stream, "Arena $P {\n", (WriteFP)arena,
                "  class $P (\"$S\")\n",
                (WriteFP)arena->class, arena->class->name,
                NULL);
   if (res != ResOK) return res;
 
   if (arena->poolReady) {
-    res = WriteF(stream,
-                 "  controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
+    res = WriteF(depth + 2, stream,
+                 "controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
                  NULL);
     if (res != ResOK) return res;
   }
 
   /* Note: this Describe clause calls a function */
   reserved = ArenaReserved(arena);
-  res = WriteF(stream,
-               "  reserved         $W  <-- "
+  res = WriteF(depth + 2, stream,
+               "reserved         $W  <-- "
                "total size of address-space reserved\n",
                (WriteFW)reserved,
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  committed        $W  <-- "
+  res = WriteF(depth + 2, stream,
+               "committed        $W  <-- "
                "total bytes currently stored (in RAM or swap)\n",
                (WriteFW)arena->committed,
-               "  commitLimit      $W\n", (WriteFW)arena->commitLimit,
-               "  spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
-               "  spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
-               "  zoneShift $U\n", (WriteFU)arena->zoneShift,
-               "  alignment $W\n", (WriteFW)arena->alignment,
+               "commitLimit      $W\n", (WriteFW)arena->commitLimit,
+               "spareCommitted   $W\n", (WriteFW)arena->spareCommitted,
+               "spareCommitLimit $W\n", (WriteFW)arena->spareCommitLimit,
+               "zoneShift $U\n", (WriteFU)arena->zoneShift,
+               "alignment $W\n", (WriteFW)arena->alignment,
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
+  res = WriteF(depth + 2, stream,
+               "droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
                (arena->droppedMessages == 0 ? "" : "  -- MESSAGES DROPPED!"),
                NULL);
   if (res != ResOK) return res;
 
-  res = (*arena->class->describe)(arena, stream);
+  res = (*arena->class->describe)(arena, stream, depth);
   if (res != ResOK) return res;
 
-  /* Do not call GlobalsDescribe: it makes too much output, thanks.
-   * RHSK 2007-04-27
-   */
-#if 0
-  res = GlobalsDescribe(ArenaGlobals(arena), stream);
+  res = WriteF(depth + 2, stream, "Globals {\n", NULL);
+  if (res != ResOK) return res;  
+  res = GlobalsDescribe(ArenaGlobals(arena), stream, depth + 4);
   if (res != ResOK) return res;
-#endif
+  res = WriteF(depth + 2, stream, "} Globals\n", NULL);
+  if (res != ResOK) return res;  
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "} Arena $P ($U)\n", (WriteFP)arena,
                (WriteFU)arena->serial,
                NULL);
@@ -497,7 +496,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
 
 /* ArenaDescribeTracts -- describe all the tracts in the arena */
 
-Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
+Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Tract tract;
@@ -516,7 +515,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
     size = ArenaAlign(arena);
 
     if (TractBase(tract) > oldLimit) {
-      res = WriteF(stream,
+      res = WriteF(depth, stream,
                    "[$P, $P) $W $U   ---\n",
                    (WriteFP)oldLimit, (WriteFP)base,
                    (WriteFW)AddrOffset(oldLimit, base),
@@ -525,7 +524,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
       if (res != ResOK) return res;
     }
 
-    res = WriteF(stream,
+    res = WriteF(depth, stream,
                  "[$P, $P) $W $U   $P ($S)\n",
                  (WriteFP)base, (WriteFP)limit,
                  (WriteFW)size, (WriteFW)size,
@@ -586,14 +585,14 @@ void ControlFree(Arena arena, void* base, size_t size)
 
 /* ControlDescribe -- describe the arena's control pool */
 
-Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
+Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = PoolDescribe(ArenaControlPool(arena), stream);
+  res = PoolDescribe(ArenaControlPool(arena), stream, depth);
 
   return res;
 }
diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c
index d5e56eaec2d..fada3b82692 100644
--- a/mps/code/arenacv.c
+++ b/mps/code/arenacv.c
@@ -332,7 +332,6 @@ static void testAllocAndIterate(Arena arena, Pool pool,
     }
     SegPrefExpress(&pref, SegPrefZoneSet, &zone);
   }
-
 }
 
 
@@ -363,6 +362,10 @@ static void testPageTable(ArenaClass class, Size size, Addr addr, Bool zoned)
   testAllocAndIterate(arena, pool, pageSize, tractsPerPage,
                       &allocatorSegStruct);
 
+  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
+  die(ArenaDescribeTracts(arena, mps_lib_get_stdout(), 0),
+      "ArenaDescribeTracts");
+
   PoolDestroy(pool);
   ArenaDestroy(arena);
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 81e0684c436..4b74b2ac68d 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -184,7 +184,7 @@ static Bool VMArenaCheck(VMArena vmArena)
 
 /* VMArenaDescribe -- describe the VMArena
  */
-static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
+static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   VMArena vmArena;
@@ -204,7 +204,7 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
    *
   */
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "  spareSize:     $U\n", (WriteFU)vmArena->spareSize,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index eefbd5088cc..13d223ca7f6 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -146,14 +146,14 @@ Bool BufferCheck(Buffer buffer)
  *
  * See <code/mpmst.h> for structure definitions.  */
 
-Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
+Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(Buffer, buffer)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
                "  class $P (\"$S\")\n",
@@ -178,10 +178,10 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
 
-  res = buffer->class->describe(buffer, stream);
+  res = buffer->class->describe(buffer, stream, depth + 2);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "} Buffer $P ($U)\n",
+  res = WriteF(depth, stream, "} Buffer $P ($U)\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
                NULL);
   return res;
@@ -1164,10 +1164,11 @@ static void bufferNoReassignSeg(Buffer buffer, Seg seg)
 
 /* bufferTrivDescribe -- basic Buffer describe method */
 
-static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream)
+static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
 {
   if (!TESTT(Buffer, buffer)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
+  UNUSED(depth);
   /* dispatching function does it all */
   return ResOK;
 }
@@ -1422,7 +1423,7 @@ static void segBufReassignSeg (Buffer buffer, Seg seg)
 
 /* segBufDescribe --  describe method for SegBuf */
 
-static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream)
+static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
 {
   SegBuf segbuf;
   BufferClass super;
@@ -1435,12 +1436,12 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream)
 
   /* Describe the superclass fields first via next-method call */
   super = BUFFER_SUPERCLASS(SegBufClass);
-  res = super->describe(buffer, stream);
+  res = super->describe(buffer, stream, depth);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  Seg $P\n",         (WriteFP)segbuf->seg,
-               "  rankSet $U\n",     (WriteFU)segbuf->rankSet,
+  res = WriteF(depth, stream,
+               "Seg $P\n",         (WriteFP)segbuf->seg,
+               "rankSet $U\n",     (WriteFU)segbuf->rankSet,
                NULL);
 
   return res;
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 118d226a603..942f1b651c8 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -660,7 +660,7 @@ static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(0, stream,
                "[$P,$P) {$U, $B}",
                (WriteFP)block->base,
                (WriteFP)block->limit,
@@ -1055,7 +1055,7 @@ Bool CBSFindLargest(Range rangeReturn, Range oldRangeReturn,
  * See <design/cbs/#function.cbs.describe>.
  */
 
-Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
+Res CBSDescribe(CBS cbs, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
@@ -1064,7 +1064,7 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "CBS $P {\n", (WriteFP)cbs,
                "  alignment: $U\n", (WriteFU)cbs->alignment,
                "  blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
@@ -1074,12 +1074,13 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
 
-  res = SplayTreeDescribe(cbsSplay(cbs), stream, &cbsSplayNodeDescribe);
+  METER_WRITE(cbs->treeSearch, stream, depth + 2);
+
+  res = SplayTreeDescribe(cbsSplay(cbs), stream, depth + 2,
+                          &cbsSplayNodeDescribe);
   if (res != ResOK) return res;
 
-  METER_WRITE(cbs->treeSearch, stream);
-
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} CBS $P\n", (WriteFP)cbs, NULL);
   return res;
 }
 
diff --git a/mps/code/cbs.h b/mps/code/cbs.h
index e425bd80cf8..64d00f5c015 100644
--- a/mps/code/cbs.h
+++ b/mps/code/cbs.h
@@ -50,7 +50,7 @@ extern Res CBSDelete(Range rangeReturn, CBS cbs, Range range);
 extern void CBSIterate(CBS cbs, CBSVisitor visitor,
                        void *closureP, Size closureS);
 
-extern Res CBSDescribe(CBS cbs, mps_lib_FILE *stream);
+extern Res CBSDescribe(CBS cbs, mps_lib_FILE *stream, Count depth);
 
 typedef Bool (*CBSFindMethod)(Range rangeReturn, Range oldRangeReturn,
                               CBS cbs, Size size, FindDelete findDelete);
diff --git a/mps/code/chain.h b/mps/code/chain.h
index d3df265a0f2..7e62262e1cd 100644
--- a/mps/code/chain.h
+++ b/mps/code/chain.h
@@ -74,7 +74,7 @@ typedef struct mps_chain_s {
 } ChainStruct;
 
 
-extern Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream);
+extern Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth);
 
 extern Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
                        GenParamStruct *params);
@@ -90,14 +90,14 @@ extern size_t ChainGens(Chain chain);
 extern Res ChainAlloc(Seg *segReturn, Chain chain, Serial genNr,
                       SegClass class, Size size, Pool pool,
                       Bool withReservoirPermit, ArgList args);
-extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream);
+extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth);
 
 extern Bool PoolGenCheck(PoolGen gen);
 extern Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool);
 extern void PoolGenFinish(PoolGen gen);
 extern void PoolGenFlip(PoolGen gen);
 #define PoolGenNr(gen) ((gen)->nr)
-extern Res PoolGenDescribe(PoolGen gen, mps_lib_FILE *stream);
+extern Res PoolGenDescribe(PoolGen gen, mps_lib_FILE *stream, Count depth);
 
 
 #endif /* chain_h */
diff --git a/mps/code/clock.h b/mps/code/clock.h
index 253f7a5e0e4..9b0dc7d6203 100644
--- a/mps/code/clock.h
+++ b/mps/code/clock.h
@@ -66,8 +66,8 @@ typedef union EventClockUnion {
           (*(EventClockUnion *)&(clock)).half.high, \
           (*(EventClockUnion *)&(clock)).half.low)
 
-#define EVENT_CLOCK_WRITE(stream, clock) \
-  WriteF(stream, "$W$W", \
+#define EVENT_CLOCK_WRITE(depth, stream, clock)  \
+  WriteF(depth, stream, "$W$W", \
          (*(EventClockUnion *)&(clock)).half.high, \
          (*(EventClockUnion *)&(clock)).half.low, \
          NULL)
@@ -86,8 +86,8 @@ typedef union EventClockUnion {
 
 #endif
 
-#define EVENT_CLOCK_WRITE(stream, clock) \
-  WriteF(stream, "$W", (WriteFW)(clock), NULL)
+#define EVENT_CLOCK_WRITE(depth, stream, clock) \
+  WriteF(depth, stream, "$W", (WriteFW)(clock), NULL)
 
 #endif
 
@@ -136,8 +136,8 @@ __extension__ typedef unsigned long long EventClock;
           (unsigned long)((clock) >> 32), \
           (unsigned long)((clock) & 0xffffffff))
 
-#define EVENT_CLOCK_WRITE(stream, clock) \
-  WriteF(stream, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL)
+#define EVENT_CLOCK_WRITE(depth, stream, clock) \
+  WriteF(depth, stream, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL)
 
 #endif /* Intel, GCC or Clang */
 
@@ -154,8 +154,8 @@ typedef mps_clock_t EventClock;
 #define EVENT_CLOCK_PRINT(stream, clock) \
   fprintf(stream, "%lu", (unsigned long)clock)
 
-#define EVENT_CLOCK_WRITE(stream, clock) \
-  WriteF(stream, "$W", (WriteFW)clock, NULL)
+#define EVENT_CLOCK_WRITE(depth, stream, clock) \
+  WriteF(depth, stream, "$W", (WriteFW)clock, NULL)
 
 #endif
 
diff --git a/mps/code/event.c b/mps/code/event.c
index 475fa4f875c..54be8cba89f 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -319,7 +319,7 @@ void EventLabelAddr(Addr addr, EventStringId id)
   " $U", (WriteFU)event->name.f##index,
 
 
-Res EventDescribe(Event event, mps_lib_FILE *stream)
+Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
@@ -329,14 +329,14 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Event $P {\n", (WriteFP)event,
                "  code $U\n", (WriteFU)event->any.code,
                "  clock ", NULL);
   if (res != ResOK) return res;
-  res = EVENT_CLOCK_WRITE(stream, event->any.clock);
+  res = EVENT_CLOCK_WRITE(depth, stream, event->any.clock);
   if (res != ResOK) return res;
-  res = WriteF(stream, "\n  size $U\n", (WriteFU)event->any.size, NULL);
+  res = WriteF(depth, stream, "\n  size $U\n", (WriteFU)event->any.size, NULL);
   if (res != ResOK) return res;
 
   switch (event->any.code) {
@@ -347,7 +347,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
 
 #define EVENT_DESC(X, name, _code, always, kind) \
   case _code: \
-    res = WriteF(stream, \
+    res = WriteF(depth, stream, \
                  "  event \"$S\"", (WriteFS)#name, \
                  EVENT_##name##_PARAMS(EVENT_DESC_PARAM, name) \
                  NULL); \
@@ -357,13 +357,13 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
   EVENT_LIST(EVENT_DESC, X)
 
   default:
-    res = WriteF(stream, "  event type unknown", NULL);
+    res = WriteF(depth, stream, "  event type unknown", NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
   }
   
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "\n} Event $P\n", (WriteFP)event,
                NULL);
   return res;
@@ -377,7 +377,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
   if (event == NULL) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = EVENT_CLOCK_WRITE(stream, event->any.clock);
+  res = EVENT_CLOCK_WRITE(0, stream, event->any.clock);
   if (res != ResOK)
     return res;
 
@@ -388,7 +388,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
 
 #define EVENT_WRITE(X, name, code, always, kind) \
   case code: \
-    res = WriteF(stream, " $S", #name, \
+    res = WriteF(0, stream, " $S", #name, \
                  EVENT_##name##_PARAMS(EVENT_WRITE_PARAM, name) \
                  NULL); \
     if (res != ResOK) return res; \
@@ -396,7 +396,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
   EVENT_LIST(EVENT_WRITE, X)
 
   default:
-    res = WriteF(stream, " <unknown code $U>", event->any.code, NULL);
+    res = WriteF(0, stream, " <unknown code $U>", event->any.code, NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
@@ -416,7 +416,7 @@ void EventDump(mps_lib_FILE *stream)
   /* This can happen if there's a backtrace very early in the life of
      the MPS, and will cause an access violation if we continue. */
   if (!eventInited) {
-    (void)WriteF(stream, "No events\n", NULL);
+    (void)WriteF(0, stream, "No events\n", NULL);
     return;
   }
 
@@ -427,7 +427,7 @@ void EventDump(mps_lib_FILE *stream)
       /* Try to keep going even if there's an error, because this is used as a
          backtrace and we'll take what we can get. */
       (void)EventWrite(event, stream);
-      (void)WriteF(stream, "\n", NULL);
+      (void)WriteF(0, stream, "\n", NULL);
     }
   }
 }
@@ -490,7 +490,7 @@ void EventLabelAddr(Addr addr, Word id)
 }
 
 
-Res EventDescribe(Event event, mps_lib_FILE *stream)
+Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
 {
   UNUSED(event);
   UNUSED(stream);
@@ -498,7 +498,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream)
 }
 
 
-Res EventWrite(Event event, mps_lib_FILE *stream)
+Res EventWrite(Event event, mps_lib_FILE *stream, Count depth)
 {
   UNUSED(event);
   UNUSED(stream);
diff --git a/mps/code/event.h b/mps/code/event.h
index 11884d30d6c..a586509f23e 100644
--- a/mps/code/event.h
+++ b/mps/code/event.h
@@ -33,7 +33,7 @@ extern EventStringId EventInternString(const char *label);
 extern EventStringId EventInternGenString(size_t, const char *label);
 extern void EventLabelAddr(Addr addr, Word id);
 extern void EventFlush(EventKind kind);
-extern Res EventDescribe(Event event, mps_lib_FILE *stream);
+extern Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth);
 extern Res EventWrite(Event event, mps_lib_FILE *stream);
 extern void EventDump(mps_lib_FILE *stream);
 
diff --git a/mps/code/fbmtest.c b/mps/code/fbmtest.c
index 231d02482a7..8a5fb63578e 100644
--- a/mps/code/fbmtest.c
+++ b/mps/code/fbmtest.c
@@ -39,7 +39,7 @@ SRCID(fbmtest, "$Id$");
 static Count NAllocateTried, NAllocateSucceeded, NDeallocateTried,
   NDeallocateSucceeded;
 
-static int verbose = 0;
+static Bool verbose = FALSE;
 
 typedef unsigned FBMType;
 enum {
@@ -81,10 +81,12 @@ static Index (indexOfAddr)(FBMState state, Addr a)
 static void describe(FBMState state) {
   switch (state->type) {
   case FBMTypeCBS:
-    die(CBSDescribe(state->the.cbs, mps_lib_get_stdout()), "CBSDescribe");
+    die(CBSDescribe(state->the.cbs, mps_lib_get_stdout(), 0),
+        "CBSDescribe");
     break;
   case FBMTypeFreelist:
-    die(FreelistDescribe(state->the.fl, mps_lib_get_stdout()), "FreelistDescribe");
+    die(FreelistDescribe(state->the.fl, mps_lib_get_stdout(), 0),
+        "FreelistDescribe");
     break;
   default:
     cdie(0, "invalid state->type");
@@ -542,6 +544,8 @@ static void test(FBMState state, unsigned n) {
     }
     if ((i + 1) % 1000 == 0)
       check(state);
+    if (i == 100)
+      describe(state);
   }
 }
 
diff --git a/mps/code/format.c b/mps/code/format.c
index 88a86283ef8..92f34b3de4c 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -193,11 +193,11 @@ Arena FormatArena(Format format)
 
 /* FormatDescribe -- describe a format */
 
-Res FormatDescribe(Format format, mps_lib_FILE *stream)
+Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial,
                "  arena $P ($U)\n",
                (WriteFP)format->arena, (WriteFU)format->arena->serial,
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 6260451ff59..814039a8723 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -551,14 +551,14 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
 {
   Res res;
   mps_lib_FILE *stream = closureP;
+  Count depth = closureS;
 
   AVER(deleteReturn != NULL);
   AVERT(Range, range);
   AVER(stream != NULL);
-  UNUSED(closureS);
 
-  res = WriteF(stream,
-               "  [$P,", (WriteFP)RangeBase(range),
+  res = WriteF(depth, stream,
+               "[$P,", (WriteFP)RangeBase(range),
                "$P)", (WriteFP)RangeLimit(range),
                " {$U}\n", (WriteFU)RangeSize(range),
                NULL);
@@ -568,22 +568,22 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
 }
 
 
-Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream)
+Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(Freelist, fl)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Freelist $P {\n", (WriteFP)fl,
                "  alignment = $U\n", (WriteFU)fl->alignment,
                "  listSize = $U\n", (WriteFU)fl->listSize,
                NULL);
 
-  FreelistIterate(fl, freelistDescribeIterateMethod, stream, 0);
+  FreelistIterate(fl, freelistDescribeIterateMethod, stream, depth + 2);
 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} Freelist $P\n", (WriteFP)fl, NULL);
   return res;
 }
 
diff --git a/mps/code/freelist.h b/mps/code/freelist.h
index 1bb9840c8c9..5957728a311 100644
--- a/mps/code/freelist.h
+++ b/mps/code/freelist.h
@@ -34,7 +34,7 @@ extern void FreelistFinish(Freelist fl);
 
 extern Res FreelistInsert(Range rangeReturn, Freelist fl, Range range);
 extern Res FreelistDelete(Range rangeReturn, Freelist fl, Range range);
-extern Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream);
+extern Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream, Count depth);
 
 extern void FreelistIterate(Freelist abq, FreelistIterateMethod iterate,
                             void *closureP, Size closureS);
diff --git a/mps/code/global.c b/mps/code/global.c
index 8fe6d7b51aa..ec2c8e0a80f 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1034,7 +1034,7 @@ Ref ArenaRead(Arena arena, Ref *p)
 
 /* GlobalsDescribe -- describe the arena globals */
 
-Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
+Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Arena arena;
@@ -1047,85 +1047,83 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   arena = GlobalsArena(arenaGlobals);
-  res = WriteF(stream,
-               "  mpsVersion $S\n", arenaGlobals->mpsVersionString,
-               "  lock $P\n", (WriteFP)arenaGlobals->lock,
-               "  pollThreshold $U kB\n",
+  res = WriteF(depth, stream,
+               "mpsVersion $S\n", arenaGlobals->mpsVersionString,
+               "lock $P\n", (WriteFP)arenaGlobals->lock,
+               "pollThreshold $U kB\n",
                (WriteFU)(arenaGlobals->pollThreshold / 1024),
                arenaGlobals->insidePoll ? "inside poll\n" : "outside poll\n",
                arenaGlobals->clamped ? "clamped\n" : "released\n",
-               "  fillMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
-               "  emptyMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
-               "  allocMutatorSize $U kB\n",
-                 (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
-               "  fillInternalSize $U kB\n",
-                 (WriteFU)(arenaGlobals->fillInternalSize / 1024),
-               "  emptyInternalSize $U kB\n",
-                 (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
-               "  poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
-               "  rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
-               "  formatSerial $U\n", (WriteFU)arena->formatSerial,
-               "  threadSerial $U\n", (WriteFU)arena->threadSerial,
+               "fillMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->fillMutatorSize / 1024),
+               "emptyMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->emptyMutatorSize / 1024),
+               "allocMutatorSize $U kB\n",
+               (WriteFU)(arenaGlobals->allocMutatorSize / 1024),
+               "fillInternalSize $U kB\n",
+               (WriteFU)(arenaGlobals->fillInternalSize / 1024),
+               "emptyInternalSize $U kB\n",
+               (WriteFU)(arenaGlobals->emptyInternalSize / 1024),
+               "poolSerial $U\n", (WriteFU)arenaGlobals->poolSerial,
+               "rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
+               "formatSerial $U\n", (WriteFU)arena->formatSerial,
+               "threadSerial $U\n", (WriteFU)arena->threadSerial,
                arena->insideShield ? "inside shield\n" : "outside shield\n",
-               "  busyTraces    $B\n", (WriteFB)arena->busyTraces,
-               "  flippedTraces $B\n", (WriteFB)arena->flippedTraces,
-               "  epoch $U\n", (WriteFU)arena->epoch,
+               "busyTraces    $B\n", (WriteFB)arena->busyTraces,
+               "flippedTraces $B\n", (WriteFB)arena->flippedTraces,
+               "epoch $U\n", (WriteFU)arena->epoch,
+               "prehistory = $B\n", (WriteFB)arena->prehistory,
+               "history {\n",
+               "  [note: indices are raw, not rotated]\n",
                NULL);
   if (res != ResOK) return res;
 
   for(i=0; i < LDHistoryLENGTH; ++ i) {
-    res = WriteF(stream,
-                 "    history[$U] = $B\n", i, arena->history[i],
+    res = WriteF(depth + 2, stream,
+                 "[$U] = $B\n", i, arena->history[i],
                  NULL);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream,
-               "    [note: indices are raw, not rotated]\n"
-               "    prehistory = $B\n", (WriteFB)arena->prehistory,
-               NULL);
-  if (res != ResOK) return res;
-
-  res = WriteF(stream,
-               "  suspended $S\n", arena->suspended ? "YES" : "NO",
-               "  shDepth $U\n", arena->shDepth,
-               "  shCacheI $U\n", arena->shCacheI,
+  res = WriteF(depth, stream,
+               "} history\n",
+               "suspended $S\n", arena->suspended ? "YES" : "NO",
+               "shDepth $U\n", arena->shDepth,
+               "shCacheI $U\n", arena->shCacheI,
                /* @@@@ should SegDescribe the cached segs? */
                NULL);
   if (res != ResOK) return res;
 
-  res = RootsDescribe(arenaGlobals, stream);
+  res = RootsDescribe(arenaGlobals, stream, depth);
   if (res != ResOK) return res;
 
   RING_FOR(node, &arenaGlobals->poolRing, nextNode) {
     Pool pool = RING_ELT(Pool, arenaRing, node);
-    res = PoolDescribe(pool, stream);
+    res = PoolDescribe(pool, stream, depth);
     if (res != ResOK) return res;
   }
 
   RING_FOR(node, &arena->formatRing, nextNode) {
     Format format = RING_ELT(Format, arenaRing, node);
-    res = FormatDescribe(format, stream);
+    res = FormatDescribe(format, stream, depth);
     if (res != ResOK) return res;
   }
 
   RING_FOR(node, &arena->threadRing, nextNode) {
     Thread thread = ThreadRingThread(node);
-    res = ThreadDescribe(thread, stream);
+    res = ThreadDescribe(thread, stream, depth);
     if (res != ResOK) return res;
   }
 
   RING_FOR(node, &arena->chainRing, nextNode) {
     Chain chain = RING_ELT(Chain, chainRing, node);
-    res = ChainDescribe(chain, stream);
+    res = ChainDescribe(chain, stream, depth);
     if (res != ResOK) return res;
   }
 
   TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
     if (TraceSetIsMember(arena->busyTraces, trace)) {
-      res = TraceDescribe(trace, stream);
+      res = TraceDescribe(trace, stream, depth);
       if (res != ResOK) return res;
     }
   TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
diff --git a/mps/code/locus.c b/mps/code/locus.c
index f90e146f675..c5baf0f542b 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -128,7 +128,7 @@ static Size GenDescTotalSize(GenDesc gen)
 
 /* GenDescDescribe -- describe a generation in a chain */
 
-Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream)
+Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Ring node, nextNode;
@@ -136,22 +136,22 @@ Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream)
   if (!TESTT(GenDesc, gen)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "GenDesc $P {\n", (WriteFP)gen,
-               "zones $B\n", (WriteFB)gen->zones,
-               "capacity $U\n", (WriteFU)gen->capacity,
-               "mortality $D\n", (WriteFD)gen->mortality,
-               "proflow $D\n", (WriteFD)gen->proflow,
+               "  zones $B\n", (WriteFB)gen->zones,
+               "  capacity $U\n", (WriteFU)gen->capacity,
+               "  mortality $D\n", (WriteFD)gen->mortality,
+               "  proflow $D\n", (WriteFD)gen->proflow,
                NULL);
   if (res != ResOK) return res;
 
   RING_FOR(node, &gen->locusRing, nextNode) {
     PoolGen pgen = RING_ELT(PoolGen, genRing, node);
-    res = PoolGenDescribe(pgen, stream);
+    res = PoolGenDescribe(pgen, stream, depth + 2);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, "} GenDesc $P\n", (WriteFP)gen, NULL);
+  res = WriteF(depth, stream, "} GenDesc $P\n", (WriteFP)gen, NULL);
   return res;
 }
 
@@ -443,7 +443,7 @@ void ChainEndGC(Chain chain, Trace trace)
 
 /* ChainDescribe -- describe a chain */
 
-Res ChainDescribe(Chain chain, mps_lib_FILE *stream)
+Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   size_t i;
@@ -451,19 +451,19 @@ Res ChainDescribe(Chain chain, mps_lib_FILE *stream)
   if (!TESTT(Chain, chain)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Chain $P {\n", (WriteFP)chain,
-               "arena $P\n", (WriteFP)chain->arena,
-               "activeTraces $B\n", (WriteFB)chain->activeTraces,
+               "  arena $P\n", (WriteFP)chain->arena,
+               "  activeTraces $B\n", (WriteFB)chain->activeTraces,
                NULL);
   if (res != ResOK) return res;
 
   for (i = 0; i < chain->genCount; ++i) {
-    res = GenDescDescribe(&chain->gens[i], stream);
+    res = GenDescDescribe(&chain->gens[i], stream, depth + 2);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "} Chain $P\n", (WriteFP)chain,
                NULL);
   return res;
@@ -525,14 +525,14 @@ Bool PoolGenCheck(PoolGen gen)
 
 /* PoolGenDescribe -- describe a PoolGen */
 
-Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream)
+Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(PoolGen, pgen)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
   
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "PoolGen $P ($U) {\n", (WriteFP)pgen, (WriteFU)pgen->nr,
                "pool $P ($U) \"$S\"\n",
                (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
diff --git a/mps/code/meter.c b/mps/code/meter.c
index 92937c1c941..debf0ee3fcc 100644
--- a/mps/code/meter.c
+++ b/mps/code/meter.c
@@ -64,12 +64,12 @@ void MeterAccumulate(Meter meter, Size amount)
 
 /* MeterWrite -- describe method for meters */
 
-Res MeterWrite(Meter meter, mps_lib_FILE *stream)
+Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth)
 {
   Res res = ResOK;
 
-  res = WriteF(stream,
-               "meter $S {", meter->name,
+  res = WriteF(depth, stream,
+               "meter \"$S\" {", meter->name,
                "count: $U", meter->count,
                NULL);
   if (res != ResOK)
@@ -77,7 +77,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream)
   if (meter->count > 0) {
     double mean = meter->total / (double)meter->count;
    
-    res = WriteF(stream,
+    res = WriteF(0, stream,
                  ", total: $D", meter->total,
                  ", max: $U", meter->max,
                  ", min: $U", meter->min,
@@ -87,7 +87,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream)
     if (res != ResOK)
       return res;
   }
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(0, stream, "}\n", NULL);
 
   return res;
 }
@@ -98,7 +98,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream)
 void MeterEmit(Meter meter)
 {
   EVENT6(MeterValues, meter, meter->total, meter->meanSquared,
-               meter->count, meter->max, meter->min);
+         meter->count, meter->max, meter->min);
 }
 
 
diff --git a/mps/code/meter.h b/mps/code/meter.h
index f1731400e42..9ac571cae22 100644
--- a/mps/code/meter.h
+++ b/mps/code/meter.h
@@ -35,7 +35,7 @@ typedef struct MeterStruct
 
 extern void MeterInit(Meter meter, const char *name, void *owner);
 extern void MeterAccumulate(Meter meter, Size amount);
-extern Res MeterWrite(Meter meter, mps_lib_FILE *stream);
+extern Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth);
 extern void MeterEmit(Meter meter);
 
 #define METER_DECL(meter) STATISTIC_DECL(struct MeterStruct meter)
@@ -45,12 +45,12 @@ extern void MeterEmit(Meter meter);
 #define METER_ACC(meter, delta) \
   STATISTIC(MeterAccumulate(&(meter), delta))
 #if defined(STATISTICS)
-#define METER_WRITE(meter, stream) BEGIN \
-    Res _res = MeterWrite(&(meter), (stream)); \
+#define METER_WRITE(meter, stream, depth) BEGIN \
+    Res _res = MeterWrite(&(meter), (stream), (depth)); \
     if (_res != ResOK) return _res; \
   END
 #elif defined(STATISTICS_NONE)
-#define METER_WRITE(meter, stream) NOOP
+#define METER_WRITE(meter, stream, depth) NOOP
 #else
 #error "No statistics configured."
 #endif
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 5584e0aa00e..5de82a1f022 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -430,34 +430,35 @@ static Res WriteDouble(mps_lib_FILE *stream, double d)
  * .writef.check: See .check.writef.
  */
 
-Res WriteF(mps_lib_FILE *stream, ...)
+Res WriteF(Count depth, mps_lib_FILE *stream, ...)
 {
   Res res;
   va_list args;
  
   va_start(args, stream);
-  res = WriteF_v(stream, args);
+  res = WriteF_v(depth, stream, args);
   va_end(args);
   return res;
 }
 
-Res WriteF_v(mps_lib_FILE *stream, va_list args)
+Res WriteF_v(Count depth, mps_lib_FILE *stream, va_list args)
 {
   const char *firstformat;
   Res res;
 
   firstformat = va_arg(args, const char *);
-  res = WriteF_firstformat_v(stream, firstformat, args);
+  res = WriteF_firstformat_v(depth, stream, firstformat, args);
   return res;
 }
 
-Res WriteF_firstformat_v(mps_lib_FILE *stream, 
+Res WriteF_firstformat_v(Count depth, mps_lib_FILE *stream, 
                          const char *firstformat, va_list args)
 {
   const char *format;
   int r;
   size_t i;
   Res res;
+  Bool start_of_line = TRUE;
 
   AVER(stream != NULL);
 
@@ -468,9 +469,18 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream,
       break;
 
     while(*format != '\0') {
+      if (start_of_line) {
+        for (i = 0; i < depth; ++i) {
+          mps_lib_fputc(' ', stream);
+        }
+        start_of_line = FALSE;
+      }
       if (*format != '$') {
         r = mps_lib_fputc(*format, stream); /* Could be more efficient */
         if (r == mps_lib_EOF) return ResIO;
+        if (*format == '\n') {
+          start_of_line = TRUE;
+        }
       } else {
         ++format;
         AVER(*format != '\0');
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 14bd71be909..c41e3b2e61d 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -153,9 +153,9 @@ extern Bool (WordIsP2)(Word word);
 
 /* Formatted Output -- see <design/writef/>, <code/mpm.c> */
 
-extern Res WriteF(mps_lib_FILE *stream, ...);
-extern Res WriteF_v(mps_lib_FILE *stream, va_list args);
-extern Res WriteF_firstformat_v(mps_lib_FILE *stream,
+extern Res WriteF(Count depth, mps_lib_FILE *stream, ...);
+extern Res WriteF_v(Count depth, mps_lib_FILE *stream, va_list args);
+extern Res WriteF_firstformat_v(Count depth, mps_lib_FILE *stream,
                                 const char *firstformat, va_list args);
 
 
@@ -178,7 +178,7 @@ extern Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args);
 extern void PoolFinish(Pool pool);
 extern Bool PoolClassCheck(PoolClass class);
 extern Bool PoolCheck(Pool pool);
-extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream);
+extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
 
 /* Must be thread-safe. See <design/interface-c/#thread-safety>. */
 #define PoolArena(pool)         ((pool)->arena)
@@ -239,7 +239,7 @@ extern void PoolNoBufferEmpty(Pool pool, Buffer buffer,
                               Addr init, Addr limit);
 extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer,
                                 Addr init, Addr limit);
-extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream);
+extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
 extern Res PoolNoTraceBegin(Pool pool, Trace trace);
 extern Res PoolTrivTraceBegin(Pool pool, Trace trace);
 extern Res PoolNoAccess(Pool pool, Seg seg, Addr addr,
@@ -397,7 +397,7 @@ extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
 
 extern void TraceQuantum(Trace trace);
 extern Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why);
-extern Res TraceDescribe(Trace trace, mps_lib_FILE *stream);
+extern Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth);
 
 /* traceanc.c -- Trace Ancillary */
 
@@ -493,8 +493,8 @@ extern void ArenaDestroy(Arena arena);
 extern Res ArenaInit(Arena arena, ArenaClass class, Align alignment,
                      ArgList args);
 extern void ArenaFinish(Arena arena);
-extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream);
-extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream);
+extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth);
+extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth);
 extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context);
 extern Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit);
 extern void ArenaFreeCBSDelete(Arena arena, Addr base, Addr limit);
@@ -505,7 +505,7 @@ extern Res GlobalsInit(Globals arena);
 extern void GlobalsFinish(Globals arena);
 extern Res GlobalsCompleteCreate(Globals arenaGlobals);
 extern void GlobalsPrepareToDestroy(Globals arenaGlobals);
-extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream);
+extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream, Count depth);
 extern Ring GlobalsRememberedSummaryRing(Globals);
 
 #define ArenaGlobals(arena) (&(arena)->globals)
@@ -557,7 +557,7 @@ extern void ControlFinish(Arena arena);
 extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
                         Bool withReservoirPermit);
 extern void ControlFree(Arena arena, void *base, size_t size);
-extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream);
+extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth);
 
 
 /* Peek/Poke
@@ -666,7 +666,7 @@ extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi,
                     Bool withReservoirPermit);
 extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at,
                     Bool withReservoirPermit);
-extern Res SegDescribe(Seg seg, mps_lib_FILE *stream);
+extern Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth);
 extern void SegSetSummary(Seg seg, RefSet summary);
 extern Buffer SegBuffer(Seg seg);
 extern void SegSetBuffer(Seg seg, Buffer buffer);
@@ -725,7 +725,7 @@ extern Res BufferCreate(Buffer *bufferReturn, BufferClass class,
 extern void BufferDestroy(Buffer buffer);
 extern Bool BufferCheck(Buffer buffer);
 extern Bool SegBufCheck(SegBuf segbuf);
-extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream);
+extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth);
 extern Res BufferReserve(Addr *pReturn, Buffer buffer, Size size,
                          Bool withReservoirPermit);
 /* macro equivalent for BufferReserve, keep in sync with <code/buffer.c> */
@@ -824,7 +824,7 @@ extern Bool FormatCheck(Format format);
 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);
+extern Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth);
 
 
 /* Reference Interface -- see <code/ref.c> */
@@ -969,8 +969,8 @@ extern Res RootCreateFun(Root *rootReturn, Arena arena,
 extern void RootDestroy(Root root);
 extern Bool RootModeCheck(RootMode mode);
 extern Bool RootCheck(Root root);
-extern Res RootDescribe(Root root, mps_lib_FILE *stream);
-extern Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream);
+extern Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth);
+extern Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth);
 extern Rank RootRank(Root root);
 extern AccessSet RootPM(Root root);
 extern RefSet RootSummary(Root root);
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index e22e77d8f69..5b871a73c5b 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -125,7 +125,7 @@ typedef void (*ArenaFreeMethod)(Addr base, Size size, Pool pool);
 typedef Res (*ArenaChunkInitMethod)(Chunk chunk, BootBlock boot);
 typedef void (*ArenaChunkFinishMethod)(Chunk chunk);
 typedef void (*ArenaCompactMethod)(Arena arena, Trace trace);
-typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream);
+typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream, Count depth);
 typedef Res (*ArenaPagesMarkAllocatedMethod)(Arena arena, Chunk chunk,
                                              Index baseIndex, Count pages,
                                              Pool pool);
@@ -165,7 +165,7 @@ typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet,
 typedef void (*SegSetSummaryMethod)(Seg seg, RefSet summary);
 typedef Buffer (*SegBufferMethod)(Seg seg);
 typedef void (*SegSetBufferMethod)(Seg seg, Buffer buffer);
-typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream);
+typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream, Count depth);
 typedef Res (*SegMergeMethod)(Seg seg, Seg segHi,
                               Addr base, Addr mid, Addr limit,
                               Bool withReservoirPermit);
@@ -185,7 +185,7 @@ typedef Seg (*BufferSegMethod)(Buffer buffer);
 typedef RankSet (*BufferRankSetMethod)(Buffer buffer);
 typedef void (*BufferSetRankSetMethod)(Buffer buffer, RankSet rankSet);
 typedef void (*BufferReassignSegMethod)(Buffer buffer, Seg seg);
-typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream);
+typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth);
 
 
 /* Pool*Method -- see <design/class-interface/> */
@@ -232,7 +232,7 @@ typedef void (*PoolWalkMethod)(Pool pool, Seg seg,
                                void *v, size_t s);
 typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockStepMethod f, void *p);
 typedef BufferClass (*PoolBufferClassMethod)(void);
-typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream);
+typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream, Count depth);
 typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool);
 
 
diff --git a/mps/code/mv2test.c b/mps/code/mv2test.c
index 40d53d0589f..ce711b013d4 100644
--- a/mps/code/mv2test.c
+++ b/mps/code/mv2test.c
@@ -4,22 +4,19 @@
  * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
  */
 
-#include <stdio.h>
+#include <math.h>
 #include <stdarg.h>
-#include "mpstd.h"
+#include <stdio.h>
 #include <time.h>
 
-#include "mpscmvt.h"
+#include "mpm.h"
 #include "mps.h"
-
-typedef mps_word_t mps_count_t;  /* machine word (target dep.) */
-
-#include "mpslib.h"
 #include "mpsavm.h"
+#include "mpscmvt.h"
+#include "mpslib.h"
+#include "mpstd.h"
 #include "testlib.h"
 
-#include <math.h>
-
 /* expdev() -- exponentially distributed random deviates
  *
  * From <http://cfatab.harvard.edu/nr/bookcpdf/c7-2.pdf>
@@ -116,6 +113,9 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
       printf("%"PRIwWORD PRIXLONGEST" %6"PRIXLONGEST" ",
              (ulongest_t)ps[i], (ulongest_t)ss[i]);
     }
+    if (i == 100) {
+      PoolDescribe(pool, mps_lib_get_stdout(), 0);
+    }
   }
   if (verbose) {
     putchar('\n');
diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index 852c98949e7..1167a838a6c 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -403,7 +403,7 @@ Bool NailboardIsResRange(Nailboard board, Addr base, Addr limit)
 }
 
 
-Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
+Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth)
 {
   Index i, j;
   Res res;
@@ -413,7 +413,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Nailboard $P\n{\n", (WriteFP)board,
                "  base: $P\n", (WriteFP)RangeBase(&board->range),
                "  limit: $P\n", (WriteFP)RangeLimit(&board->range),
@@ -427,21 +427,21 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
   for(i = 0; i < board->levels; ++i) {
     Count levelNails = nailboardLevelBits(nailboardNails(board), i);
     Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
-    res = WriteF(stream, "  Level $U ($U bits, $U set): ",
+    res = WriteF(depth + 2, stream, "Level $U ($U bits, $U set): ",
                  i, levelNails, levelNails - resetNails, NULL);
     if (res != ResOK)
       return res;
     for (j = 0; j < levelNails; ++j) {
       char c = BTGet(board->level[i], j) ? '*' : '.';
-      res = WriteF(stream, "$C", c, NULL);
+      res = WriteF(0, stream, "$C", c, NULL);
       if (res != ResOK)
         return res;
     }
-    res = WriteF(stream, "\n", NULL);
+    res = WriteF(0, stream, "\n", NULL);
     if (res != ResOK)
       return res;
   }
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} Nailboard $P\n", (WriteFP)board, NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/nailboard.h b/mps/code/nailboard.h
index 66141067f5f..538a46e9249 100644
--- a/mps/code/nailboard.h
+++ b/mps/code/nailboard.h
@@ -45,7 +45,7 @@ extern Bool NailboardSet(Nailboard board, Addr addr);
 extern void NailboardSetRange(Nailboard board, Addr base, Addr limit);
 extern Bool NailboardIsSetRange(Nailboard board, Addr base, Addr limit);
 extern Bool NailboardIsResRange(Nailboard board, Addr base, Addr limit);
-extern Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream);
+extern Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth);
 
 #endif /* nailboard.h */
 
diff --git a/mps/code/nailboardtest.c b/mps/code/nailboardtest.c
index 24bf3be36c2..93e9796e2dd 100644
--- a/mps/code/nailboardtest.c
+++ b/mps/code/nailboardtest.c
@@ -49,6 +49,8 @@ static void test(mps_arena_t arena)
            "NailboardIsResRange");
     }
   }
+
+  die(NailboardDescribe(board, mps_lib_get_stdout(), 0), "NailboardDescribe");
 }
 
 int main(int argc, char **argv)
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 5741470457a..ed50c5c0933 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -522,7 +522,7 @@ void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
 
 /* PoolDescribe -- describe a pool */
 
-Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
+Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Ring node, nextNode;
@@ -530,7 +530,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
   if (!TESTT(Pool, pool)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
  
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
                "  class $P (\"$S\")\n",
                (WriteFP)pool->class, pool->class->name,
@@ -540,31 +540,31 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
   if (NULL != pool->format) {
-    res = FormatDescribe(pool->format, stream);
+    res = FormatDescribe(pool->format, stream, depth + 2);
     if (res != ResOK) return res;
   }
-  res = WriteF(stream,
-               "  fillMutatorSize $UKb\n",
-                 (WriteFU)(pool->fillMutatorSize / 1024),
-               "  emptyMutatorSize $UKb\n",
-                 (WriteFU)(pool->emptyMutatorSize / 1024),
-               "  fillInternalSize $UKb\n",
-                 (WriteFU)(pool->fillInternalSize / 1024),
-               "  emptyInternalSize $UKb\n",
-                 (WriteFU)(pool->emptyInternalSize / 1024),
+  res = WriteF(depth + 2, stream,
+               "fillMutatorSize $UKb\n",
+               (WriteFU)(pool->fillMutatorSize / 1024),
+               "emptyMutatorSize $UKb\n",
+               (WriteFU)(pool->emptyMutatorSize / 1024),
+               "fillInternalSize $UKb\n",
+               (WriteFU)(pool->fillInternalSize / 1024),
+               "emptyInternalSize $UKb\n",
+               (WriteFU)(pool->emptyInternalSize / 1024),
                NULL);
   if (res != ResOK) return res;
 
-  res = (*pool->class->describe)(pool, stream);
+  res = (*pool->class->describe)(pool, stream, depth + 2);
   if (res != ResOK) return res;
 
   RING_FOR(node, &pool->bufferRing, nextNode) {
     Buffer buffer = RING_ELT(Buffer, poolRing, node);
-    res = BufferDescribe(buffer, stream);
+    res = BufferDescribe(buffer, stream, depth + 2);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial,
                NULL);
   if (res != ResOK) return res;
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index aa2ee5adcbd..ee20a829f77 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -311,11 +311,13 @@ void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
 }
 
 
-Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream)
+Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   AVERT(Pool, pool);
   AVER(stream != NULL);
-  return WriteF(stream, "  No class-specific description available.\n", NULL);
+  return WriteF(depth, stream,
+                "No class-specific description available.\n",
+                NULL);
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index aeb04454efe..5777b95c72b 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -225,7 +225,7 @@ static void AMCSegSketch(Seg seg, char *pbSketch, size_t cbSketch)
  *
  * See <design/poolamc/#seg-describe>.
  */
-static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
+static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Pool pool;
@@ -246,7 +246,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
 
   /* Describe the superclass fields first via next-method call */
   super = SEG_SUPERCLASS(amcSegClass);
-  res = super->describe(seg, stream);
+  res = super->describe(seg, stream, depth);
   if(res != ResOK)
     return res;
 
@@ -258,7 +258,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
   p = AddrAdd(base, pool->format->headerSize);
   limit = SegLimit(seg);
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "AMC seg $P [$A,$A){\n",
                (WriteFP)seg, (WriteFA)base, (WriteFA)limit,
                NULL);
@@ -266,16 +266,17 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
     return res;
 
   if(amcSegHasNailboard(seg)) {
-    res = WriteF(stream, "  Boarded\n", NULL);
+    res = WriteF(depth + 2, stream, "Boarded\n", NULL);
   } else if(SegNailed(seg) == TraceSetEMPTY) {
-    res = WriteF(stream, "  Mobile\n", NULL);
+    res = WriteF(depth + 2, stream, "Mobile\n", NULL);
   } else {
-    res = WriteF(stream, "  Stuck\n", NULL);
+    res = WriteF(depth + 2, stream, "Stuck\n", NULL);
   }
   if(res != ResOK)
     return res;
 
-  res = WriteF(stream, "  Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
+  res = WriteF(depth + 2, stream,
+               "Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
   if(res != ResOK)
     return res;
 
@@ -288,7 +289,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
     Addr j;
     char c;
 
-    res = WriteF(stream, "    $A  ", i, NULL);
+    res = WriteF(depth + 2, stream, "$A  ", i, NULL);
     if(res != ResOK)
       return res;
 
@@ -308,22 +309,22 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream)
           c = (nailed ? '+' : '=');
         }
       }
-      res = WriteF(stream, "$C", c, NULL);
+      res = WriteF(0, stream, "$C", c, NULL);
       if(res != ResOK)
         return res;
     }
 
-    res = WriteF(stream, "\n", NULL);
+    res = WriteF(0, stream, "\n", NULL);
     if(res != ResOK)
       return res;
   }
 
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
-  res = WriteF(stream, "  Sketch: $S\n", (WriteFS)abzSketch, NULL);
+  res = WriteF(depth + 2, stream, "Sketch: $S\n", (WriteFS)abzSketch, NULL);
   if(res != ResOK)
     return res;
 
-  res = WriteF(stream, "} AMC Seg $P\n", (WriteFP)seg, NULL);
+  res = WriteF(depth, stream, "} AMC Seg $P\n", (WriteFP)seg, NULL);
   if(res != ResOK)
     return res;
 
@@ -707,22 +708,22 @@ static void amcGenDestroy(amcGen gen)
 
 /* amcGenDescribe -- describe an AMC generation */
 
-static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream)
+static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if(!TESTT(amcGen, gen))
     return ResFAIL;
 
-  res = WriteF(stream,
-               "  amcGen $P ($U) {\n",
+  res = WriteF(depth, stream,
+               "amcGen $P ($U) {\n",
                (WriteFP)gen, (WriteFU)amcGenNr(gen),
-               "   buffer $P\n", gen->forward,
-               "   segs $U, totalSize $U, newSize $U\n",
+               "  buffer $P\n", gen->forward,
+               "  segs $U, totalSize $U, newSize $U\n",
                (WriteFU)gen->segs,
                (WriteFU)gen->pgen.totalSize,
                (WriteFU)gen->pgen.newSize,
-               "  } amcGen\n", NULL);
+               "} amcGen $P\n", (WriteFP)gen, NULL);
   return res;
 }
 
@@ -2262,7 +2263,7 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr)
  *
  * See <design/poolamc/#describe>.
  */
-static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
+static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   AMC amc;
@@ -2277,7 +2278,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
   if(stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
                " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
                (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial,
@@ -2286,29 +2287,25 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
     return res;
 
   switch(amc->rampMode) {
-
 #define RAMP_DESCRIBE(e, s)     \
     case e:                     \
       rampmode = s;             \
       break;
-
     RAMP_RELATION(RAMP_DESCRIBE)
 #undef RAMP_DESCRIBE
-
     default:
       rampmode = "unknown ramp mode";
       break;
-
   }
-  res = WriteF(stream,
-               "  ", rampmode, " ($U)\n", (WriteFU)amc->rampCount,
+  res = WriteF(depth + 2, stream,
+               rampmode, " ($U)\n", (WriteFU)amc->rampCount,
                NULL);
   if(res != ResOK)
     return res;
 
   RING_FOR(node, &amc->genRing, nextNode) {
     amcGen gen = RING_ELT(amcGen, amcRing, node);
-    res = amcGenDescribe(gen, stream);
+    res = amcGenDescribe(gen, stream, depth + 2);
     if(res != ResOK)
       return res;
   }
@@ -2317,13 +2314,13 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
     /* SegDescribes */
     RING_FOR(node, &AMC2Pool(amc)->segRing, nextNode) {
       Seg seg = RING_ELT(Seg, poolRing, node);
-      res = AMCSegDescribe(seg, stream);
+      res = AMCSegDescribe(seg, stream, depth + 2);
       if(res != ResOK)
         return res;
     }
   }
 
-  res = WriteF(stream, "} AMC $P\n", (WriteFP)amc, NULL);
+  res = WriteF(depth, stream, "} AMC $P\n", (WriteFP)amc, NULL);
   if(res != ResOK)
     return res;
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 65b2dcf754f..fe3d8d36db3 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -525,12 +525,12 @@ failCreateTablesLo:
   BEGIN \
     if ((buffer) != NULL \
        && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \
-      Res _res = WriteF(stream, char, NULL); \
+      Res _res = WriteF(0, stream, char, NULL); \
       if (_res != ResOK) return _res; \
     } \
   END
 
-static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
+static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   AMSSeg amsseg;
@@ -545,30 +545,30 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
 
   /* Describe the superclass fields first via next-method call */
   super = SEG_SUPERCLASS(AMSSegClass);
-  res = super->describe(seg, stream);
+  res = super->describe(seg, stream, depth);
   if (res != ResOK) return res;
 
   buffer = SegBuffer(seg);
 
-  res = WriteF(stream,
-               "  AMS $P\n", (WriteFP)amsseg->ams,
-               "  grains $W\n", (WriteFW)amsseg->grains,
+  res = WriteF(depth, stream,
+               "AMS $P\n", (WriteFP)amsseg->ams,
+               "grains $W\n", (WriteFW)amsseg->grains,
                NULL);
   if (res != ResOK) return res;
   if (amsseg->allocTableInUse)
-    res = WriteF(stream,
-                 "  alloctable $P\n", (WriteFP)amsseg->allocTable,
+    res = WriteF(depth, stream,
+                 "alloctable $P\n", (WriteFP)amsseg->allocTable,
                  NULL);
   else
-    res = WriteF(stream,
-                 "  firstFree $W\n", (WriteFW)amsseg->firstFree,
+    res = WriteF(depth, stream,
+                 "firstFree $W\n", (WriteFW)amsseg->firstFree,
                  NULL);
   if (res != ResOK) return res;
-  res = WriteF(stream,
-               "  tables: nongrey $P, nonwhite $P\n",
+  res = WriteF(depth, stream,
+               "tables: nongrey $P, nonwhite $P\n",
                (WriteFP)amsseg->nongreyTable,
                (WriteFP)amsseg->nonwhiteTable,
-               "  map: \n",
+               "map:",
                NULL);
   if (res != ResOK) return res;
 
@@ -576,7 +576,9 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     char c = 0;
 
     if (i % 64 == 0) {
-      res = WriteF(stream, "\n  ", NULL);
+      res = WriteF(0, stream, "\n", NULL);
+      if (res != ResOK) return res;
+      res = WriteF(depth, stream, "  ", NULL);
       if (res != ResOK) return res;
     }
 
@@ -598,7 +600,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
         c = '.';
     } else
       c = ' ';
-    res = WriteF(stream, "$C", c, NULL);
+    res = WriteF(0, stream, "$C", c, NULL);
     if (res != ResOK)
       return res;
 
@@ -606,8 +608,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
     WRITE_BUFFER_LIMIT(stream, seg, i+1, buffer, BufferLimit, "]");
   }
 
-  res = WriteF(stream, "\n", NULL);
-  return res;
+  return ResOK;
 }
 
 
@@ -627,8 +628,6 @@ DEFINE_CLASS(AMSSegClass, class)
 }
 
 
-
-
 /* AMSPoolRing -- the ring of segments in the pool */
 
 static Ring AMSPoolRing(AMS ams, RankSet rankSet, Size size)
@@ -1648,7 +1647,7 @@ static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
  *
  * Iterates over the segments, describing all of them.
  */
-static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
+static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   AMS ams;
   Ring node, nextNode;
@@ -1659,7 +1658,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
   if (!TESTT(AMS, ams)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "AMS $P {\n", (WriteFP)ams,
                "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
@@ -1671,21 +1670,19 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  segments\n"
-               "    * = black, + = grey, - = white, . = alloc, ! = bad\n"
-               "    buffers: [ = base, < = scan limit, | = init,\n"
-               "             > = alloc, ] = limit\n",
+  res = WriteF(depth + 2, stream,
+               "segments: * black  + grey  - white  . alloc  ! bad\n"
+               "buffers: [ base  < scan limit  | init  > alloc  ] limit\n",
                NULL);
   if (res != ResOK) return res;
 
   RING_FOR(node, &ams->segRing, nextNode) {
     AMSSeg amsseg = RING_ELT(AMSSeg, segRing, node);
-    res = SegDescribe(AMSSeg2Seg(amsseg), stream);
+    res = SegDescribe(AMSSeg2Seg(amsseg), stream, depth + 2);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, "} AMS $P\n",(WriteFP)ams, NULL);
+  res = WriteF(depth, stream, "} AMS $P\n",(WriteFP)ams, NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 214b2b232d3..9b3e469e28a 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -311,7 +311,7 @@ static void MFSFree(Pool pool, Addr old, Size size)
 }
 
 
-static Res MFSDescribe(Pool pool, mps_lib_FILE *stream)
+static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   MFS mfs;
   Res res;
@@ -322,12 +322,12 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream)
 
   AVER(stream != NULL);
 
-  res = WriteF(stream,
-               "  unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
-               "  unit size $W\n",           (WriteFW)mfs->unitSize,
-               "  extent size $W\n",         (WriteFW)mfs->extendBy,
-               "  free list begins at $P\n", (WriteFP)mfs->freeList,
-               "  tract list begin at $P\n", (WriteFP)mfs->tractList,
+  res = WriteF(depth, stream,
+               "unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
+               "unit size $W\n",           (WriteFW)mfs->unitSize,
+               "extent size $W\n",         (WriteFW)mfs->extendBy,
+               "free list begins at $P\n", (WriteFP)mfs->freeList,
+               "tract list begin at $P\n", (WriteFP)mfs->tractList,
                NULL);
   if(res != ResOK) return res;
 
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 93d9f8bd25e..add1d013db8 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -792,7 +792,7 @@ Res MRGDeregister(Pool pool, Ref obj)
  * This could be improved by implementing MRGSegDescribe
  * and having MRGDescribe iterate over all the pool's segments.
  */
-static Res MRGDescribe(Pool pool, mps_lib_FILE *stream)
+static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   MRG mrg;
   Arena arena;
@@ -806,13 +806,13 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream)
   if (stream == NULL) return ResFAIL;
 
   arena = PoolArena(pool);
-  res = WriteF(stream, "  extendBy $W\n", mrg->extendBy, NULL);
+  res = WriteF(depth, stream, "  extendBy $W\n", mrg->extendBy, NULL);
   if (res != ResOK) return res;
-  res = WriteF(stream, "  Entry queue:\n", NULL);
+  res = WriteF(depth, stream, "  Entry queue:\n", NULL);
   if (res != ResOK) return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
-    res = WriteF(stream, "    at $A Ref $A\n",
+    res = WriteF(depth, stream, "    at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
     if (res != ResOK) return res;
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index d345141ecf0..7f181a405b0 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -672,7 +672,7 @@ static PoolDebugMixin MVDebugMixin(Pool pool)
 }
 
 
-static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
+static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   MV mv;
@@ -687,15 +687,15 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
   if(!TESTT(MV, mv)) return ResFAIL;
   if(stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
-               "  blockPool $P ($U)\n",
+  res = WriteF(depth, stream,
+               "blockPool $P ($U)\n",
                (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
-               "  spanPool  $P ($U)\n",
+               "spanPool  $P ($U)\n",
                (WriteFP)mvSpanPool(mv), (WriteFU)mvSpanPool(mv)->serial,
-               "  extendBy  $W\n",  (WriteFW)mv->extendBy,
-               "  avgSize   $W\n",  (WriteFW)mv->avgSize,
-               "  maxSize   $W\n",  (WriteFW)mv->maxSize,
-               "  space     $P\n",  (WriteFP)mv->space,
+               "extendBy  $W\n",  (WriteFW)mv->extendBy,
+               "avgSize   $W\n",  (WriteFW)mv->avgSize,
+               "maxSize   $W\n",  (WriteFW)mv->maxSize,
+               "space     $P\n",  (WriteFP)mv->space,
                NULL);
   if(res != ResOK) return res;              
 
@@ -707,29 +707,28 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     Addr i, j;
     MVBlock block;
     span = RING_ELT(MVSpan, spans, node);
-    res = WriteF(stream, "MVSpan $P {\n", (WriteFP)span, NULL);
+    res = WriteF(depth, stream, "MVSpan $P {\n", (WriteFP)span, NULL);
     if(res != ResOK) return res;
 
-    res = WriteF(stream,
-                 "  span    $P\n", (WriteFP)span,
-                 "  tract   $P\n", (WriteFP)span->tract,
-                 "  space   $W\n", (WriteFW)span->space,
-                 "  blocks  $U\n", (WriteFU)span->blockCount,
-                 "  largest ",
+    res = WriteF(depth + 2, stream,
+                 "span    $P\n", (WriteFP)span,
+                 "tract   $P\n", (WriteFP)span->tract,
+                 "space   $W\n", (WriteFW)span->space,
+                 "blocks  $U\n", (WriteFU)span->blockCount,
+                 "largest ",
                  NULL);
     if(res != ResOK) return res;
 
     if (span->largestKnown) /* .design.largest */
-      res = WriteF(stream, "$W\n", (WriteFW)span->largest, NULL);
+      res = WriteF(0, stream, "$W\n", (WriteFW)span->largest, NULL);
     else
-      res = WriteF(stream, "unknown\n", NULL);
-   
+      res = WriteF(0, stream, "unknown\n", NULL);
     if(res != ResOK) return res;
 
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
-      res = WriteF(stream, "    $A ", i, NULL);
+      res = WriteF(depth + 2, stream, "$A ", i, NULL);
       if(res != ResOK) return res;
 
       for(j = i;
@@ -752,12 +751,14 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
           c = ']';
         else /* j > block->base && j < block->limit */
           c = '=';
-        res = WriteF(stream, "$C", c, NULL);
+        res = WriteF(0, stream, "$C", c, NULL);
         if(res != ResOK) return res;
       }
-      res = WriteF(stream, "\n", NULL);
+      res = WriteF(0, stream, "\n", NULL);
       if(res != ResOK) return res;
     }
+    res = WriteF(depth, stream, "} MVSpan $P\n", (WriteFP)span, NULL);
+    if(res != ResOK) return res;
   }
 
   return ResOK;
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index f6d85b1b134..5a457b0612d 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -38,7 +38,7 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn,
                          Bool withReservoirPermit);
 static void MVTBufferEmpty(Pool pool, Buffer buffer, Addr base, Addr limit);
 static void MVTFree(Pool pool, Addr base, Size size);
-static Res MVTDescribe(Pool pool, mps_lib_FILE *stream);
+static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
 static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size,
                        Bool withReservoirPermit);
 
@@ -1003,7 +1003,7 @@ static void MVTFree(Pool pool, Addr base, Size size)
 
 /* MVTDescribe -- describe an MVT pool */
 
-static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
+static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   MVT mvt;
@@ -1013,68 +1013,69 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
   if (!TESTT(MVT, mvt)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
-               "MVT $P\n{\n", (WriteFP)mvt,
-               "  minSize: $U \n", (WriteFU)mvt->minSize,
-               "  meanSize: $U \n", (WriteFU)mvt->meanSize,
-               "  maxSize: $U \n", (WriteFU)mvt->maxSize,
-               "  fragLimit: $U \n", (WriteFU)mvt->fragLimit,
-               "  reuseSize: $U \n", (WriteFU)mvt->reuseSize,
-               "  fillSize: $U \n", (WriteFU)mvt->fillSize,
-               "  availLimit: $U \n", (WriteFU)mvt->availLimit,
-               "  abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
-               "  splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
-               "  splinterBase: $A \n", (WriteFA)mvt->splinterBase,
-               "  splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
-               "  size: $U \n", (WriteFU)mvt->size,
-               "  allocated: $U \n", (WriteFU)mvt->allocated,
-               "  available: $U \n", (WriteFU)mvt->available,
-               "  unavailable: $U \n", (WriteFU)mvt->unavailable,
+  res = WriteF(depth, stream,
+               "MVT $P {\n", (WriteFP)mvt,
+               "  minSize: $U\n", (WriteFU)mvt->minSize,
+               "  meanSize: $U\n", (WriteFU)mvt->meanSize,
+               "  maxSize: $U\n", (WriteFU)mvt->maxSize,
+               "  fragLimit: $U\n", (WriteFU)mvt->fragLimit,
+               "  reuseSize: $U\n", (WriteFU)mvt->reuseSize,
+               "  fillSize: $U\n", (WriteFU)mvt->fillSize,
+               "  availLimit: $U\n", (WriteFU)mvt->availLimit,
+               "  abqOverflow: $S\n", mvt->abqOverflow?"TRUE":"FALSE",
+               "  splinter: $S\n", mvt->splinter?"TRUE":"FALSE",
+               "  splinterBase: $A\n", (WriteFA)mvt->splinterBase,
+               "  splinterLimit: $A\n", (WriteFU)mvt->splinterLimit,
+               "  size: $U\n", (WriteFU)mvt->size,
+               "  allocated: $U\n", (WriteFU)mvt->allocated,
+               "  available: $U\n", (WriteFU)mvt->available,
+               "  unavailable: $U\n", (WriteFU)mvt->unavailable,
                NULL);
   if(res != ResOK) return res;
 
-  res = CBSDescribe(MVTCBS(mvt), stream);
+  res = CBSDescribe(MVTCBS(mvt), stream, depth + 2);
   if(res != ResOK) return res;
 
-  res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream);
+  res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream,
+                    depth + 2);
   if(res != ResOK) return res;
 
-  res = FreelistDescribe(MVTFreelist(mvt), stream);
+  res = FreelistDescribe(MVTFreelist(mvt), stream, depth + 2);
   if(res != ResOK) return res;
 
-  METER_WRITE(mvt->segAllocs, stream);
-  METER_WRITE(mvt->segFrees, stream);
-  METER_WRITE(mvt->bufferFills, stream);
-  METER_WRITE(mvt->bufferEmpties, stream);
-  METER_WRITE(mvt->poolFrees, stream);
-  METER_WRITE(mvt->poolSize, stream);
-  METER_WRITE(mvt->poolAllocated, stream);
-  METER_WRITE(mvt->poolAvailable, stream);
-  METER_WRITE(mvt->poolUnavailable, stream);
-  METER_WRITE(mvt->poolUtilization, stream);
-  METER_WRITE(mvt->finds, stream);
-  METER_WRITE(mvt->overflows, stream);
-  METER_WRITE(mvt->underflows, stream);
-  METER_WRITE(mvt->refills, stream);
-  METER_WRITE(mvt->refillPushes, stream);
-  METER_WRITE(mvt->returns, stream);
-  METER_WRITE(mvt->perfectFits, stream);
-  METER_WRITE(mvt->firstFits, stream);
-  METER_WRITE(mvt->secondFits, stream);
-  METER_WRITE(mvt->failures, stream);
-  METER_WRITE(mvt->emergencyContingencies, stream);
-  METER_WRITE(mvt->fragLimitContingencies, stream);
-  METER_WRITE(mvt->contingencySearches, stream);
-  METER_WRITE(mvt->contingencyHardSearches, stream);
-  METER_WRITE(mvt->splinters, stream);
-  METER_WRITE(mvt->splintersUsed, stream);
-  METER_WRITE(mvt->splintersDropped, stream);
-  METER_WRITE(mvt->sawdust, stream);
-  METER_WRITE(mvt->exceptions, stream);
-  METER_WRITE(mvt->exceptionSplinters, stream);
-  METER_WRITE(mvt->exceptionReturns, stream);
+  METER_WRITE(mvt->segAllocs, stream, depth + 2);
+  METER_WRITE(mvt->segFrees, stream, depth + 2);
+  METER_WRITE(mvt->bufferFills, stream, depth + 2);
+  METER_WRITE(mvt->bufferEmpties, stream, depth + 2);
+  METER_WRITE(mvt->poolFrees, stream, depth + 2);
+  METER_WRITE(mvt->poolSize, stream, depth + 2);
+  METER_WRITE(mvt->poolAllocated, stream, depth + 2);
+  METER_WRITE(mvt->poolAvailable, stream, depth + 2);
+  METER_WRITE(mvt->poolUnavailable, stream, depth + 2);
+  METER_WRITE(mvt->poolUtilization, stream, depth + 2);
+  METER_WRITE(mvt->finds, stream, depth + 2);
+  METER_WRITE(mvt->overflows, stream, depth + 2);
+  METER_WRITE(mvt->underflows, stream, depth + 2);
+  METER_WRITE(mvt->refills, stream, depth + 2);
+  METER_WRITE(mvt->refillPushes, stream, depth + 2);
+  METER_WRITE(mvt->returns, stream, depth + 2);
+  METER_WRITE(mvt->perfectFits, stream, depth + 2);
+  METER_WRITE(mvt->firstFits, stream, depth + 2);
+  METER_WRITE(mvt->secondFits, stream, depth + 2);
+  METER_WRITE(mvt->failures, stream, depth + 2);
+  METER_WRITE(mvt->emergencyContingencies, stream, depth + 2);
+  METER_WRITE(mvt->fragLimitContingencies, stream, depth + 2);
+  METER_WRITE(mvt->contingencySearches, stream, depth + 2);
+  METER_WRITE(mvt->contingencyHardSearches, stream, depth + 2);
+  METER_WRITE(mvt->splinters, stream, depth + 2);
+  METER_WRITE(mvt->splintersUsed, stream, depth + 2);
+  METER_WRITE(mvt->splintersDropped, stream, depth + 2);
+  METER_WRITE(mvt->sawdust, stream, depth + 2);
+  METER_WRITE(mvt->exceptions, stream, depth + 2);
+  METER_WRITE(mvt->exceptionSplinters, stream, depth + 2);
+  METER_WRITE(mvt->exceptionReturns, stream, depth + 2);
  
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} MVT $P\n", (WriteFP)mvt, NULL);
   return res;
 }
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index fc4307d50a2..ec5ecb86e54 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -669,7 +669,7 @@ static PoolDebugMixin MVFFDebugMixin(Pool pool)
 
 /* MVFFDescribe -- describe an MVFF pool */
 
-static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
+static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   MVFF mvff;
@@ -679,7 +679,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   if (!TESTT(MVFF, mvff)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "MVFF $P {\n", (WriteFP)mvff,
                "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
@@ -691,15 +691,15 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   if (res != ResOK)
     return res;
 
-  res = CBSDescribe(CBSOfMVFF(mvff), stream);
+  res = CBSDescribe(CBSOfMVFF(mvff), stream, depth + 2);
   if (res != ResOK)
     return res;
 
-  res = FreelistDescribe(FreelistOfMVFF(mvff), stream);
+  res = FreelistDescribe(FreelistOfMVFF(mvff), stream, depth + 2);
   if (res != ResOK)
     return res;
 
-  res = WriteF(stream, "}\n", NULL);
+  res = WriteF(depth, stream, "} MVFF $P\n", (WriteFP)mvff, NULL);
 
   return res;
 }
diff --git a/mps/code/pooln.c b/mps/code/pooln.c
index 3a7e26df34c..226d1bfae28 100644
--- a/mps/code/pooln.c
+++ b/mps/code/pooln.c
@@ -133,7 +133,7 @@ static void NBufferEmpty(Pool pool, Buffer buffer,
 
 /* NDescribe -- describe method for class N */
 
-static Res NDescribe(Pool pool, mps_lib_FILE *stream)
+static Res NDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   PoolN poolN;
 
@@ -142,6 +142,7 @@ static Res NDescribe(Pool pool, mps_lib_FILE *stream)
   AVERT(PoolN, poolN);
 
   UNUSED(stream); /* TODO: should output something here */
+  UNUSED(depth);
 
   return ResOK;
 }
diff --git a/mps/code/poolncv.c b/mps/code/poolncv.c
index 8b8dab2a8a1..a3f85342cb8 100644
--- a/mps/code/poolncv.c
+++ b/mps/code/poolncv.c
@@ -5,10 +5,10 @@
  */
 
 #include "mpm.h"
-#include "pooln.h"
 #include "mpsavm.h"
-#include "testlib.h"
 #include "mpslib.h"
+#include "pooln.h"
+#include "testlib.h"
 
 #include <stdio.h> /* printf */
 
@@ -28,6 +28,7 @@ static void testit(ArenaClass class, ArgList args)
     error("Error: Unexpectedly succeeded in"
           "allocating block from PoolN\n");
   }
+  PoolDescribe(pool, mps_lib_get_stdout(), 0);
   PoolDestroy(pool);
   ArenaDestroy(arena);
 }
diff --git a/mps/code/range.c b/mps/code/range.c
index b54a001db2f..41ba26216b6 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -39,19 +39,19 @@ void RangeFinish(Range range)
   range->sig = SigInvalid;
 }
 
-Res RangeDescribe(Range range, mps_lib_FILE *stream)
+Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   AVERT(Range, range);
   AVER(stream != NULL);
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Range $P\n{\n", (WriteFP)range,
                "  base: $P\n", (WriteFP)RangeBase(range),
                "  limit: $P\n", (WriteFP)RangeLimit(range),
                "  size: $U\n", (WriteFU)RangeSize(range),
-               "}\n", NULL);
+               "} Range $P\n", (WriteFP)range, NULL);
   if (res != ResOK) {
     return res;
   }
diff --git a/mps/code/range.h b/mps/code/range.h
index 0ff105f7f20..541fa5ff574 100644
--- a/mps/code/range.h
+++ b/mps/code/range.h
@@ -31,7 +31,7 @@ typedef struct RangeStruct *Range;
 
 extern void RangeInit(Range range, Addr base, Addr limit);
 extern void RangeFinish(Range range);
-extern Res RangeDescribe(Range range, mps_lib_FILE *stream);
+extern Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth);
 extern Bool RangeCheck(Range range);
 extern Bool RangeIsAligned(Range range, Align align);
 extern Bool RangesOverlap(Range range1, Range range2);
diff --git a/mps/code/root.c b/mps/code/root.c
index 4277550a7fb..a3ed0c80b7e 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -580,14 +580,14 @@ Res RootsIterate(Globals arena, RootIterateFn f, void *p)
 
 /* RootDescribe -- describe a root */
 
-Res RootDescribe(Root root, mps_lib_FILE *stream)
+Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(Root, root)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial,
                "  arena $P ($U)\n", (WriteFP)root->arena,
                (WriteFU)root->arena->serial,
@@ -599,15 +599,16 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
   switch(root->var) {
     case RootTABLE:
-    res = WriteF(stream,
-                 "  table base $A limit $A\n",
+    res = WriteF(depth + 2, stream,
+                 "table base $A limit $A\n",
                  root->the.table.base, root->the.table.limit,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootTABLE_MASKED:
-    res = WriteF(stream, "  table base $A limit $A mask $B\n",
+    res = WriteF(depth + 2, stream,
+                 "table base $A limit $A mask $B\n",
                  root->the.tableMasked.base, root->the.tableMasked.limit,
                  root->the.tableMasked.mask,
                  NULL);
@@ -615,26 +616,26 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
     break;
 
     case RootFUN:
-    res = WriteF(stream,
-                 "  scan function $F\n", (WriteFF)root->the.fun.scan,
-                 "  environment p $P s $W\n",
+    res = WriteF(depth + 2, stream,
+                 "scan function $F\n", (WriteFF)root->the.fun.scan,
+                 "environment p $P s $W\n",
                  root->the.fun.p, (WriteFW)root->the.fun.s,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootREG:
-    res = WriteF(stream,
-                 "  thread $P\n", (WriteFP)root->the.reg.thread,
-                 "  environment p $P", root->the.reg.p,
+    res = WriteF(depth + 2, stream,
+                 "thread $P\n", (WriteFP)root->the.reg.thread,
+                 "environment p $P", root->the.reg.p,
                  NULL);
     if (res != ResOK) return res;
     break;
 
     case RootFMT:
-    res = WriteF(stream,
-                 "  scan function $F\n", (WriteFF)root->the.fmt.scan,
-                 "  format base $A limit $A\n",
+    res = WriteF(depth + 2, stream,
+                 "scan function $F\n", (WriteFF)root->the.fmt.scan,
+                 "format base $A limit $A\n",
                  root->the.fmt.base, root->the.fmt.limit,
                  NULL);
     if (res != ResOK) return res;
@@ -644,7 +645,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
     NOTREACHED;
   }
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "} Root $P ($U)\n", (WriteFP)root, (WriteFU)root->serial,
                NULL);
   if (res != ResOK) return res;
@@ -655,14 +656,14 @@ Res RootDescribe(Root root, mps_lib_FILE *stream)
 
 /* RootsDescribe -- describe all roots */
 
-Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
+Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
 {
   Res res = ResOK;
   Ring node, next;
 
   RING_FOR(node, &arenaGlobals->rootRing, next) {
     Root root = RING_ELT(Root, arenaRing, node);
-    res = RootDescribe(root, stream); /* this outputs too much */
+    res = RootDescribe(root, stream, depth);
     if (res != ResOK) return res;
   }
   return res;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 31dd0759ff9..7e022362b30 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -355,7 +355,7 @@ void SegSetBuffer(Seg seg, Buffer buffer)
 
 /* SegDescribe -- describe a segment */
 
-Res SegDescribe(Seg seg, mps_lib_FILE *stream)
+Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Pool pool;
@@ -365,7 +365,7 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
 
   pool = SegPool(seg);
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Segment $P [$A,$A) {\n", (WriteFP)seg,
                (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
                "  class $P (\"$S\")\n",
@@ -375,11 +375,13 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
 
-  res = seg->class->describe(seg, stream);
+  res = seg->class->describe(seg, stream, depth + 2);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "\n",
-               "} Segment $P\n", (WriteFP)seg, NULL);
+  res = WriteF(0, stream, "\n", NULL);
+  if (res != ResOK) return res;
+
+  res = WriteF(depth, stream, "} Segment $P\n", (WriteFP)seg, NULL);
   return res;
 }
 
@@ -1023,59 +1025,30 @@ static Res segTrivSplit(Seg seg, Seg segHi,
 
 /* segTrivDescribe -- Basic Seg description method */
 
-static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream)
+static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
   if (!TESTT(Seg, seg)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(stream,
-               "  shield depth $U\n", (WriteFU)seg->depth,
-               "  protection mode:",
-               NULL);
-  if (res != ResOK) return res;
-  if (SegPM(seg) & AccessREAD) {
-     res = WriteF(stream, " read", NULL);
-     if (res != ResOK) return res;
-  }
-  if (SegPM(seg) & AccessWRITE) {
-     res = WriteF(stream, " write", NULL);
-     if (res != ResOK) return res;
-  }
-  res = WriteF(stream, "\n  shield mode:", NULL);
-  if (res != ResOK) return res;
-  if (SegSM(seg) & AccessREAD) {
-     res = WriteF(stream, " read", NULL);
-     if (res != ResOK) return res;
-  }
-  if (SegSM(seg) & AccessWRITE) {
-     res = WriteF(stream, " write", NULL);
-     if (res != ResOK) return res;
-  }
-  res = WriteF(stream, "\n  ranks:", NULL);
-  if (res != ResOK) return res;
-  /* This bit ought to be in a RankSetDescribe in ref.c. */
-  if (RankSetIsMember(seg->rankSet, RankAMBIG)) {
-     res = WriteF(stream, " ambiguous", NULL);
-     if (res != ResOK) return res;
-  }
-  if (RankSetIsMember(seg->rankSet, RankEXACT)) {
-     res = WriteF(stream, " exact", NULL);
-     if (res != ResOK) return res;
-  }
-  if (RankSetIsMember(seg->rankSet, RankFINAL)) {
-     res = WriteF(stream, " final", NULL);
-     if (res != ResOK) return res;
-  }
-  if (RankSetIsMember(seg->rankSet, RankWEAK)) {
-     res = WriteF(stream, " weak", NULL);
-     if (res != ResOK) return res;
-  }
-  res = WriteF(stream, "\n",
-               "  white  $B\n", (WriteFB)seg->white,
-               "  grey   $B\n", (WriteFB)seg->grey,
-               "  nailed $B\n", (WriteFB)seg->nailed,
+  res = WriteF(depth, stream,
+               "shield depth $U\n", (WriteFU)seg->depth,
+               "protection mode: ",
+               (SegPM(seg) & AccessREAD) ? "" : "!", "READ", " ",
+               (SegPM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n",
+               "shield mode: ",
+               (SegSM(seg) & AccessREAD) ? "" : "!", "READ", " ",
+               (SegSM(seg) & AccessWRITE) ? "" : "!", "WRITE", "\n",
+               "ranks:",
+               RankSetIsMember(seg->rankSet, RankAMBIG) ? " ambiguous" : "",
+               RankSetIsMember(seg->rankSet, RankEXACT) ? " exact" : "",
+               RankSetIsMember(seg->rankSet, RankFINAL) ? " final" : "",
+               RankSetIsMember(seg->rankSet, RankWEAK) ? " weak" : "",
+               "\n",
+               "white  $B\n", (WriteFB)seg->white,
+               "grey   $B\n", (WriteFB)seg->grey,
+               "nailed $B\n", (WriteFB)seg->nailed,
                NULL);
   return res;
 }
@@ -1611,7 +1584,7 @@ failSuper:
 
 /* gcSegDescribe -- GCSeg  description method */
 
-static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream)
+static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   SegClass super;
@@ -1624,19 +1597,18 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream)
 
   /* Describe the superclass fields first via next-method call */
   super = SEG_SUPERCLASS(GCSegClass);
-  res = super->describe(seg, stream);
+  res = super->describe(seg, stream, depth);
   if (res != ResOK) return res;
 
-  res = WriteF(stream,
-               "  summary $W\n", (WriteFW)gcseg->summary,
+  res = WriteF(depth, stream,
+               "summary $W\n", (WriteFW)gcseg->summary,
                NULL);
   if (res != ResOK) return res;
 
   if (gcseg->buffer == NULL) {
-    res = WriteF(stream, "  buffer: NULL\n", NULL);
-  }
-  else {
-    res = BufferDescribe(gcseg->buffer, stream);
+    res = WriteF(depth, stream, "buffer: NULL\n", NULL);
+  } else {
+    res = BufferDescribe(gcseg->buffer, stream, depth);
   }
   if (res != ResOK) return res;
 
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 7e061cd14f4..4325d8b2c56 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -1006,7 +1006,8 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
  */
 
 static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
-                             SplayNodeDescribeMethod nodeDescribe) {
+                             SplayNodeDescribeMethod nodeDescribe)
+{
   Res res;
 
 #if defined(AVER_AND_CHECK)
@@ -1014,14 +1015,14 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
   /* stream and nodeDescribe checked by SplayTreeDescribe */
 #endif
 
-  res = WriteF(stream, "( ", NULL);
+  res = WriteF(0, stream, "( ", NULL);
   if (res != ResOK) return res;
 
   if (TreeHasLeft(node)) {
     res = SplayNodeDescribe(TreeLeft(node), stream, nodeDescribe);
     if (res != ResOK) return res;
 
-    res = WriteF(stream, " / ", NULL);
+    res = WriteF(0, stream, " / ", NULL);
     if (res != ResOK) return res;
   }
 
@@ -1029,14 +1030,14 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
   if (res != ResOK) return res;
 
   if (TreeHasRight(node)) {
-    res = WriteF(stream, " \\ ", NULL);
+    res = WriteF(0, stream, " \\ ", NULL);
     if (res != ResOK) return res;
 
     res = SplayNodeDescribe(TreeRight(node), stream, nodeDescribe);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, " )", NULL);
+  res = WriteF(0, stream, " )", NULL);
   if (res != ResOK) return res;
 
   return ResOK;
@@ -1323,8 +1324,9 @@ void SplayNodeRefresh(SplayTree splay, Tree node)
  * See <design/splay/#function.splay.tree.describe>.
  */
 
-Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
-                      SplayNodeDescribeMethod nodeDescribe) {
+Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth,
+                      SplayNodeDescribeMethod nodeDescribe)
+{
   Res res;
 
 #if defined(AVER_AND_CHECK)
@@ -1333,18 +1335,20 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
   if (!FUNCHECK(nodeDescribe)) return ResFAIL;
 #endif
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Splay $P {\n", (WriteFP)splay,
                "  compare $F\n", (WriteFF)splay->compare,
                NULL);
   if (res != ResOK) return res;
 
   if (SplayTreeRoot(splay) != TreeEMPTY) {
+    res = WriteF(depth, stream, "  tree ", NULL);
+    if (res != ResOK) return res;
     res = SplayNodeDescribe(SplayTreeRoot(splay), stream, nodeDescribe);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(stream, "\n}\n", NULL);
+  res = WriteF(depth, stream, "\n} Splay $P\n", (WriteFP)splay, NULL);
   return res;
 }
 
diff --git a/mps/code/splay.h b/mps/code/splay.h
index 86f7f470482..96e9e15b04e 100644
--- a/mps/code/splay.h
+++ b/mps/code/splay.h
@@ -72,6 +72,7 @@ extern Bool SplayFindLast(Tree *nodeReturn, SplayTree splay,
 extern void SplayNodeRefresh(SplayTree splay, Tree node);
 
 extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
+                             Count depth,
                              SplayNodeDescribeMethod nodeDescribe);
 
 extern void SplayDebugUpdate(SplayTree splay, Tree tree);
diff --git a/mps/code/th.h b/mps/code/th.h
index 30a2205a356..8c7da150fd0 100644
--- a/mps/code/th.h
+++ b/mps/code/th.h
@@ -28,7 +28,7 @@ extern Bool ThreadCheck(Thread thread);
 extern Bool ThreadCheckSimple(Thread thread);
 
 
-extern Res ThreadDescribe(Thread thread, mps_lib_FILE *stream);
+extern Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth);
 
 
 /*  Register/Deregister
diff --git a/mps/code/than.c b/mps/code/than.c
index a1dab12adc8..5ce14031bd9 100644
--- a/mps/code/than.c
+++ b/mps/code/than.c
@@ -128,11 +128,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot)
 }
 
 
-Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
+Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thix.c b/mps/code/thix.c
index cc380dd040f..c4a7f9ad71c 100644
--- a/mps/code/thix.c
+++ b/mps/code/thix.c
@@ -272,11 +272,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot)
 
 /* ThreadDescribe -- describe a thread */
 
-Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
+Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thw3.c b/mps/code/thw3.c
index 701ffc53cdd..730d2d00352 100644
--- a/mps/code/thw3.c
+++ b/mps/code/thw3.c
@@ -212,11 +212,11 @@ Arena ThreadArena(Thread thread)
   return thread->arena;
 }
 
-Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
+Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thxc.c b/mps/code/thxc.c
index 9e6a6bd325c..99468e1158d 100644
--- a/mps/code/thxc.c
+++ b/mps/code/thxc.c
@@ -248,11 +248,11 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot)
 }
 
 
-Res ThreadDescribe(Thread thread, mps_lib_FILE *stream)
+Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
-  res = WriteF(stream,
+  res = WriteF(depth, stream,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 91004bf65aa..0083446a3f7 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1901,7 +1901,7 @@ failStart:
 
 /* TraceDescribe -- describe a trace */
 
-Res TraceDescribe(Trace trace, mps_lib_FILE *stream)
+Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   const char *state;
@@ -1918,7 +1918,8 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream)
   default:             state = "unknown";   break;
   }
 
-  res = WriteF(stream, "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
+  res = WriteF(depth, stream,
+               "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
                "arena $P ($U)\n", (WriteFP)trace->arena,
                (WriteFU)trace->arena->serial,
                "why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why),
@@ -1940,7 +1941,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream)
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(stream, "} Trace $P\n", (WriteFP)trace, NULL);
+  res = WriteF(depth, stream, "} Trace $P\n", (WriteFP)trace, NULL);
   return res;
 }
 
diff --git a/mps/design/buffer.txt b/mps/design/buffer.txt
index 391e86b7c62..6f5f49ac3db 100644
--- a/mps/design/buffer.txt
+++ b/mps/design/buffer.txt
@@ -243,10 +243,10 @@ setter method which sets the rank set of a buffer. It is called from
 ``BufferSetRankSet()``. Clients should not need to define their own
 methods for this.
 
-``typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream)``
+``typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth)``
 
 _`.class.method.describe`: ``describe()`` is a class-specific method
-called to describe a buffer, via BufferDescribe. Client-defined
+called to describe a buffer, via ``BufferDescribe()``. Client-defined
 methods must call their superclass method (via a next-method call)
 before describing any class-specific state.
 
diff --git a/mps/design/cbs.txt b/mps/design/cbs.txt
index 3168c7f472d..0d8c81df74e 100644
--- a/mps/design/cbs.txt
+++ b/mps/design/cbs.txt
@@ -167,13 +167,12 @@ and an iterator method to invoke on every range in address order. If
 the iterator method returns ``FALSE``, then the iteration is
 terminated.
 
-``Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)``
+``Res CBSDescribe(CBS cbs, mps_lib_FILE *stream, Count depth)``
 
-_`.function.cbs.describe`: ``CBSDescribe()`` is a function that prints
-a textual representation of the CBS to the given stream, indicating
-the contiguous ranges in order, as well as the structure of the
-underlying splay tree implementation. It is provided for debugging
-purposes only.
+_`.function.cbs.describe`: ``CBSDescribe()`` prints a textual
+representation of the CBS to the given stream, indicating the
+contiguous ranges in order, as well as the structure of the underlying
+splay tree implementation. It is provided for debugging only.
 
 ``Bool CBSFindFirst(Range rangeReturn, Range oldRangeReturn, CBS cbs, Size size, FindDelete findDelete)``
 
@@ -291,8 +290,8 @@ simulates the allocation and deallocation of ranges within this block
 using both a ``CBS`` and a ``BT``. It makes both valid and invalid
 requests, and compares the ``CBS`` response to the correct behaviour
 as determined by the ``BT``. It also iterates the ranges in the
-``CBS``, comparing them to the ``BT``. It also invokes the
-``CBSDescribe()`` method, but makes no automatic test of the resulting
+``CBS``, comparing them to the ``BT``. It also invokes
+``CBSDescribe()``, but makes no automatic test of the resulting
 output. It does not currently test the callbacks.
 
 _`.test.pool`: Several pools (currently MVT_ and MVFF_) are implemented
diff --git a/mps/design/diag.txt b/mps/design/diag.txt
index 68fe1301d4b..0c9ee32c52b 100644
--- a/mps/design/diag.txt
+++ b/mps/design/diag.txt
@@ -77,21 +77,23 @@ There are two mechanism for getting diagnostic output:
         (gdb) frame 12
         #12 0x000000010000b1fc in MVTFree (pool=0x103ffe160, base=0x101dfd000, size=5024) at poolmv2.c:711
         711	    Res res = CBSInsert(MVTCBS(mvt), base, limit);
-        (gdb) p MVTDescribe(mvt, mps_lib_get_stdout())
-        MVT 0000000103FFE160
-        {
-          minSize: 8 
-          meanSize: 42 
-          maxSize: 8192 
-          fragLimit: 30 
-          reuseSize: 16384 
-          fillSize: 8192 
-          availLimit: 1110835 
-          abqOverflow: FALSE 
-          splinter: TRUE 
-          splinterSeg: 0000000103FEE780 
-          splinterBase: 0000000101D7ABB8 
-          splinterLimit: 0000000101D7B000 
+        (gdb) p MVTDescribe(mvt, mps_lib_get_stdout(), 0)
+        MVT 0000000103FFE160 {
+          minSize: 8
+          meanSize: 42
+          maxSize: 8192
+          fragLimit: 30
+          reuseSize: 16384
+          fillSize: 8192
+          availLimit: 90931
+          abqOverflow: FALSE
+          splinter: TRUE
+          splinterBase: 0000000106192FF0
+          splinterLimit: 0000000106193000
+          size: 303104
+          allocated: 262928
+          available: 40176
+          unavailable: 0
           # ... etc ...
         }
 
diff --git a/mps/design/freelist.txt b/mps/design/freelist.txt
index badc4067f15..455816cf623 100644
--- a/mps/design/freelist.txt
+++ b/mps/design/freelist.txt
@@ -203,11 +203,11 @@ the Coalescing Block Structure ``cbs``. Continue until a call to
 ``CBSInsert()`` fails, or until the free list is empty, whichever
 happens first.
 
-``Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream)``
+``Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream, Count depth)``
 
 _`.function.describe`: Print a textual representation of the free
 list ``fl`` to the given stream, indicating the contiguous ranges in
-order. It is provided for debugging purposes only.
+order. It is provided for debugging only.
 
 
 
diff --git a/mps/design/poolawl.txt b/mps/design/poolawl.txt
index 790956b28f9..fe7f0c999d4 100644
--- a/mps/design/poolawl.txt
+++ b/mps/design/poolawl.txt
@@ -451,7 +451,7 @@ objects. Now reclaim doesn't need to check that the objects are
 allocated before skipping them. There may be a corresponding change
 for scan as well.
 
-``Res AWLDescribe(Pool pool, mps_lib_FILE *stream)``
+``Res AWLDescribe(Pool pool, mps_lib_FILE *stream, Count depth)``
 
 _`.fun.describe`:
 
diff --git a/mps/design/poolmrg.txt b/mps/design/poolmrg.txt
index 26e401ff9a6..cb31274915f 100644
--- a/mps/design/poolmrg.txt
+++ b/mps/design/poolmrg.txt
@@ -471,11 +471,12 @@ required.
 See analysis.mps.poolmrg.improve.scan.nomove for a suggested
 improvement that avoids redundant unlinking and relinking.
 
-``Res MRGDescribe(Pool pool, mps_lib_FILE *stream)``
+``Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)``
 
 _`.describe`: Describes an MRG pool. Iterates along each of the entry
 and exit lists and prints the guardians in each. The location of the
 guardian and the value of the reference in it will be printed out.
+Provided for debugging only.
 
 _`.functions.unused`: All of these will be unused: ``BufferInit()``,
 ``BufferFill()``, ``BufferEmpty()``, ``BufferFinish()``,
diff --git a/mps/design/splay.txt b/mps/design/splay.txt
index 8eb1a91c2a8..84116cce54d 100644
--- a/mps/design/splay.txt
+++ b/mps/design/splay.txt
@@ -183,7 +183,7 @@ _`.type.splay.node.describe.method`: A function of type
 ``SplayNodeDescribeMethod`` is required to write (via ``WriteF()``) a
 client-oriented representation of the splay node. The output should be
 non-empty, short, and without return characters. This is provided for
-debugging purposes only.
+debugging only.
 
 ``typedef Bool (*SplayTestNodeMethod)(SplayTree splay, Tree tree, void *closureP, unsigned long closureS)``
 
@@ -323,12 +323,13 @@ tree was previously beneficially balanced for a small working set of
 accesses, then this local optimization will be lost. (see
 `.future.parent`_).
 
-``Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, SplayNodeDescribeMethod nodeDescribe)``
+``Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth, SplayNodeDescribeMethod nodeDescribe)``
 
 _`.function.splay.tree.describe`: This function prints (using
-``WriteF``) to the stream a textual representation of the given splay
-tree, using ``nodeDescribe`` to print client-oriented representations
-of the nodes (see `.req.debug`_).
+``WriteF()``) to the stream a textual representation of the given
+splay tree, using ``nodeDescribe()`` to print client-oriented
+representations of the nodes (see `.req.debug`_). Provided for
+debugging only.
 
 ``Bool SplayFindFirst(Tree *nodeReturn, SplayTree splay, SplayTestNodeMethod testNode, SplayTestTreeMethod testTree, void *closureP, unsigned long closureS)``
 
@@ -368,19 +369,19 @@ _`.prop`: To support `.req.property.find`_, this splay tree
 implementation provides additional features to permit clients to cache
 maximum (or minimum) values of client properties for all the nodes in
 a subtree. The splay tree implementation uses the cached values as
-part of ``SplayFindFirst`` and ``SplayFindLast`` via the ``testNode``
-and ``testTree`` methods. The client is free to choose how to
-represent the client property, and how to compute and store the cached
-value.
+part of ``SplayFindFirst()`` and ``SplayFindLast()`` via the
+``testNode`` and ``testTree`` methods. The client is free to choose
+how to represent the client property, and how to compute and store the
+cached value.
 
 _`.prop.update`: The cached values depend upon the topology of the
 tree, which may vary as a result of operations on the tree. The client
 is given the opportunity to compute new cache values whenever
 necessary, via the ``updateNode`` method (see
 `.function.splay.tree.init`_). This happens whenever the tree is
-restructured. The client may use the ``SplayNodeRefresh`` method to
+restructured. The client may use the ``SplayNodeRefresh()`` method to
 indicate that the client attributes at a node have changed (see
-`.req.property.change`_). A call to ``SplayNodeRefresh`` splays the
+`.req.property.change`_). A call to ``SplayNodeRefresh()`` splays the
 tree at the specified node, which may provoke calls to the
 ``updateNode`` method as a result of the tree restructuring. The
 ``updateNode`` method will also be called whenever a new splay node is
diff --git a/mps/design/telemetry.txt b/mps/design/telemetry.txt
index 2bc359ed352..dc8b2619f65 100644
--- a/mps/design/telemetry.txt
+++ b/mps/design/telemetry.txt
@@ -409,7 +409,7 @@ _`.debug.dump`: The contents of all buffers can be dumped with the
 _`.debug.describe`: Individual events can be described with the
 EventDescribe function, for example::
 
-    gdb> print EventDescribe(EventLast[3], mps_lib_get_stdout())
+    gdb> print EventDescribe(EventLast[3], mps_lib_get_stdout(), 0)
 
 _`.debug.core`: The event buffers are preserved in core dumps and can
 be used to work out what the MPS was doing before a crash. Since the
diff --git a/mps/design/writef.txt b/mps/design/writef.txt
index dcbbbb78f83..ef39175b56d 100644
--- a/mps/design/writef.txt
+++ b/mps/design/writef.txt
@@ -38,13 +38,17 @@ _`.writef`: Our output requirements are few, so the code is short. The
 only output function which should be used in the rest of the MPM is
 ``WriteF()``.
 
-``Res WriteF(mps_lib_FILE *stream, ...)``
+``Res WriteF(Count depth, mps_lib_FILE *stream, ...)``
+
+If ``depth`` is greater than zero, then the first format character,
+and each format character after a newline, is preceded by ``depth``
+spaces.
 
 ``WriteF()`` expects a format string followed by zero or more items to
 insert into the output, followed by another format string, more items,
 and so on, and finally a ``NULL`` format string. For example::
 
-    res = WriteF(stream,
+    res = WriteF(depth, stream,
                  "Hello: $A\n", address,
                  "Spong: $U ($S)\n", number, string,
                  NULL);
@@ -52,25 +56,28 @@ and so on, and finally a ``NULL`` format string. For example::
 
 This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` contains the following code::
 
-    res = WriteF(stream,
+    res = WriteF(depth, stream,
                  "Buffer $P ($U) {\n",
                  (WriteFP)buffer, (WriteFU)buffer->serial,
-                 "class $P (\"$S\")\n",
+                 "  class $P (\"$S\")\n",
                  (WriteFP)buffer->class, buffer->class->name,
-                 "Arena $P\n",       (WriteFP)buffer->arena,
-                 "Pool $P\n",        (WriteFP)buffer->pool,
-                 buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
-                 "mode $S (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
-                 (WriteFS)abzMode,
-                 "fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
-                 "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
-                 "alignment $W\n",   (WriteFW)buffer->alignment,
-                 "base $A\n",        buffer->base,
-                 "initAtFlip $A\n",  buffer->initAtFlip,
-                 "init $A\n",        buffer->ap_s.init,
-                 "alloc $A\n",       buffer->ap_s.alloc,
-                 "limit $A\n",       buffer->ap_s.limit,
-                 "poolLimit $A\n",   buffer->poolLimit,
+                 "  Arena $P\n",       (WriteFP)buffer->arena,
+                 "  Pool $P\n",        (WriteFP)buffer->pool,
+                 "  ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
+                 "  mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+                 (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'),
+                 (WriteFC)((buffer->mode & BufferModeLOGGED)     ? 'l' : '_'),
+                 (WriteFC)((buffer->mode & BufferModeFLIPPED)    ? 'f' : '_'),
+                 (WriteFC)((buffer->mode & BufferModeATTACHED)   ? 'a' : '_'),
+                 "  fillSize $UKb\n",  (WriteFU)(buffer->fillSize / 1024),
+                 "  emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
+                 "  alignment $W\n",   (WriteFW)buffer->alignment,
+                 "  base $A\n",        buffer->base,
+                 "  initAtFlip $A\n",  buffer->initAtFlip,
+                 "  init $A\n",        buffer->ap_s.init,
+                 "  alloc $A\n",       buffer->ap_s.alloc,
+                 "  limit $A\n",       buffer->ap_s.limit,
+                 "  poolLimit $A\n",   buffer->poolLimit,
                  NULL);
     if (res != ResOK) return res;
 
@@ -93,7 +100,7 @@ used in future in some generalisation of varargs in the MPS.
 _`.formats`: The formats supported are as follows.
 
 ======= =========== ================== ======================================
-Code    Bame        Type               Example rendering
+Code    Name        Type               Example rendering
 ======= =========== ================== ======================================
 ``$A``  address     ``Addr``           ``000000019EF60010``
 ``$P``  pointer     ``void *``         ``000000019EF60100``
@@ -111,8 +118,8 @@ promotion of a ``char`` (see `.types`_).
 
 _`.snazzy`: We should resist the temptation to make ``WriteF()`` an
 incredible snazzy output engine. We only need it for ``Describe()``
-methods. At the moment it's a very simple bit of code -- let's keep it
-that way.
+methods. At the moment it's a simple bit of code -- let's keep it that
+way.
 
 _`.f`: The ``F`` code is used for function pointers. ISO C forbids casting
 function pointers to other types, so the bytes of their representation are
@@ -129,7 +136,7 @@ Document History
 
 - 2013-05-22 GDR_ Converted to reStructuredText.
 
-- 2014-04-17 GDR_ Add design for maintaining indentation.
+- 2014-04-17 GDR_ ``WriteF()`` now takes a ``depth`` parameter.
 
 .. _RB: http://www.ravenbrook.com/consultants/rb/
 .. _GDR: http://www.ravenbrook.com/consultants/gdr/

From c77c91056d464e26559775d6ac73ba39e4c868d5 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 18:30:23 +0100
Subject: [PATCH 13/70] Consistent order stream, depth.

Copied from Perforce
 Change: 186001
 ServerID: perforce.ravenbrook.com
---
 mps/code/abq.c        |  4 ++--
 mps/code/arena.c      | 22 +++++++++++-----------
 mps/code/arenavm.c    |  2 +-
 mps/code/buffer.c     |  6 +++---
 mps/code/cbs.c        |  6 +++---
 mps/code/clock.h      | 16 ++++++++--------
 mps/code/event.c      | 22 +++++++++++-----------
 mps/code/format.c     |  2 +-
 mps/code/freelist.c   |  6 +++---
 mps/code/global.c     |  6 +++---
 mps/code/locus.c      | 10 +++++-----
 mps/code/meter.c      |  6 +++---
 mps/code/mpm.c        | 12 ++++++------
 mps/code/mpm.h        |  6 +++---
 mps/code/nailboard.c  | 10 +++++-----
 mps/code/pool.c       |  6 +++---
 mps/code/poolabs.c    |  2 +-
 mps/code/poolamc.c    | 28 ++++++++++++++--------------
 mps/code/poolams.c    | 22 +++++++++++-----------
 mps/code/poolmfs.c    |  2 +-
 mps/code/poolmrg.c    |  6 +++---
 mps/code/poolmv.c     | 18 +++++++++---------
 mps/code/poolmv2.c    |  4 ++--
 mps/code/poolmvff.c   |  4 ++--
 mps/code/range.c      |  2 +-
 mps/code/root.c       | 14 +++++++-------
 mps/code/seg.c        | 12 ++++++------
 mps/code/splay.c      | 14 +++++++-------
 mps/code/than.c       |  2 +-
 mps/code/thix.c       |  2 +-
 mps/code/thw3.c       |  2 +-
 mps/code/thxc.c       |  2 +-
 mps/code/trace.c      |  4 ++--
 mps/design/writef.txt | 12 +++---------
 34 files changed, 144 insertions(+), 150 deletions(-)

diff --git a/mps/code/abq.c b/mps/code/abq.c
index 63abd1e5725..74abcdf009a 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -164,7 +164,7 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
   if (!TESTT(ABQ, abq)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "ABQ $P {\n", (WriteFP)abq,
                "  elements: $U \n", (WriteFU)abq->elements,
                "  in: $U \n", (WriteFU)abq->in,
@@ -186,7 +186,7 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
   METER_WRITE(abq->peek, stream, depth + 2);
   METER_WRITE(abq->delete, stream, depth + 2);
 
-  res = WriteF(depth, stream, "} ABQ $P\n", (WriteFP)abq, NULL);
+  res = WriteF(stream, depth, "} ABQ $P\n", (WriteFP)abq, NULL);
   if(res != ResOK)
     return res;
  
diff --git a/mps/code/arena.c b/mps/code/arena.c
index b344b3a6129..fa70084f194 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -47,7 +47,7 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
    * subclass describe method should avoid invoking 
    * ARENA_SUPERCLASS()->describe.  RHSK 2007-04-27.
    */
-  return WriteF(depth, stream,
+  return WriteF(stream, depth,
                 "  No class-specific description available.\n", NULL);
 }
 
@@ -436,14 +436,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream, "Arena $P {\n", (WriteFP)arena,
+  res = WriteF(stream, depth, "Arena $P {\n", (WriteFP)arena,
                "  class $P (\"$S\")\n",
                (WriteFP)arena->class, arena->class->name,
                NULL);
   if (res != ResOK) return res;
 
   if (arena->poolReady) {
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "controlPool $P\n", (WriteFP)&arena->controlPoolStruct,
                  NULL);
     if (res != ResOK) return res;
@@ -451,14 +451,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 
   /* Note: this Describe clause calls a function */
   reserved = ArenaReserved(arena);
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "reserved         $W  <-- "
                "total size of address-space reserved\n",
                (WriteFW)reserved,
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "committed        $W  <-- "
                "total bytes currently stored (in RAM or swap)\n",
                (WriteFW)arena->committed,
@@ -470,7 +470,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "droppedMessages $U$S\n", (WriteFU)arena->droppedMessages,
                (arena->droppedMessages == 0 ? "" : "  -- MESSAGES DROPPED!"),
                NULL);
@@ -479,14 +479,14 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
   res = (*arena->class->describe)(arena, stream, depth);
   if (res != ResOK) return res;
 
-  res = WriteF(depth + 2, stream, "Globals {\n", NULL);
+  res = WriteF(stream, depth + 2, "Globals {\n", NULL);
   if (res != ResOK) return res;  
   res = GlobalsDescribe(ArenaGlobals(arena), stream, depth + 4);
   if (res != ResOK) return res;
-  res = WriteF(depth + 2, stream, "} Globals\n", NULL);
+  res = WriteF(stream, depth + 2, "} Globals\n", NULL);
   if (res != ResOK) return res;  
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "} Arena $P ($U)\n", (WriteFP)arena,
                (WriteFU)arena->serial,
                NULL);
@@ -515,7 +515,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
     size = ArenaAlign(arena);
 
     if (TractBase(tract) > oldLimit) {
-      res = WriteF(depth, stream,
+      res = WriteF(stream, depth,
                    "[$P, $P) $W $U   ---\n",
                    (WriteFP)oldLimit, (WriteFP)base,
                    (WriteFW)AddrOffset(oldLimit, base),
@@ -524,7 +524,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
       if (res != ResOK) return res;
     }
 
-    res = WriteF(depth, stream,
+    res = WriteF(stream, depth,
                  "[$P, $P) $W $U   $P ($S)\n",
                  (WriteFP)base, (WriteFP)limit,
                  (WriteFW)size, (WriteFW)size,
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 4b74b2ac68d..08f68b6fb75 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -204,7 +204,7 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
    *
   */
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "  spareSize:     $U\n", (WriteFU)vmArena->spareSize,
                NULL);
   if(res != ResOK)
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index 13d223ca7f6..bb5ef1d995b 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -153,7 +153,7 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Buffer, buffer)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Buffer $P ($U) {\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
                "  class $P (\"$S\")\n",
@@ -181,7 +181,7 @@ Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
   res = buffer->class->describe(buffer, stream, depth + 2);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream, "} Buffer $P ($U)\n",
+  res = WriteF(stream, depth, "} Buffer $P ($U)\n",
                (WriteFP)buffer, (WriteFU)buffer->serial,
                NULL);
   return res;
@@ -1439,7 +1439,7 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
   res = super->describe(buffer, stream, depth);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Seg $P\n",         (WriteFP)segbuf->seg,
                "rankSet $U\n",     (WriteFU)segbuf->rankSet,
                NULL);
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 942f1b651c8..c7facb9a98f 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -660,7 +660,7 @@ static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(0, stream,
+  res = WriteF(stream, 0,
                "[$P,$P) {$U, $B}",
                (WriteFP)block->base,
                (WriteFP)block->limit,
@@ -1064,7 +1064,7 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "CBS $P {\n", (WriteFP)cbs,
                "  alignment: $U\n", (WriteFU)cbs->alignment,
                "  blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
@@ -1080,7 +1080,7 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream, Count depth)
                           &cbsSplayNodeDescribe);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream, "} CBS $P\n", (WriteFP)cbs, NULL);
+  res = WriteF(stream, depth, "} CBS $P\n", (WriteFP)cbs, NULL);
   return res;
 }
 
diff --git a/mps/code/clock.h b/mps/code/clock.h
index 9b0dc7d6203..2766ccd724c 100644
--- a/mps/code/clock.h
+++ b/mps/code/clock.h
@@ -66,8 +66,8 @@ typedef union EventClockUnion {
           (*(EventClockUnion *)&(clock)).half.high, \
           (*(EventClockUnion *)&(clock)).half.low)
 
-#define EVENT_CLOCK_WRITE(depth, stream, clock)  \
-  WriteF(depth, stream, "$W$W", \
+#define EVENT_CLOCK_WRITE(stream, depth, clock)  \
+  WriteF(stream, depth, "$W$W", \
          (*(EventClockUnion *)&(clock)).half.high, \
          (*(EventClockUnion *)&(clock)).half.low, \
          NULL)
@@ -86,8 +86,8 @@ typedef union EventClockUnion {
 
 #endif
 
-#define EVENT_CLOCK_WRITE(depth, stream, clock) \
-  WriteF(depth, stream, "$W", (WriteFW)(clock), NULL)
+#define EVENT_CLOCK_WRITE(stream, depth, clock) \
+  WriteF(stream, depth, "$W", (WriteFW)(clock), NULL)
 
 #endif
 
@@ -136,8 +136,8 @@ __extension__ typedef unsigned long long EventClock;
           (unsigned long)((clock) >> 32), \
           (unsigned long)((clock) & 0xffffffff))
 
-#define EVENT_CLOCK_WRITE(depth, stream, clock) \
-  WriteF(depth, stream, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL)
+#define EVENT_CLOCK_WRITE(stream, depth, clock) \
+  WriteF(stream, depth, "$W$W", (WriteFW)((clock) >> 32), (WriteFW)clock, NULL)
 
 #endif /* Intel, GCC or Clang */
 
@@ -154,8 +154,8 @@ typedef mps_clock_t EventClock;
 #define EVENT_CLOCK_PRINT(stream, clock) \
   fprintf(stream, "%lu", (unsigned long)clock)
 
-#define EVENT_CLOCK_WRITE(depth, stream, clock) \
-  WriteF(depth, stream, "$W", (WriteFW)clock, NULL)
+#define EVENT_CLOCK_WRITE(stream, depth, clock) \
+  WriteF(stream, depth, "$W", (WriteFW)clock, NULL)
 
 #endif
 
diff --git a/mps/code/event.c b/mps/code/event.c
index 54be8cba89f..d2b182d7377 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -329,14 +329,14 @@ Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Event $P {\n", (WriteFP)event,
                "  code $U\n", (WriteFU)event->any.code,
                "  clock ", NULL);
   if (res != ResOK) return res;
-  res = EVENT_CLOCK_WRITE(depth, stream, event->any.clock);
+  res = EVENT_CLOCK_WRITE(stream, depth, event->any.clock);
   if (res != ResOK) return res;
-  res = WriteF(depth, stream, "\n  size $U\n", (WriteFU)event->any.size, NULL);
+  res = WriteF(stream, depth, "\n  size $U\n", (WriteFU)event->any.size, NULL);
   if (res != ResOK) return res;
 
   switch (event->any.code) {
@@ -347,7 +347,7 @@ Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
 
 #define EVENT_DESC(X, name, _code, always, kind) \
   case _code: \
-    res = WriteF(depth, stream, \
+    res = WriteF(stream, depth, \
                  "  event \"$S\"", (WriteFS)#name, \
                  EVENT_##name##_PARAMS(EVENT_DESC_PARAM, name) \
                  NULL); \
@@ -357,13 +357,13 @@ Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
   EVENT_LIST(EVENT_DESC, X)
 
   default:
-    res = WriteF(depth, stream, "  event type unknown", NULL);
+    res = WriteF(stream, depth, "  event type unknown", NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
   }
   
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "\n} Event $P\n", (WriteFP)event,
                NULL);
   return res;
@@ -377,7 +377,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
   if (event == NULL) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = EVENT_CLOCK_WRITE(0, stream, event->any.clock);
+  res = EVENT_CLOCK_WRITE(stream, 0, event->any.clock);
   if (res != ResOK)
     return res;
 
@@ -388,7 +388,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
 
 #define EVENT_WRITE(X, name, code, always, kind) \
   case code: \
-    res = WriteF(0, stream, " $S", #name, \
+    res = WriteF(stream, 0, " $S", #name, \
                  EVENT_##name##_PARAMS(EVENT_WRITE_PARAM, name) \
                  NULL); \
     if (res != ResOK) return res; \
@@ -396,7 +396,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
   EVENT_LIST(EVENT_WRITE, X)
 
   default:
-    res = WriteF(0, stream, " <unknown code $U>", event->any.code, NULL);
+    res = WriteF(stream, 0, " <unknown code $U>", event->any.code, NULL);
     if (res != ResOK) return res;
     /* TODO: Hexdump unknown event contents. */
     break;
@@ -416,7 +416,7 @@ void EventDump(mps_lib_FILE *stream)
   /* This can happen if there's a backtrace very early in the life of
      the MPS, and will cause an access violation if we continue. */
   if (!eventInited) {
-    (void)WriteF(0, stream, "No events\n", NULL);
+    (void)WriteF(stream, 0, "No events\n", NULL);
     return;
   }
 
@@ -427,7 +427,7 @@ void EventDump(mps_lib_FILE *stream)
       /* Try to keep going even if there's an error, because this is used as a
          backtrace and we'll take what we can get. */
       (void)EventWrite(event, stream);
-      (void)WriteF(0, stream, "\n", NULL);
+      (void)WriteF(stream, 0, "\n", NULL);
     }
   }
 }
diff --git a/mps/code/format.c b/mps/code/format.c
index 92f34b3de4c..965ca61c306 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -197,7 +197,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial,
                "  arena $P ($U)\n",
                (WriteFP)format->arena, (WriteFU)format->arena->serial,
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 814039a8723..f51f44fbceb 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -557,7 +557,7 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
   AVERT(Range, range);
   AVER(stream != NULL);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "[$P,", (WriteFP)RangeBase(range),
                "$P)", (WriteFP)RangeLimit(range),
                " {$U}\n", (WriteFU)RangeSize(range),
@@ -575,7 +575,7 @@ Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Freelist, fl)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Freelist $P {\n", (WriteFP)fl,
                "  alignment = $U\n", (WriteFU)fl->alignment,
                "  listSize = $U\n", (WriteFU)fl->listSize,
@@ -583,7 +583,7 @@ Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream, Count depth)
 
   FreelistIterate(fl, freelistDescribeIterateMethod, stream, depth + 2);
 
-  res = WriteF(depth, stream, "} Freelist $P\n", (WriteFP)fl, NULL);
+  res = WriteF(stream, depth, "} Freelist $P\n", (WriteFP)fl, NULL);
   return res;
 }
 
diff --git a/mps/code/global.c b/mps/code/global.c
index ec2c8e0a80f..0b8f331b101 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1047,7 +1047,7 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
   if (stream == NULL) return ResFAIL;
 
   arena = GlobalsArena(arenaGlobals);
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "mpsVersion $S\n", arenaGlobals->mpsVersionString,
                "lock $P\n", (WriteFP)arenaGlobals->lock,
                "pollThreshold $U kB\n",
@@ -1079,13 +1079,13 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
   if (res != ResOK) return res;
 
   for(i=0; i < LDHistoryLENGTH; ++ i) {
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "[$U] = $B\n", i, arena->history[i],
                  NULL);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "} history\n",
                "suspended $S\n", arena->suspended ? "YES" : "NO",
                "shDepth $U\n", arena->shDepth,
diff --git a/mps/code/locus.c b/mps/code/locus.c
index c5baf0f542b..a6017a6b09c 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -136,7 +136,7 @@ Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
   if (!TESTT(GenDesc, gen)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "GenDesc $P {\n", (WriteFP)gen,
                "  zones $B\n", (WriteFB)gen->zones,
                "  capacity $U\n", (WriteFU)gen->capacity,
@@ -151,7 +151,7 @@ Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream, "} GenDesc $P\n", (WriteFP)gen, NULL);
+  res = WriteF(stream, depth, "} GenDesc $P\n", (WriteFP)gen, NULL);
   return res;
 }
 
@@ -451,7 +451,7 @@ Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Chain, chain)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Chain $P {\n", (WriteFP)chain,
                "  arena $P\n", (WriteFP)chain->arena,
                "  activeTraces $B\n", (WriteFB)chain->activeTraces,
@@ -463,7 +463,7 @@ Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth)
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "} Chain $P\n", (WriteFP)chain,
                NULL);
   return res;
@@ -532,7 +532,7 @@ Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
   if (!TESTT(PoolGen, pgen)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
   
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "PoolGen $P ($U) {\n", (WriteFP)pgen, (WriteFU)pgen->nr,
                "pool $P ($U) \"$S\"\n",
                (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
diff --git a/mps/code/meter.c b/mps/code/meter.c
index debf0ee3fcc..e112986119d 100644
--- a/mps/code/meter.c
+++ b/mps/code/meter.c
@@ -68,7 +68,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth)
 {
   Res res = ResOK;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "meter \"$S\" {", meter->name,
                "count: $U", meter->count,
                NULL);
@@ -77,7 +77,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth)
   if (meter->count > 0) {
     double mean = meter->total / (double)meter->count;
    
-    res = WriteF(0, stream,
+    res = WriteF(stream, 0,
                  ", total: $D", meter->total,
                  ", max: $U", meter->max,
                  ", min: $U", meter->min,
@@ -87,7 +87,7 @@ Res MeterWrite(Meter meter, mps_lib_FILE *stream, Count depth)
     if (res != ResOK)
       return res;
   }
-  res = WriteF(0, stream, "}\n", NULL);
+  res = WriteF(stream, 0, "}\n", NULL);
 
   return res;
 }
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index 5de82a1f022..35bd33ea6f0 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -430,28 +430,28 @@ static Res WriteDouble(mps_lib_FILE *stream, double d)
  * .writef.check: See .check.writef.
  */
 
-Res WriteF(Count depth, mps_lib_FILE *stream, ...)
+Res WriteF(mps_lib_FILE *stream, Count depth, ...)
 {
   Res res;
   va_list args;
  
-  va_start(args, stream);
-  res = WriteF_v(depth, stream, args);
+  va_start(args, depth);
+  res = WriteF_v(stream, depth, args);
   va_end(args);
   return res;
 }
 
-Res WriteF_v(Count depth, mps_lib_FILE *stream, va_list args)
+Res WriteF_v(mps_lib_FILE *stream, Count depth, va_list args)
 {
   const char *firstformat;
   Res res;
 
   firstformat = va_arg(args, const char *);
-  res = WriteF_firstformat_v(depth, stream, firstformat, args);
+  res = WriteF_firstformat_v(stream, depth, firstformat, args);
   return res;
 }
 
-Res WriteF_firstformat_v(Count depth, mps_lib_FILE *stream, 
+Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth, 
                          const char *firstformat, va_list args)
 {
   const char *format;
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index c41e3b2e61d..f912718cc53 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -153,9 +153,9 @@ extern Bool (WordIsP2)(Word word);
 
 /* Formatted Output -- see <design/writef/>, <code/mpm.c> */
 
-extern Res WriteF(Count depth, mps_lib_FILE *stream, ...);
-extern Res WriteF_v(Count depth, mps_lib_FILE *stream, va_list args);
-extern Res WriteF_firstformat_v(Count depth, mps_lib_FILE *stream,
+extern Res WriteF(mps_lib_FILE *stream, Count depth, ...);
+extern Res WriteF_v(mps_lib_FILE *stream, Count depth, va_list args);
+extern Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth,
                                 const char *firstformat, va_list args);
 
 
diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index 1167a838a6c..f8104371efd 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -413,7 +413,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Nailboard $P\n{\n", (WriteFP)board,
                "  base: $P\n", (WriteFP)RangeBase(&board->range),
                "  limit: $P\n", (WriteFP)RangeLimit(&board->range),
@@ -427,21 +427,21 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth)
   for(i = 0; i < board->levels; ++i) {
     Count levelNails = nailboardLevelBits(nailboardNails(board), i);
     Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
-    res = WriteF(depth + 2, stream, "Level $U ($U bits, $U set): ",
+    res = WriteF(stream, depth + 2, "Level $U ($U bits, $U set): ",
                  i, levelNails, levelNails - resetNails, NULL);
     if (res != ResOK)
       return res;
     for (j = 0; j < levelNails; ++j) {
       char c = BTGet(board->level[i], j) ? '*' : '.';
-      res = WriteF(0, stream, "$C", c, NULL);
+      res = WriteF(stream, 0, "$C", c, NULL);
       if (res != ResOK)
         return res;
     }
-    res = WriteF(0, stream, "\n", NULL);
+    res = WriteF(stream, 0, "\n", NULL);
     if (res != ResOK)
       return res;
   }
-  res = WriteF(depth, stream, "} Nailboard $P\n", (WriteFP)board, NULL);
+  res = WriteF(stream, depth, "} Nailboard $P\n", (WriteFP)board, NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/pool.c b/mps/code/pool.c
index ed50c5c0933..ec125b7bec0 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -530,7 +530,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Pool, pool)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
  
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
                "  class $P (\"$S\")\n",
                (WriteFP)pool->class, pool->class->name,
@@ -543,7 +543,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     res = FormatDescribe(pool->format, stream, depth + 2);
     if (res != ResOK) return res;
   }
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "fillMutatorSize $UKb\n",
                (WriteFU)(pool->fillMutatorSize / 1024),
                "emptyMutatorSize $UKb\n",
@@ -564,7 +564,7 @@ Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial,
                NULL);
   if (res != ResOK) return res;
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index ee20a829f77..cc0eb6e838c 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -315,7 +315,7 @@ Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   AVERT(Pool, pool);
   AVER(stream != NULL);
-  return WriteF(depth, stream,
+  return WriteF(stream, depth,
                 "No class-specific description available.\n",
                 NULL);
 }
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 5777b95c72b..05dea8bc83c 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -258,7 +258,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   p = AddrAdd(base, pool->format->headerSize);
   limit = SegLimit(seg);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "AMC seg $P [$A,$A){\n",
                (WriteFP)seg, (WriteFA)base, (WriteFA)limit,
                NULL);
@@ -266,16 +266,16 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
     return res;
 
   if(amcSegHasNailboard(seg)) {
-    res = WriteF(depth + 2, stream, "Boarded\n", NULL);
+    res = WriteF(stream, depth + 2, "Boarded\n", NULL);
   } else if(SegNailed(seg) == TraceSetEMPTY) {
-    res = WriteF(depth + 2, stream, "Mobile\n", NULL);
+    res = WriteF(stream, depth + 2, "Mobile\n", NULL);
   } else {
-    res = WriteF(depth + 2, stream, "Stuck\n", NULL);
+    res = WriteF(stream, depth + 2, "Stuck\n", NULL);
   }
   if(res != ResOK)
     return res;
 
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
   if(res != ResOK)
     return res;
@@ -289,7 +289,7 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
     Addr j;
     char c;
 
-    res = WriteF(depth + 2, stream, "$A  ", i, NULL);
+    res = WriteF(stream, depth + 2, "$A  ", i, NULL);
     if(res != ResOK)
       return res;
 
@@ -309,22 +309,22 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
           c = (nailed ? '+' : '=');
         }
       }
-      res = WriteF(0, stream, "$C", c, NULL);
+      res = WriteF(stream, 0, "$C", c, NULL);
       if(res != ResOK)
         return res;
     }
 
-    res = WriteF(0, stream, "\n", NULL);
+    res = WriteF(stream, 0, "\n", NULL);
     if(res != ResOK)
       return res;
   }
 
   AMCSegSketch(seg, abzSketch, NELEMS(abzSketch));
-  res = WriteF(depth + 2, stream, "Sketch: $S\n", (WriteFS)abzSketch, NULL);
+  res = WriteF(stream, depth + 2, "Sketch: $S\n", (WriteFS)abzSketch, NULL);
   if(res != ResOK)
     return res;
 
-  res = WriteF(depth, stream, "} AMC Seg $P\n", (WriteFP)seg, NULL);
+  res = WriteF(stream, depth, "} AMC Seg $P\n", (WriteFP)seg, NULL);
   if(res != ResOK)
     return res;
 
@@ -715,7 +715,7 @@ static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream, Count depth)
   if(!TESTT(amcGen, gen))
     return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "amcGen $P ($U) {\n",
                (WriteFP)gen, (WriteFU)amcGenNr(gen),
                "  buffer $P\n", gen->forward,
@@ -2278,7 +2278,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if(stream == NULL)
     return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
                " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
                (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial,
@@ -2297,7 +2297,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
       rampmode = "unknown ramp mode";
       break;
   }
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                rampmode, " ($U)\n", (WriteFU)amc->rampCount,
                NULL);
   if(res != ResOK)
@@ -2320,7 +2320,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     }
   }
 
-  res = WriteF(depth, stream, "} AMC $P\n", (WriteFP)amc, NULL);
+  res = WriteF(stream, depth, "} AMC $P\n", (WriteFP)amc, NULL);
   if(res != ResOK)
     return res;
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index fe3d8d36db3..e85f06991ed 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -525,7 +525,7 @@ failCreateTablesLo:
   BEGIN \
     if ((buffer) != NULL \
        && (i) == AMS_ADDR_INDEX(seg, accessor(buffer))) { \
-      Res _res = WriteF(0, stream, char, NULL); \
+      Res _res = WriteF(stream, 0, char, NULL); \
       if (_res != ResOK) return _res; \
     } \
   END
@@ -550,21 +550,21 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 
   buffer = SegBuffer(seg);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "AMS $P\n", (WriteFP)amsseg->ams,
                "grains $W\n", (WriteFW)amsseg->grains,
                NULL);
   if (res != ResOK) return res;
   if (amsseg->allocTableInUse)
-    res = WriteF(depth, stream,
+    res = WriteF(stream, depth,
                  "alloctable $P\n", (WriteFP)amsseg->allocTable,
                  NULL);
   else
-    res = WriteF(depth, stream,
+    res = WriteF(stream, depth,
                  "firstFree $W\n", (WriteFW)amsseg->firstFree,
                  NULL);
   if (res != ResOK) return res;
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "tables: nongrey $P, nonwhite $P\n",
                (WriteFP)amsseg->nongreyTable,
                (WriteFP)amsseg->nonwhiteTable,
@@ -576,9 +576,9 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
     char c = 0;
 
     if (i % 64 == 0) {
-      res = WriteF(0, stream, "\n", NULL);
+      res = WriteF(stream, 0, "\n", NULL);
       if (res != ResOK) return res;
-      res = WriteF(depth, stream, "  ", NULL);
+      res = WriteF(stream, depth, "  ", NULL);
       if (res != ResOK) return res;
     }
 
@@ -600,7 +600,7 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
         c = '.';
     } else
       c = ' ';
-    res = WriteF(0, stream, "$C", c, NULL);
+    res = WriteF(stream, 0, "$C", c, NULL);
     if (res != ResOK)
       return res;
 
@@ -1658,7 +1658,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (!TESTT(AMS, ams)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "AMS $P {\n", (WriteFP)ams,
                "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
@@ -1670,7 +1670,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(depth + 2, stream,
+  res = WriteF(stream, depth + 2,
                "segments: * black  + grey  - white  . alloc  ! bad\n"
                "buffers: [ base  < scan limit  | init  > alloc  ] limit\n",
                NULL);
@@ -1682,7 +1682,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream, "} AMS $P\n",(WriteFP)ams, NULL);
+  res = WriteF(stream, depth, "} AMS $P\n",(WriteFP)ams, NULL);
   if (res != ResOK)
     return res;
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 9b3e469e28a..baf7c2f5ee4 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -322,7 +322,7 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 
   AVER(stream != NULL);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "unrounded unit size $W\n", (WriteFW)mfs->unroundedUnitSize,
                "unit size $W\n",           (WriteFW)mfs->unitSize,
                "extent size $W\n",         (WriteFW)mfs->extendBy,
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index add1d013db8..bc7762e9091 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -806,13 +806,13 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (stream == NULL) return ResFAIL;
 
   arena = PoolArena(pool);
-  res = WriteF(depth, stream, "  extendBy $W\n", mrg->extendBy, NULL);
+  res = WriteF(stream, depth, "  extendBy $W\n", mrg->extendBy, NULL);
   if (res != ResOK) return res;
-  res = WriteF(depth, stream, "  Entry queue:\n", NULL);
+  res = WriteF(stream, depth, "  Entry queue:\n", NULL);
   if (res != ResOK) return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
-    res = WriteF(depth, stream, "    at $A Ref $A\n",
+    res = WriteF(stream, depth, "    at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
     if (res != ResOK) return res;
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 7f181a405b0..6af3ae68724 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -687,7 +687,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if(!TESTT(MV, mv)) return ResFAIL;
   if(stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "blockPool $P ($U)\n",
                (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
                "spanPool  $P ($U)\n",
@@ -707,10 +707,10 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     Addr i, j;
     MVBlock block;
     span = RING_ELT(MVSpan, spans, node);
-    res = WriteF(depth, stream, "MVSpan $P {\n", (WriteFP)span, NULL);
+    res = WriteF(stream, depth, "MVSpan $P {\n", (WriteFP)span, NULL);
     if(res != ResOK) return res;
 
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "span    $P\n", (WriteFP)span,
                  "tract   $P\n", (WriteFP)span->tract,
                  "space   $W\n", (WriteFW)span->space,
@@ -720,15 +720,15 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     if(res != ResOK) return res;
 
     if (span->largestKnown) /* .design.largest */
-      res = WriteF(0, stream, "$W\n", (WriteFW)span->largest, NULL);
+      res = WriteF(stream, 0, "$W\n", (WriteFW)span->largest, NULL);
     else
-      res = WriteF(0, stream, "unknown\n", NULL);
+      res = WriteF(stream, 0, "unknown\n", NULL);
     if(res != ResOK) return res;
 
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
-      res = WriteF(depth + 2, stream, "$A ", i, NULL);
+      res = WriteF(stream, depth + 2, "$A ", i, NULL);
       if(res != ResOK) return res;
 
       for(j = i;
@@ -751,13 +751,13 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
           c = ']';
         else /* j > block->base && j < block->limit */
           c = '=';
-        res = WriteF(0, stream, "$C", c, NULL);
+        res = WriteF(stream, 0, "$C", c, NULL);
         if(res != ResOK) return res;
       }
-      res = WriteF(0, stream, "\n", NULL);
+      res = WriteF(stream, 0, "\n", NULL);
       if(res != ResOK) return res;
     }
-    res = WriteF(depth, stream, "} MVSpan $P\n", (WriteFP)span, NULL);
+    res = WriteF(stream, depth, "} MVSpan $P\n", (WriteFP)span, NULL);
     if(res != ResOK) return res;
   }
 
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 5a457b0612d..6dd86183205 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -1013,7 +1013,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (!TESTT(MVT, mvt)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "MVT $P {\n", (WriteFP)mvt,
                "  minSize: $U\n", (WriteFU)mvt->minSize,
                "  meanSize: $U\n", (WriteFU)mvt->meanSize,
@@ -1075,7 +1075,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   METER_WRITE(mvt->exceptionSplinters, stream, depth + 2);
   METER_WRITE(mvt->exceptionReturns, stream, depth + 2);
  
-  res = WriteF(depth, stream, "} MVT $P\n", (WriteFP)mvt, NULL);
+  res = WriteF(stream, depth, "} MVT $P\n", (WriteFP)mvt, NULL);
   return res;
 }
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index ec5ecb86e54..b5f6e942ba4 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -679,7 +679,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (!TESTT(MVFF, mvff)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "MVFF $P {\n", (WriteFP)mvff,
                "  pool $P ($U)\n",
                (WriteFP)pool, (WriteFU)pool->serial,
@@ -699,7 +699,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (res != ResOK)
     return res;
 
-  res = WriteF(depth, stream, "} MVFF $P\n", (WriteFP)mvff, NULL);
+  res = WriteF(stream, depth, "} MVFF $P\n", (WriteFP)mvff, NULL);
 
   return res;
 }
diff --git a/mps/code/range.c b/mps/code/range.c
index 41ba26216b6..222e335f95b 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -46,7 +46,7 @@ Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth)
   AVERT(Range, range);
   AVER(stream != NULL);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Range $P\n{\n", (WriteFP)range,
                "  base: $P\n", (WriteFP)RangeBase(range),
                "  limit: $P\n", (WriteFP)RangeLimit(range),
diff --git a/mps/code/root.c b/mps/code/root.c
index a3ed0c80b7e..4732af15a62 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -587,7 +587,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Root, root)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Root $P ($U) {\n", (WriteFP)root, (WriteFU)root->serial,
                "  arena $P ($U)\n", (WriteFP)root->arena,
                (WriteFU)root->arena->serial,
@@ -599,7 +599,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
 
   switch(root->var) {
     case RootTABLE:
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "table base $A limit $A\n",
                  root->the.table.base, root->the.table.limit,
                  NULL);
@@ -607,7 +607,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
     break;
 
     case RootTABLE_MASKED:
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "table base $A limit $A mask $B\n",
                  root->the.tableMasked.base, root->the.tableMasked.limit,
                  root->the.tableMasked.mask,
@@ -616,7 +616,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
     break;
 
     case RootFUN:
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "scan function $F\n", (WriteFF)root->the.fun.scan,
                  "environment p $P s $W\n",
                  root->the.fun.p, (WriteFW)root->the.fun.s,
@@ -625,7 +625,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
     break;
 
     case RootREG:
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "thread $P\n", (WriteFP)root->the.reg.thread,
                  "environment p $P", root->the.reg.p,
                  NULL);
@@ -633,7 +633,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
     break;
 
     case RootFMT:
-    res = WriteF(depth + 2, stream,
+    res = WriteF(stream, depth + 2,
                  "scan function $F\n", (WriteFF)root->the.fmt.scan,
                  "format base $A limit $A\n",
                  root->the.fmt.base, root->the.fmt.limit,
@@ -645,7 +645,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
     NOTREACHED;
   }
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "} Root $P ($U)\n", (WriteFP)root, (WriteFU)root->serial,
                NULL);
   if (res != ResOK) return res;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 7e022362b30..f55a07334af 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -365,7 +365,7 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 
   pool = SegPool(seg);
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Segment $P [$A,$A) {\n", (WriteFP)seg,
                (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
                "  class $P (\"$S\")\n",
@@ -378,10 +378,10 @@ Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   res = seg->class->describe(seg, stream, depth + 2);
   if (res != ResOK) return res;
 
-  res = WriteF(0, stream, "\n", NULL);
+  res = WriteF(stream, 0, "\n", NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream, "} Segment $P\n", (WriteFP)seg, NULL);
+  res = WriteF(stream, depth, "} Segment $P\n", (WriteFP)seg, NULL);
   return res;
 }
 
@@ -1032,7 +1032,7 @@ static Res segTrivDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   if (!TESTT(Seg, seg)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "shield depth $U\n", (WriteFU)seg->depth,
                "protection mode: ",
                (SegPM(seg) & AccessREAD) ? "" : "!", "READ", " ",
@@ -1600,13 +1600,13 @@ static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   res = super->describe(seg, stream, depth);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "summary $W\n", (WriteFW)gcseg->summary,
                NULL);
   if (res != ResOK) return res;
 
   if (gcseg->buffer == NULL) {
-    res = WriteF(depth, stream, "buffer: NULL\n", NULL);
+    res = WriteF(stream, depth, "buffer: NULL\n", NULL);
   } else {
     res = BufferDescribe(gcseg->buffer, stream, depth);
   }
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 4325d8b2c56..0e5c1ad6edb 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -1015,14 +1015,14 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
   /* stream and nodeDescribe checked by SplayTreeDescribe */
 #endif
 
-  res = WriteF(0, stream, "( ", NULL);
+  res = WriteF(stream, 0, "( ", NULL);
   if (res != ResOK) return res;
 
   if (TreeHasLeft(node)) {
     res = SplayNodeDescribe(TreeLeft(node), stream, nodeDescribe);
     if (res != ResOK) return res;
 
-    res = WriteF(0, stream, " / ", NULL);
+    res = WriteF(stream, 0, " / ", NULL);
     if (res != ResOK) return res;
   }
 
@@ -1030,14 +1030,14 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
   if (res != ResOK) return res;
 
   if (TreeHasRight(node)) {
-    res = WriteF(0, stream, " \\ ", NULL);
+    res = WriteF(stream, 0, " \\ ", NULL);
     if (res != ResOK) return res;
 
     res = SplayNodeDescribe(TreeRight(node), stream, nodeDescribe);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(0, stream, " )", NULL);
+  res = WriteF(stream, 0, " )", NULL);
   if (res != ResOK) return res;
 
   return ResOK;
@@ -1335,20 +1335,20 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth,
   if (!FUNCHECK(nodeDescribe)) return ResFAIL;
 #endif
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Splay $P {\n", (WriteFP)splay,
                "  compare $F\n", (WriteFF)splay->compare,
                NULL);
   if (res != ResOK) return res;
 
   if (SplayTreeRoot(splay) != TreeEMPTY) {
-    res = WriteF(depth, stream, "  tree ", NULL);
+    res = WriteF(stream, depth, "  tree ", NULL);
     if (res != ResOK) return res;
     res = SplayNodeDescribe(SplayTreeRoot(splay), stream, nodeDescribe);
     if (res != ResOK) return res;
   }
 
-  res = WriteF(depth, stream, "\n} Splay $P\n", (WriteFP)splay, NULL);
+  res = WriteF(stream, depth, "\n} Splay $P\n", (WriteFP)splay, NULL);
   return res;
 }
 
diff --git a/mps/code/than.c b/mps/code/than.c
index 5ce14031bd9..0ee0a3cc363 100644
--- a/mps/code/than.c
+++ b/mps/code/than.c
@@ -132,7 +132,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thix.c b/mps/code/thix.c
index c4a7f9ad71c..cc6a3b61219 100644
--- a/mps/code/thix.c
+++ b/mps/code/thix.c
@@ -276,7 +276,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thw3.c b/mps/code/thw3.c
index 730d2d00352..96af1f83f6b 100644
--- a/mps/code/thw3.c
+++ b/mps/code/thw3.c
@@ -216,7 +216,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
  
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n", 
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/thxc.c b/mps/code/thxc.c
index 99468e1158d..3160bec9caf 100644
--- a/mps/code/thxc.c
+++ b/mps/code/thxc.c
@@ -252,7 +252,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth)
 {
   Res res;
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial,
                "  arena $P ($U)\n",
                (WriteFP)thread->arena, (WriteFU)thread->arena->serial,
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 0083446a3f7..8ea1b1bf0fd 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1918,7 +1918,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth)
   default:             state = "unknown";   break;
   }
 
-  res = WriteF(depth, stream,
+  res = WriteF(stream, depth,
                "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
                "arena $P ($U)\n", (WriteFP)trace->arena,
                (WriteFU)trace->arena->serial,
@@ -1941,7 +1941,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth)
                NULL);
   if (res != ResOK) return res;
 
-  res = WriteF(depth, stream, "} Trace $P\n", (WriteFP)trace, NULL);
+  res = WriteF(stream, depth, "} Trace $P\n", (WriteFP)trace, NULL);
   return res;
 }
 
diff --git a/mps/design/writef.txt b/mps/design/writef.txt
index ef39175b56d..bfb2a131e26 100644
--- a/mps/design/writef.txt
+++ b/mps/design/writef.txt
@@ -38,7 +38,7 @@ _`.writef`: Our output requirements are few, so the code is short. The
 only output function which should be used in the rest of the MPM is
 ``WriteF()``.
 
-``Res WriteF(Count depth, mps_lib_FILE *stream, ...)``
+``Res WriteF(mps_lib_FILE *stream, Count depth, ...)``
 
 If ``depth`` is greater than zero, then the first format character,
 and each format character after a newline, is preceded by ``depth``
@@ -48,7 +48,7 @@ spaces.
 insert into the output, followed by another format string, more items,
 and so on, and finally a ``NULL`` format string. For example::
 
-    res = WriteF(depth, stream,
+    res = WriteF(stream, depth,
                  "Hello: $A\n", address,
                  "Spong: $U ($S)\n", number, string,
                  NULL);
@@ -56,7 +56,7 @@ and so on, and finally a ``NULL`` format string. For example::
 
 This makes ``Describe()`` methods much easier to write. For example, ``BufferDescribe()`` contains the following code::
 
-    res = WriteF(depth, stream,
+    res = WriteF(stream, depth,
                  "Buffer $P ($U) {\n",
                  (WriteFP)buffer, (WriteFU)buffer->serial,
                  "  class $P (\"$S\")\n",
@@ -81,12 +81,6 @@ This makes ``Describe()`` methods much easier to write. For example, ``BufferDes
                  NULL);
     if (res != ResOK) return res;
 
-_`.indent`: ``WriteF()`` maintains the indentation of nested
-structures automatically. In a format string, ``{`` increases the
-indentation level by one, and ``}`` decreases it by one. Before
-emitting the first character on a line (but after updating the depth),
-``WriteF()`` emits the indentation whitespace for the current depth.
-
 _`.types`: For each format ``$X`` that ``WriteF()`` supports, there is a
 type defined in impl.h.mpmtypes ``WriteFX()`` which is the promoted
 version of that type. These are provided both to ensure promotion and

From f55b7d46758e9c8ebf2704a664a66c28927bc299 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 21:12:36 +0100
Subject: [PATCH 14/70] Fix bug in mrgdescribe: must be in the shield in order
 to call mrgrefpartref.

Copied from Perforce
 Change: 186009
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmrg.c | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index b0be22c66ef..2cb2f1fc95a 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -810,15 +810,22 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (stream == NULL) return ResFAIL;
 
   arena = PoolArena(pool);
-  res = WriteF(stream, depth, "  extendBy $W\n", mrg->extendBy, NULL);
+  res = WriteF(stream, depth, "extendBy $W\n", mrg->extendBy, NULL);
   if (res != ResOK) return res;
-  res = WriteF(stream, depth, "  Entry queue:\n", NULL);
+  res = WriteF(stream, depth, "Entry queue:\n", NULL);
   if (res != ResOK) return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
+    Bool outsideShield = !arena->insideShield;
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
-    res = WriteF(stream, depth, "    at $A Ref $A\n",
+    if (outsideShield) {
+      ShieldEnter(arena);
+    }
+    res = WriteF(stream, depth, "at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
+    if (outsideShield) {
+      ShieldLeave(arena);
+    }
     if (res != ResOK) return res;
   }
 

From 8a84937edbe024c15ca5145c59daf5cfa1a497e0 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 21:13:55 +0100
Subject: [PATCH 15/70] Improve formatting of poolgendescribe and
 tracedescribe.

Add ArenaDescribe calls to amcss and finalcv to get coverage of PoolGenDescribe, TraceDescribe, and MRGDescribe.

Copied from Perforce
 Change: 186010
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcss.c   |  6 ++++--
 mps/code/finalcv.c | 13 ++++++++-----
 mps/code/locus.c   | 10 +++++-----
 mps/code/trace.c   | 38 ++++++++++++++++++--------------------
 4 files changed, 35 insertions(+), 32 deletions(-)

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 1b50268e88a..3d6f8394ed5 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -164,6 +164,9 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
   /* create an ap, and leave it busy */
   die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
 
+  die(mps_arena_start_collect(arena), "mps_arena_start_collect");
+  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
+
   collections = 0;
   rampSwitch = rampSIZE;
   die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
@@ -275,9 +278,8 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
     ++objs;
   }
 
-  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "PoolDescribe");
-
   (void)mps_commit(busy_ap, busy_init, 64);
+  mps_arena_park(arena);
   mps_ap_destroy(busy_ap);
   mps_ap_destroy(ap);
   mps_root_destroy(exactRoot);
diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index 1466e514ff8..d8673972156 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -18,14 +18,15 @@
  * This code was created by first copying <code/weakcv.c>
  */
 
-#include "testlib.h"
-#include "mpslib.h"
-#include "mps.h"
-#include "mpscamc.h"
-#include "mpsavm.h"
 #include "fmtdy.h"
 #include "fmtdytst.h"
+#include "mpm.h"
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscamc.h"
+#include "mpslib.h"
 #include "mpstd.h"
+#include "testlib.h"
 
 #include <stdio.h> /* printf */
 
@@ -141,6 +142,8 @@ static void *test(void *arg, size_t s)
   }
   p = NULL;
 
+  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
+
   mps_message_type_enable(arena, mps_message_type_finalization());
 
   /* <design/poolmrg/#test.promise.ut.churn> */
diff --git a/mps/code/locus.c b/mps/code/locus.c
index 8b2716000c5..06fedac0473 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -516,13 +516,13 @@ Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
   
   res = WriteF(stream, depth,
                "PoolGen $P ($U) {\n", (WriteFP)pgen, (WriteFU)pgen->nr,
-               "pool $P ($U) \"$S\"\n",
+               "  pool $P ($U) \"$S\"\n",
                (WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
                (WriteFS)pgen->pool->class->name,
-               "chain $P\n", (WriteFP)pgen->chain,
-               "totalSize $U\n", (WriteFU)pgen->totalSize,
-               "newSize $U\n", (WriteFU)pgen->newSize,
-               "newSizeAtCreate $U\n", (WriteFU)pgen->newSizeAtCreate,
+               "  chain $P\n", (WriteFP)pgen->chain,
+               "  totalSize $U\n", (WriteFU)pgen->totalSize,
+               "  newSize $U\n", (WriteFU)pgen->newSize,
+               "  newSizeAtCreate $U\n", (WriteFU)pgen->newSizeAtCreate,
                "} PoolGen $P\n", (WriteFP)pgen,
                NULL);
   return res;
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 1312fa04b29..d072de98585 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1943,28 +1943,26 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth)
 
   res = WriteF(stream, depth,
                "Trace $P ($U) {\n", (WriteFP)trace, (WriteFU)trace->ti,
-               "arena $P ($U)\n", (WriteFP)trace->arena,
+               "  arena $P ($U)\n", (WriteFP)trace->arena,
                (WriteFU)trace->arena->serial,
-               "why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why),
-               "state $S\n", (WriteFS)state,
-               "band $U\n", (WriteFU)trace->band,
-               "white   $B\n", (WriteFB)trace->white,
-               "mayMove $B\n", (WriteFB)trace->mayMove,
-               "chain $P\n", (WriteFP)trace->chain,
-               "condemned $U\n", (WriteFU)trace->condemned,
-               "notCondemned $U\n", (WriteFU)trace->notCondemned,
-               "foundation $U\n", (WriteFU)trace->foundation,
-               "rate $U\n", (WriteFU)trace->rate,
-               "rootScanSize $U\n", (WriteFU)trace->rootScanSize,
-               "rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize,
-               "segScanSize $U\n", (WriteFU)trace->segScanSize,
-               "segCopiedSize $U\n", (WriteFU)trace->segCopiedSize,
-               "forwardedSize $U\n", (WriteFU)trace->forwardedSize,
-               "preservedInPlaceSize $U\n", (WriteFU)trace->preservedInPlaceSize,
+               "  why \"$S\"\n", (WriteFS)TraceStartWhyToString(trace->why),
+               "  state $S\n", (WriteFS)state,
+               "  band $U\n", (WriteFU)trace->band,
+               "  white   $B\n", (WriteFB)trace->white,
+               "  mayMove $B\n", (WriteFB)trace->mayMove,
+               "  chain $P\n", (WriteFP)trace->chain,
+               "  condemned $U\n", (WriteFU)trace->condemned,
+               "  notCondemned $U\n", (WriteFU)trace->notCondemned,
+               "  foundation $U\n", (WriteFU)trace->foundation,
+               "  rate $U\n", (WriteFU)trace->rate,
+               "  rootScanSize $U\n", (WriteFU)trace->rootScanSize,
+               "  rootCopiedSize $U\n", (WriteFU)trace->rootCopiedSize,
+               "  segScanSize $U\n", (WriteFU)trace->segScanSize,
+               "  segCopiedSize $U\n", (WriteFU)trace->segCopiedSize,
+               "  forwardedSize $U\n", (WriteFU)trace->forwardedSize,
+               "  preservedInPlaceSize $U\n", (WriteFU)trace->preservedInPlaceSize,
+               "} Trace $P\n", (WriteFP)trace,
                NULL);
-  if (res != ResOK) return res;
-
-  res = WriteF(stream, depth, "} Trace $P\n", (WriteFP)trace, NULL);
   return res;
 }
 

From a23ae370135af30813a42ca27e22a76916c5ddc2 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 21:37:09 +0100
Subject: [PATCH 16/70] Ensure coverage of tracedescribe.

Copied from Perforce
 Change: 186011
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcss.c | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 3d6f8394ed5..7bbbac61fe1 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -136,6 +136,7 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
   mps_ap_t busy_ap;
   mps_addr_t busy_init;
   mps_pool_t pool;
+  int described = 0; 
 
   die(dylan_fmt(&format, arena), "fmt_create");
   die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
@@ -164,9 +165,6 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
   /* create an ap, and leave it busy */
   die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
 
-  die(mps_arena_start_collect(arena), "mps_arena_start_collect");
-  die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
-
   collections = 0;
   rampSwitch = rampSIZE;
   die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
@@ -179,6 +177,10 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
 
     c = mps_collections(arena);
     if (collections != c) {
+      if (!described) {
+        die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
+        described = TRUE;
+      }
       collections = c;
       report(arena);
 

From d2aac4f6c2e12b92794c81c87bc0f7ab685684e3 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 21:41:34 +0100
Subject: [PATCH 17/70] Ensure coverage of rangedescribe.

Copied from Perforce
 Change: 186012
 ServerID: perforce.ravenbrook.com
---
 mps/code/nailboard.c | 19 +++++++++++--------
 mps/code/range.c     |  2 +-
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index f8104371efd..46fa3a2f582 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -413,17 +413,20 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream, depth,
-               "Nailboard $P\n{\n", (WriteFP)board,
-               "  base: $P\n", (WriteFP)RangeBase(&board->range),
-               "  limit: $P\n", (WriteFP)RangeLimit(&board->range),
-               "  levels: $U\n", (WriteFU)board->levels,
-               "  newNails: $S\n", board->newNails ? "TRUE" : "FALSE",
-               "  alignShift: $U\n", (WriteFU)board->alignShift,
-               NULL);
+  res = WriteF(stream, depth, "Nailboard $P {\n", (WriteFP)board, NULL);
   if (res != ResOK)
     return res;
 
+  res = RangeDescribe(&board->range, stream, depth + 2);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
+               "levels: $U\n", (WriteFU)board->levels,
+               "newNails: $S\n", board->newNails ? "TRUE" : "FALSE",
+               "alignShift: $U\n", (WriteFU)board->alignShift,
+               NULL);
+
   for(i = 0; i < board->levels; ++i) {
     Count levelNails = nailboardLevelBits(nailboardNails(board), i);
     Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
diff --git a/mps/code/range.c b/mps/code/range.c
index 222e335f95b..6faf1d254f4 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -47,7 +47,7 @@ Res RangeDescribe(Range range, mps_lib_FILE *stream, Count depth)
   AVER(stream != NULL);
 
   res = WriteF(stream, depth,
-               "Range $P\n{\n", (WriteFP)range,
+               "Range $P {\n", (WriteFP)range,
                "  base: $P\n", (WriteFP)RangeBase(range),
                "  limit: $P\n", (WriteFP)RangeLimit(range),
                "  size: $U\n", (WriteFU)RangeSize(range),

From 7c7203ef70c0c4e3ea9bea85b22d3c97286b575e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 22:08:29 +0100
Subject: [PATCH 18/70] Reduce size of nursery to make it more likely that we
 get a collection.

Copied from Perforce
 Change: 186015
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcss.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 7bbbac61fe1..593bb6f7e5a 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -21,7 +21,7 @@
 
 /* These values have been tuned in the hope of getting one dynamic collection. */
 #define testArenaSIZE     ((size_t)1000*1024)
-#define gen1SIZE          ((size_t)150)
+#define gen1SIZE          ((size_t)40)
 #define gen2SIZE          ((size_t)170)
 #define avLEN             3
 #define exactRootsCOUNT   180

From 848a289cbc0130f7e170158148af45b87af23fb3 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 11 May 2014 22:17:39 +0100
Subject: [PATCH 19/70] Ensure coverage of mvffdescribe.

Copied from Perforce
 Change: 186016
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpmss.c | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 339ae5b54f4..b46043ef153 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -5,14 +5,15 @@
  * Portions copyright (C) 2002 Global Graphics Software.
  */
 
+#include "mpm.h"
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscmfs.h"
 #include "mpscmv.h"
 #include "mpscmvff.h"
-#include "mpscmfs.h"
 #include "mpslib.h"
-#include "mpsavm.h"
+#include "mpslib.h"
 #include "testlib.h"
-#include "mpslib.h"
-#include "mps.h"
 
 #include <stdio.h> /* printf */
 
@@ -81,6 +82,7 @@ static mps_res_t stress(mps_class_t class, size_t (*size)(size_t i),
     }
   }
    
+  die(PoolDescribe(pool, mps_lib_get_stdout(), 0), "PoolDescribe");
   mps_pool_destroy(pool);
 
   return MPS_RES_OK;

From b953ee2432df37064833666ad1690fa002f441fd Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 17:21:25 +0100
Subject: [PATCH 20/70] Document mps_key_spare keyword argument.

Copied from Perforce
 Change: 186085
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/pool/mvff.rst     | 6 ++++++
 mps/manual/source/topic/keyword.rst | 1 +
 2 files changed, 7 insertions(+)

diff --git a/mps/manual/source/pool/mvff.rst b/mps/manual/source/pool/mvff.rst
index e688a00d09d..149d533d2d0 100644
--- a/mps/manual/source/pool/mvff.rst
+++ b/mps/manual/source/pool/mvff.rst
@@ -132,6 +132,12 @@ MVFF interface
       The minimum alignment supported by pools of this class is
       ``sizeof(void *)``.
 
+    * :c:macro:`MPS_KEY_SPARE` (type :c:type:`double`, default 0.75)
+      is the maximum proportion of freed memory that the pool will
+      keep spare for future allocations. If the proportion of memory
+      that's free exceeds this, then the pool will return some of it
+      to the arena for use by other pools.
+
     * :c:macro:`MPS_KEY_MVFF_ARENA_HIGH` (type :c:type:`mps_bool_t`,
       default false) determines whether new segments are acquired at high
       addresses (if true), or at low addresses (if false).
diff --git a/mps/manual/source/topic/keyword.rst b/mps/manual/source/topic/keyword.rst
index 3b3fbcb01ad..bca0d471121 100644
--- a/mps/manual/source/topic/keyword.rst
+++ b/mps/manual/source/topic/keyword.rst
@@ -115,6 +115,7 @@ now :c:macro:`MPS_KEY_ARGS_END`.
     :c:macro:`MPS_KEY_MVT_RESERVE_DEPTH`     :c:type:`mps_count_t`           ``count``              :c:func:`mps_class_mvt`
     :c:macro:`MPS_KEY_POOL_DEBUG_OPTIONS`    ``mps_pool_debug_options_s *``  ``pool_debug_options`` :c:func:`mps_class_ams_debug`, :c:func:`mps_class_mv_debug`, :c:func:`mps_class_mvff_debug`
     :c:macro:`MPS_KEY_RANK`                  :c:type:`mps_rank_t`            ``rank``               :c:func:`mps_class_ams`, :c:func:`mps_class_awl`, :c:func:`mps_class_snc`
+    :c:macro:`MPS_KEY_SPARE`                 :c:type:`double`                  ``d``                :c:func:`mps_class_mvff`
     :c:macro:`MPS_KEY_VMW3_TOP_DOWN`         :c:type:`mps_bool_t`            ``b``                  :c:func:`mps_arena_class_vm`
     ======================================== ====================================================== ==========================================================
 

From 56179ec206828b1418b11c6c27a99957e3ed8770 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 17:31:43 +0100
Subject: [PATCH 21/70] Update release notes.

Copied from Perforce
 Change: 186087
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/pool/mvff.rst | 8 ++++----
 mps/manual/source/release.rst   | 7 +++++++
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/mps/manual/source/pool/mvff.rst b/mps/manual/source/pool/mvff.rst
index 149d533d2d0..64c220e9506 100644
--- a/mps/manual/source/pool/mvff.rst
+++ b/mps/manual/source/pool/mvff.rst
@@ -133,10 +133,10 @@ MVFF interface
       ``sizeof(void *)``.
 
     * :c:macro:`MPS_KEY_SPARE` (type :c:type:`double`, default 0.75)
-      is the maximum proportion of freed memory that the pool will
-      keep spare for future allocations. If the proportion of memory
-      that's free exceeds this, then the pool will return some of it
-      to the arena for use by other pools.
+      is the maximum proportion of memory that the pool will keep
+      spare for future allocations. If the proportion of memory that's
+      free exceeds this, then the pool will return some of it to the
+      arena for use by other pools.
 
     * :c:macro:`MPS_KEY_MVFF_ARENA_HIGH` (type :c:type:`mps_bool_t`,
       default false) determines whether new segments are acquired at high
diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index 0ac53f9020a..21d6ca6c13e 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -54,6 +54,10 @@ Interface changes
    the value ``FALSE`` is appropriate only when you know that all
    references are exact. See :ref:`pool-ams`.
 
+#. The :ref:`pool-mvff` pool class takes a new keyword argument
+   :c:macro:`MPS_KEY_SPARE`. This specifies the maximum proportion of
+   memory that the pool will keep spare for future allocations.
+
 
 Other changes
 .............
@@ -90,6 +94,9 @@ Other changes
 
    .. _job003771: https://www.ravenbrook.com/project/mps/issue/job003771/
 
+#. The :ref:`pool-mvt` and :ref:`pool-mvff` pool classes are now
+   around 25% faster (in our benchmarks) than they were in release
+   1.113.0.
 
 
 .. _release-notes-1.113:

From af4cf5fb060c7f52ad5a6aef720f05eefa694f06 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 17:37:48 +0100
Subject: [PATCH 22/70] Delete files accidentally branched from
 branch/2014-02-23/mvff-tune.

Copied from Perforce
 Change: 186088
 ServerID: perforce.ravenbrook.com
---
 mps/code/spw3i3mv.c |  66 ---------------------------
 mps/code/spw3i6mv.c |  67 ---------------------------
 mps/tool/gcovfmt.py | 109 --------------------------------------------
 3 files changed, 242 deletions(-)
 delete mode 100644 mps/code/spw3i3mv.c
 delete mode 100644 mps/code/spw3i6mv.c
 delete mode 100755 mps/tool/gcovfmt.py

diff --git a/mps/code/spw3i3mv.c b/mps/code/spw3i3mv.c
deleted file mode 100644
index 3bb8ce94d0f..00000000000
--- a/mps/code/spw3i3mv.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/* spw3i3mv.c: STACK PROBE FOR 32-BIT WINDOWS
- *
- * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
- * Portions copyright (C) 2001 Global Graphics Software.
- *
- * This function reads a location that is depth words beyond the
- * current stack pointer. On Intel platforms, the stack grows
- * downwards, so this means reading from a location with a lesser
- * address.
- */
-
-
-#include "mpm.h"
-
-
-void StackProbe(Size depth)
-{
-  __asm {
-    mov  eax, depth
-    neg  eax
-    mov  eax, [esp+eax*4] /* do the actual probe */
-  }
-}
-
-
-/* C. COPYRIGHT AND LICENSE
- *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
- * All rights reserved.  This is an open source license.  Contact
- * Ravenbrook for commercial licensing options.
- * 
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- * 
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- * 
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- * 
- * 3. Redistributions in any form must be accompanied by information on how
- * to obtain complete source code for this software and any accompanying
- * software that uses this software.  The source code must either be
- * included in the distribution or be available for no more than the cost
- * of distribution plus a nominal fee, and must be freely redistributable
- * under reasonable conditions.  For an executable file, complete source
- * code means the source code for all modules it contains. It does not
- * include source code for modules or files that typically accompany the
- * major components of the operating system on which the executable file
- * runs.
- * 
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
- * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
- * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
- * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
diff --git a/mps/code/spw3i6mv.c b/mps/code/spw3i6mv.c
deleted file mode 100644
index 751e9680e4b..00000000000
--- a/mps/code/spw3i6mv.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/* spw3i6mv.c: STACK PROBE FOR 64-BIT WINDOWS
- *
- * $Id$
- * Copyright (c) 2013 Ravenbrook Limited.  See end of file for license.
- *
- * The function StackProbe ensures that the stack has at least depth
- * words available. It achieves this by exploiting an obscure but
- * documented feature of Microsoft's function _alloca: "A stack
- * overflow exception is generated if the space cannot be allocated."
- * _alloca: http://msdn.microsoft.com/en-us/library/wb1s57t5.aspx
- *
- * The purpose of this function to ensure that the stack overflow
- * exception is generated here (before taking the arena lock) where it
- * can be handled safely rather than at some later point where the
- * arena lock is held and so handling the exception may cause the MPS
- * to be entered recursively.
- */
-
-#include "mpm.h"
-#include <malloc.h>
-
-void StackProbe(Size depth)
-{
-  _alloca(depth*sizeof(Word));
-}
-
-
-/* C. COPYRIGHT AND LICENSE
- *
- * Copyright (C) 2013 Ravenbrook Limited <http://www.ravenbrook.com/>.
- * All rights reserved.  This is an open source license.  Contact
- * Ravenbrook for commercial licensing options.
- * 
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are
- * met:
- * 
- * 1. Redistributions of source code must retain the above copyright
- * notice, this list of conditions and the following disclaimer.
- * 
- * 2. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- * 
- * 3. Redistributions in any form must be accompanied by information on how
- * to obtain complete source code for this software and any accompanying
- * software that uses this software.  The source code must either be
- * included in the distribution or be available for no more than the cost
- * of distribution plus a nominal fee, and must be freely redistributable
- * under reasonable conditions.  For an executable file, complete source
- * code means the source code for all modules it contains. It does not
- * include source code for modules or files that typically accompany the
- * major components of the operating system on which the executable file
- * runs.
- * 
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
- * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
- * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
- * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
- * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
- * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
diff --git a/mps/tool/gcovfmt.py b/mps/tool/gcovfmt.py
deleted file mode 100755
index 0f17bd0a353..00000000000
--- a/mps/tool/gcovfmt.py
+++ /dev/null
@@ -1,109 +0,0 @@
-#!/usr/bin/python
-# 
-# $Id$
-# Copyright (c) 2013 Ravenbrook Limited. See end of file for license.
-# 
-# This program takes the output of gcov on standard input and writes a
-# human-readable table with a summary, to the file named on the
-# command line (or standard output if none is given). The summary line
-# is always written to standard output so that in the context of "make
-# test" where the detailed test output is being directed to a test log
-# file, the coverage summary can still be presented.
-# 
-# gcov output looks like this:
-# 
-#     File '/project/mps/master/code/mpsi.c'
-#     Lines executed:85.12% of 921
-#     /project/mps/master/code/mpsi.c:creating 'mpsi.c.gcov'
-# 
-# Note that we select only the .c files (there may also be output for
-# system files like signal.h with inline function definitions, and we
-# are not interested in covering them). The MPS has no inline function
-# definitions in headers.
-
-from sys import argv, stdin, stdout
-from re import match
-
-def coverage():
-    """For each .c file with coverage data, generate a triple (percent
-    coverage, file name, number of lines).
-
-    """
-    for line in stdin:
-        m1 = match(r"File '.*/([^/]+\.c)'$", line)
-        if not m1:
-            continue
-        m2 = match(r"Lines executed:(\d[0-9.]*)% of (\d+)$", next(stdin))
-        if m2:
-            yield float(m2.group(1)), m1.group(1), int(m2.group(2))
-
-def main():
-    if len(argv) >= 2:
-        out = open(argv[1], 'a')
-    else:
-        out = stdout
-    fmt1 = "{0:<16s} {1:<7s} {2:<7s} {3:<7s}\n"
-    fmt2 = "{0:<16s} {1:7d} {2:7d} {3:6.2f}%\n"
-    underlines = "---------------- ------- ------- -------".split()
-    out.write(fmt1.format(*"File Lines Covered Percent".split()))
-    out.write(fmt1.format(*underlines))
-    total_lines, total_covered = 0, 0
-    for percent, file, lines in sorted(coverage()):
-        covered = int(round(lines * percent / 100))
-        total_lines += lines
-        total_covered += covered
-        out.write(fmt2.format(file, lines, covered, percent))
-    out.write(fmt1.format(*underlines))
-    if total_lines == 0:
-        total_percent = 100.0
-    else:
-        total_percent = 100.0 * total_covered / total_lines
-    summary = fmt2.format("COVERAGE TOTAL", total_lines, total_covered,
-                          total_percent)
-    out.write(summary)
-    if out != stdout:
-        stdout.write(summary)
-
-if __name__ == '__main__':
-    main()
-
-
-# C. COPYRIGHT AND LICENSE
-#
-# Copyright (C) 2013 Ravenbrook Limited <http://www.ravenbrook.com/>.
-# All rights reserved.  This is an open source license.  Contact
-# Ravenbrook for commercial licensing options.
-# 
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-# 
-# 1. Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-# 
-# 2. Redistributions in binary form must reproduce the above copyright
-# notice, this list of conditions and the following disclaimer in the
-# documentation and/or other materials provided with the distribution.
-# 
-# 3. Redistributions in any form must be accompanied by information on how
-# to obtain complete source code for this software and any accompanying
-# software that uses this software.  The source code must either be
-# included in the distribution or be available for no more than the cost
-# of distribution plus a nominal fee, and must be freely redistributable
-# under reasonable conditions.  For an executable file, complete source
-# code means the source code for all modules it contains. It does not
-# include source code for modules or files that typically accompany the
-# major components of the operating system on which the executable file
-# runs.
-# 
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
-# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
-# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
-# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
-# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

From 9b98c26ff3c7bda4c6c426c8b11b5736d90fe034 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 17:49:35 +0100
Subject: [PATCH 23/70] Describe the block pool.

Copied from Perforce
 Change: 186091
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index b874fbec340..2363ea3a772 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -650,22 +650,21 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
                "  firstFit  $U\n",  (WriteFU)mvff->firstFit,
                "  slotHigh  $U\n",  (WriteFU)mvff->slotHigh,
                NULL);
-  if (res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
   /* TODO: SegPrefDescribe(MVFFSegPref(mvff), stream); */
 
+  res = PoolDescribe(MVFFBlockPool(mvff), stream);
+  if (res != ResOK) return res;
+
   res = LandDescribe(MVFFTotalCBS(mvff), stream);
-  if (res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
   res = LandDescribe(MVFFFreeCBS(mvff), stream);
-  if (res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
   res = LandDescribe(MVFFFreelist(mvff), stream);
-  if (res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
   res = WriteF(stream, "}\n", NULL);
   return res;

From 6980f345f1705c38a219180d99e4ffdcd632c4ed Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 18:04:59 +0100
Subject: [PATCH 24/70] Add note about potential for speed improvement, as
 requested by rb.

Copied from Perforce
 Change: 186093
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 2363ea3a772..c3e18df5aec 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -10,11 +10,16 @@
  *
  * .design: <design/poolmvff>
  *
- *
  * TRANSGRESSIONS
  *
  * .trans.stat: mps_mvff_stat is a temporary hack for measurement purposes,
  * see .stat below.
+ *
+ * NOTE
+ *
+ * There's potential for up to 4% speed improvement by calling Land
+ * methods statically instead of indirectly via the Land abstraction
+ * (thus, cbsInsert instead of LandInsert, and so on).
  */
 
 #include "cbs.h"

From 32f87cbdc16a1ca99556918141f44f7dac0e21de Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 13 May 2014 22:10:04 +0100
Subject: [PATCH 25/70] Fix formatting of table.

Copied from Perforce
 Change: 186097
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/topic/keyword.rst | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mps/manual/source/topic/keyword.rst b/mps/manual/source/topic/keyword.rst
index bca0d471121..459f703e35f 100644
--- a/mps/manual/source/topic/keyword.rst
+++ b/mps/manual/source/topic/keyword.rst
@@ -115,7 +115,7 @@ now :c:macro:`MPS_KEY_ARGS_END`.
     :c:macro:`MPS_KEY_MVT_RESERVE_DEPTH`     :c:type:`mps_count_t`           ``count``              :c:func:`mps_class_mvt`
     :c:macro:`MPS_KEY_POOL_DEBUG_OPTIONS`    ``mps_pool_debug_options_s *``  ``pool_debug_options`` :c:func:`mps_class_ams_debug`, :c:func:`mps_class_mv_debug`, :c:func:`mps_class_mvff_debug`
     :c:macro:`MPS_KEY_RANK`                  :c:type:`mps_rank_t`            ``rank``               :c:func:`mps_class_ams`, :c:func:`mps_class_awl`, :c:func:`mps_class_snc`
-    :c:macro:`MPS_KEY_SPARE`                 :c:type:`double`                  ``d``                :c:func:`mps_class_mvff`
+    :c:macro:`MPS_KEY_SPARE`                 :c:type:`double`                ``d``                  :c:func:`mps_class_mvff`
     :c:macro:`MPS_KEY_VMW3_TOP_DOWN`         :c:type:`mps_bool_t`            ``b``                  :c:func:`mps_arena_class_vm`
     ======================================== ====================================================== ==========================================================
 

From 2d51f793532c5292b47ecbaa95da5ec50c6bc397 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 15 May 2014 10:09:14 +0100
Subject: [PATCH 26/70] Branching master to branch/2014-05-15/size.

Copied from Perforce
 Change: 186108
 ServerID: perforce.ravenbrook.com

From c72b7b9310b9131b13b967fec1cee139844706c2 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 15 May 2014 10:22:57 +0100
Subject: [PATCH 27/70] Fumbled the merge.

Copied from Perforce
 Change: 186113
 ServerID: perforce.ravenbrook.com
---
 mps/code/poollo.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index e022963c14b..06d3e68160f 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -189,7 +189,7 @@ static void loSegFinish(Seg seg)
 
 
 ATTRIBUTE_UNUSED
-static Count loSegBits(LOSeg loseg)
+static Count loSegGrains(LOSeg loseg)
 {
   LO lo;
   Size size;

From 981a2666428037529142e5f906266a30fd68d410 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 15 May 2014 17:01:59 +0100
Subject: [PATCH 28/70] New public functions mps_pool_total_size and
 mps_pool_free_size.

Old (undocumented) functions mps_{mv,mvff,mvt}_size and mps_{mv,mvff,mvt}_free_size are now macros for the new public functions.
New pool methods PoolTotalSize and PoolFreeSize, with implementations for public pool classes except SNC.
Coverage of the new functions in apss and mpmss for the manual pool classes, and in finaltest for the automatic pool classes.

Copied from Perforce
 Change: 186118
 ServerID: perforce.ravenbrook.com
---
 mps/code/apss.c                  |  39 ++++++---
 mps/code/finaltest.c             |  17 ++--
 mps/code/mpm.h                   |   4 +
 mps/code/mpmss.c                 |  43 +++++++---
 mps/code/mpmst.h                 |   6 +-
 mps/code/mpmtypes.h              |   1 +
 mps/code/mps.h                   |   8 ++
 mps/code/mpscmv.h                |   4 +-
 mps/code/mpscmvff.h              |   4 +-
 mps/code/mpscmvt.h               |  10 ++-
 mps/code/mpsi.c                  |  34 ++++++++
 mps/code/pool.c                  |  22 +++++
 mps/code/poolabs.c               |  10 +++
 mps/code/poolamc.c               |  46 ++++++++++
 mps/code/poolams.c               |  30 +++++++
 mps/code/poolawl.c               |  30 +++++++
 mps/code/poollo.c                |  30 +++++++
 mps/code/poolmfs.c               |  40 +++++++++
 mps/code/poolmv.c                | 139 +++++++++++++++----------------
 mps/code/poolmv2.c               |  70 +++++++---------
 mps/code/poolmvff.c              |  61 +++++++-------
 mps/code/poolsnc.c               |   3 -
 mps/manual/source/release.rst    |   3 +
 mps/manual/source/topic/pool.rst |  25 ++++++
 24 files changed, 500 insertions(+), 179 deletions(-)

diff --git a/mps/code/apss.c b/mps/code/apss.c
index 81edbe7d04d..cdf88cee43f 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -41,9 +41,21 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 }
 
 
+/* check_allocated_size -- check the allocated size of the pool */
+
+static void check_allocated_size(mps_pool_t pool, mps_ap_t ap, size_t allocated)
+{
+  size_t total = mps_pool_total_size(pool);
+  size_t free = mps_pool_free_size(pool);
+  size_t ap_free = (size_t)((char *)ap->limit - (char *)ap->init);
+  Insist(total - free == allocated + ap_free);
+}
+
+
 /* stress -- create a pool of the requested type and allocate in it */
 
-static mps_res_t stress(mps_arena_t arena, mps_align_t align,
+static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
+                        mps_align_t align,
                         size_t (*size)(size_t i, mps_align_t align),
                         const char *name, mps_class_t class, mps_arg_s args[])
 {
@@ -53,6 +65,8 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
   size_t i, k;
   int *ps[testSetSIZE];
   size_t ss[testSetSIZE];
+  size_t allocated = 0;         /* Total allocated memory */
+  size_t debugOverhead = options ? 2 * alignUp(options->fence_size, align) : 0;
 
   printf("stress %s\n", name);
 
@@ -66,8 +80,10 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
     res = make((mps_addr_t *)&ps[i], ap, ss[i]);
     if (res != MPS_RES_OK)
       goto allocFail;
+    allocated += ss[i] + debugOverhead;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
+    check_allocated_size(pool, ap, allocated);
   }
 
   mps_pool_check_fenceposts(pool);
@@ -90,6 +106,8 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
       mps_free(pool, (mps_addr_t)ps[i], ss[i]);
       /* if (i == testSetSIZE/2) */
       /*   PoolDescribe((Pool)pool, mps_lib_stdout); */
+      Insist(ss[i] + debugOverhead <= allocated);
+      allocated -= ss[i] + debugOverhead;
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
@@ -97,7 +115,9 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
       res = make((mps_addr_t *)&ps[i], ap, ss[i]);
       if (res != MPS_RES_OK)
         goto allocFail;
+      allocated += ss[i] + debugOverhead;
     }
+    check_allocated_size(pool, ap, allocated);
   }
 
 allocFail:
@@ -145,8 +165,8 @@ static void testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
-    die(stress(arena, align, randomSizeAligned, "MVFF", mps_class_mvff(), args),
-        "stress MVFF");
+    die(stress(arena, NULL, align, randomSizeAligned, "MVFF",
+               mps_class_mvff(), args), "stress MVFF");
   } MPS_ARGS_END(args);
 
   /* IWBN to test MVFFDebug, but the MPS doesn't support debugging APs, */
@@ -155,24 +175,23 @@ static void testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
   MPS_ARGS_BEGIN(args) {
     mps_align_t align = 1 << (rnd() % 6);
     MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
-    die(stress(arena, align, randomSizeAligned, "MV", mps_class_mv(), args),
-        "stress MV");
+    die(stress(arena, NULL, align, randomSizeAligned, "MV",
+               mps_class_mv(), args), "stress MV");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
     mps_align_t align = 1 << (rnd() % 6);
     MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
     MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
-    die(stress(arena, align, randomSizeAligned, "MV debug",
-               mps_class_mv_debug(), args),
-        "stress MV debug");
+    die(stress(arena, options, align, randomSizeAligned, "MV debug",
+               mps_class_mv_debug(), args), "stress MV debug");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
     mps_align_t align = sizeof(void *) << (rnd() % 4);
     MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
-    die(stress(arena, align, randomSizeAligned, "MVT", mps_class_mvt(), args),
-        "stress MVT");
+    die(stress(arena, NULL, align, randomSizeAligned, "MVT",
+               mps_class_mvt(), args), "stress MVT");
   } MPS_ARGS_END(args);
 }
 
diff --git a/mps/code/finaltest.c b/mps/code/finaltest.c
index 2e36c31ee10..da04a38c7ba 100644
--- a/mps/code/finaltest.c
+++ b/mps/code/finaltest.c
@@ -147,7 +147,7 @@ static mps_addr_t test_awl_find_dependent(mps_addr_t addr)
 static void *root[rootCOUNT];
 
 static void test_trees(int mode, const char *name, mps_arena_t arena,
-                       mps_ap_t ap,
+                       mps_pool_t pool, mps_ap_t ap,
                        mps_word_t (*make)(mps_word_t, mps_ap_t),
                        void (*reg)(mps_word_t, mps_arena_t))
 {
@@ -158,7 +158,9 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
 
   object_count = 0;
 
-  printf("Making some %s finalized trees of objects.\n", name);
+  printf("---- Mode %s, pool class %s, %s trees ----\n",
+         mode == ModePARK ? "PARK" : "POLL",
+         pool->class->name, name);
   mps_arena_park(arena);
 
   /* make some trees */
@@ -167,7 +169,6 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
     (*reg)((mps_word_t)root[i], arena);
   }
 
-  printf("Losing all pointers to the trees.\n");
   /* clean out the roots */
   for(i = 0; i < rootCOUNT; ++i) {
     root[i] = 0;
@@ -190,9 +191,15 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
       object_alloc = 0;
       while (object_alloc < 1000 && !mps_message_poll(arena))
         (void)DYLAN_INT(object_alloc++);
+      printf(" Done.\n");
       break;
     }
     ++ collections;
+    {
+      size_t live_size = (object_count - finals) * sizeof(void *) * 3;
+      size_t alloc_size = mps_pool_total_size(pool) - mps_pool_free_size(pool);
+      Insist(live_size <= alloc_size);
+    }
     while (mps_message_poll(arena)) {
       mps_message_t message;
       mps_addr_t objaddr;
@@ -238,9 +245,9 @@ static void test_pool(int mode, mps_arena_t arena, mps_chain_t chain,
       "root_create\n");
   die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create\n");
 
-  test_trees(mode, "numbered", arena, ap, make_numbered_tree,
+  test_trees(mode, "numbered", arena, pool, ap, make_numbered_tree,
              register_numbered_tree);
-  test_trees(mode, "indirect", arena, ap, make_indirect_tree,
+  test_trees(mode, "indirect", arena, pool, ap, make_indirect_tree,
              register_indirect_tree);
 
   mps_ap_destroy(ap);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index e141edb2bc5..533d99e462f 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -222,6 +222,9 @@ extern Res PoolAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr);
 extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
                      void *v, size_t s);
 extern void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p);
+extern Size PoolTotalSize(Pool pool);
+extern Size PoolFreeSize(Pool pool);
+
 extern Res PoolTrivInit(Pool pool, ArgList arg);
 extern void PoolTrivFinish(Pool pool);
 extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size,
@@ -275,6 +278,7 @@ extern void PoolNoWalk(Pool pool, Seg seg, FormattedObjectsStepMethod step,
 extern void PoolTrivFreeWalk(Pool pool, FreeBlockStepMethod f, void *p);
 extern PoolDebugMixin PoolNoDebugMixin(Pool pool);
 extern BufferClass PoolNoBufferClass(void);
+extern Size PoolNoSize(Pool pool);
 
 #define ClassOfPool(pool) ((pool)->class)
 #define SuperclassOfPool(pool) \
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index a2019bca0f5..6c61b6a9ad8 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -23,9 +23,20 @@
 #define testLOOPS 10
 
 
+/* check_allocated_size -- check the allocated size of the pool */
+
+static void check_allocated_size(mps_pool_t pool, size_t allocated)
+{
+  size_t total = mps_pool_total_size(pool);
+  size_t free = mps_pool_free_size(pool);
+  Insist(total - free == allocated);
+}
+
+
 /* stress -- create a pool of the requested type and allocate in it */
 
-static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i),
+static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
+                        size_t (*size)(size_t i), mps_align_t align,
                         const char *name, mps_class_t pool_class,
                         mps_arg_s *args)
 {
@@ -34,8 +45,10 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i),
   size_t i, k;
   int *ps[testSetSIZE];
   size_t ss[testSetSIZE];
+  size_t allocated = 0;         /* Total allocated memory */
+  size_t debugOverhead = options ? 2 * alignUp(options->fence_size, align) : 0;
 
-  printf("%s\n", name);
+  printf("Pool class %s, alignment %u\n", name, (unsigned)align);
 
   res = mps_pool_create_k(&pool, arena, pool_class, args);
   if (res != MPS_RES_OK)
@@ -48,8 +61,10 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i),
     res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
     if (res != MPS_RES_OK)
       return res;
+    allocated += alignUp(ss[i], align) + debugOverhead;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
+    check_allocated_size(pool, allocated);
   }
 
   mps_pool_check_fenceposts(pool);
@@ -72,13 +87,17 @@ static mps_res_t stress(mps_arena_t arena, size_t (*size)(size_t i),
       mps_free(pool, (mps_addr_t)ps[i], ss[i]);
       /* if (i == testSetSIZE/2) */
       /*   PoolDescribe((Pool)pool, mps_lib_stdout); */
+      Insist(alignUp(ss[i], align) + debugOverhead <= allocated);
+      allocated -= alignUp(ss[i], align) + debugOverhead;
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
       ss[i] = (*size)(i);
       res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
       if (res != MPS_RES_OK) return res;
+      allocated += alignUp(ss[i], align) + debugOverhead;
     }
+    check_allocated_size(pool, allocated);
   }
    
   mps_pool_destroy(pool);
@@ -150,8 +169,8 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
-    die(stress(arena, randomSize8, "MVFF", mps_class_mvff(), args),
-        "stress MVFF");
+    die(stress(arena, NULL, randomSize8, align, "MVFF",
+               mps_class_mvff(), args), "stress MVFF");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
@@ -161,31 +180,31 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
     MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
-    die(stress(arena, randomSize8, "MVFF debug", mps_class_mvff_debug(), args),
-        "stress MVFF debug");
+    die(stress(arena, options, randomSize8, align, "MVFF debug",
+               mps_class_mvff_debug(), args), "stress MVFF debug");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
     mps_align_t align = 1 << (rnd() % 6);
     MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
-    die(stress(arena, randomSize, "MV", mps_class_mv(), args),
-        "stress MV");
+    die(stress(arena, NULL, randomSize, align, "MV",
+               mps_class_mv(), args), "stress MV");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
     mps_align_t align = 1 << (rnd() % 6);
     MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
     MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
-    die(stress(arena, randomSize, "MV debug", mps_class_mv_debug(), args),
-        "stress MV debug");
+    die(stress(arena, options, randomSize, align, "MV debug",
+               mps_class_mv_debug(), args), "stress MV debug");
   } MPS_ARGS_END(args);
 
   MPS_ARGS_BEGIN(args) {
     fixedSizeSize = 1 + rnd() % 64;
     MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, fixedSizeSize);
     MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, 100000);
-    die(stress(arena, fixedSize, "MFS", mps_class_mfs(), args),
-      "stress MFS");
+    die(stress(arena, NULL, fixedSize, MPS_PF_ALIGN, "MFS",
+               mps_class_mfs(), args), "stress MFS");
   } MPS_ARGS_END(args);
 
   mps_arena_destroy(arena);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 8ce4d14f01a..468e2ec866e 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -81,6 +81,8 @@ typedef struct mps_class_s {
   PoolBufferClassMethod bufferClass; /* default BufferClass of pool */
   PoolDescribeMethod describe;  /* describe the contents of the pool */
   PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */
+  PoolSizeMethod totalSize;     /* total memory allocated from arena */
+  PoolSizeMethod freeSize;      /* free memory (unused by client program) */
   Bool labelled;                /* whether it has been EventLabelled */
   Sig sig;                      /* .class.end-sig */
 } PoolClassStruct;
@@ -136,6 +138,8 @@ typedef struct MFSStruct {      /* MFS outer structure */
   Bool extendSelf;              /* whether to allocate tracts */
   Size unitSize;                /* rounded for management purposes */
   struct MFSHeaderStruct *freeList; /* head of the free list */
+  Size total;                   /* total size allocated from arena */
+  Size free;                    /* free space in pool */
   Tract tractList;              /* the first tract */
   Sig sig;                      /* <design/sig/> */
 } MFSStruct;
@@ -158,7 +162,7 @@ typedef struct MVStruct {       /* MV pool outer structure */
   Size extendBy;                /* segment size to extend pool by */
   Size avgSize;                 /* client estimate of allocation size */
   Size maxSize;                 /* client estimate of maximum size */
-  Size space;                   /* total free space in pool */
+  Size free;                    /* free space in pool */
   Size lost;                    /* <design/poolmv/#lost> */
   RingStruct spans;             /* span chain */
   Sig sig;                      /* <design/sig/> */
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 04f73a7e42d..8bee48e202e 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -237,6 +237,7 @@ typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockStepMethod f, void *p);
 typedef BufferClass (*PoolBufferClassMethod)(void);
 typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream);
 typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool);
+typedef Size (*PoolSizeMethod)(Pool pool);
 
 
 /* Messages
diff --git a/mps/code/mps.h b/mps/code/mps.h
index f927ea48b30..46b9e8d81dc 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -472,6 +472,11 @@ extern mps_res_t mps_pool_create_v(mps_pool_t *, mps_arena_t,
 extern mps_res_t mps_pool_create_k(mps_pool_t *, mps_arena_t,
                                    mps_class_t, mps_arg_s []);
 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);
+
+
+/* Chains */
 
 /* .gen-param: This structure must match <code/chain.h#gen-param>. */
 typedef struct mps_gen_param_s {
@@ -483,6 +488,9 @@ extern mps_res_t mps_chain_create(mps_chain_t *, mps_arena_t,
                                   size_t, mps_gen_param_s *);
 extern void mps_chain_destroy(mps_chain_t);
 
+
+/* Manual Allocation */
+
 extern mps_res_t mps_alloc(mps_addr_t *, mps_pool_t, size_t);
 extern mps_res_t mps_alloc_v(mps_addr_t *, mps_pool_t, size_t, va_list);
 extern void mps_free(mps_pool_t, mps_addr_t, size_t);
diff --git a/mps/code/mpscmv.h b/mps/code/mpscmv.h
index 805db19b8af..aeb163aec4a 100644
--- a/mps/code/mpscmv.h
+++ b/mps/code/mpscmv.h
@@ -9,8 +9,8 @@
 
 #include "mps.h"
 
-extern size_t mps_mv_free_size(mps_pool_t mps_pool);
-extern size_t mps_mv_size(mps_pool_t mps_pool);
+#define mps_mv_free_size(pool) (mps_pool_free_size(pool))
+#define mps_mv_size(pool) (mps_pool_total_size(pool))
 extern mps_class_t mps_class_mv(void);
 extern mps_class_t mps_class_mv_debug(void);
 
diff --git a/mps/code/mpscmvff.h b/mps/code/mpscmvff.h
index f8bc97b7f3b..ec1eb22eff9 100644
--- a/mps/code/mpscmvff.h
+++ b/mps/code/mpscmvff.h
@@ -19,8 +19,8 @@ extern const struct mps_key_s _mps_key_mvff_first_fit;
 #define MPS_KEY_MVFF_FIRST_FIT (&_mps_key_mvff_first_fit)
 #define MPS_KEY_MVFF_FIRST_FIT_FIELD b
 
-extern size_t mps_mvff_free_size(mps_pool_t mps_pool);
-extern size_t mps_mvff_size(mps_pool_t mps_pool);
+#define mps_mvff_free_size(pool) (mps_pool_free_size(pool))
+#define mps_mvff_size(pool) (mps_pool_total_size(pool))
 extern mps_class_t mps_class_mvff(void);
 extern mps_class_t mps_class_mvff_debug(void);
 
diff --git a/mps/code/mpscmvt.h b/mps/code/mpscmvt.h
index f46e43267df..82792eb3f55 100644
--- a/mps/code/mpscmvt.h
+++ b/mps/code/mpscmvt.h
@@ -34,10 +34,12 @@ extern const struct mps_key_s _mps_key_mvt_frag_limit;
  */
 extern mps_class_t mps_class_mvt(void);
 
-/* The mvt pool class supports two extensions to the pool protocol:
-   size and free_size. */
-extern size_t mps_mvt_free_size(mps_pool_t mps_pool);
-extern size_t mps_mvt_size(mps_pool_t mps_pool);
+/* The mvt pool class formerly supported two extensions to the pool
+   protocol: size and free_size. These are deprecated in favour of the
+   generic pool function. */
+
+#define mps_mvt_free_size(pool) (mps_pool_free_size(pool))
+#define mps_mvt_size(pool) (mps_pool_total_size(pool))
 
 #endif /* mpscmvt_h */
 
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index 0573a6d4256..a679955456d 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -678,6 +678,40 @@ void mps_pool_destroy(mps_pool_t pool)
   ArenaLeave(arena);
 }
 
+size_t mps_pool_total_size(mps_pool_t pool)
+{
+  Arena arena;
+  Size size;
+
+  AVER(TESTT(Pool, pool));
+  arena = PoolArena(pool);
+
+  ArenaEnter(arena);
+
+  size = PoolTotalSize(pool);
+
+  ArenaLeave(arena);
+
+  return (size_t)size;
+}
+
+size_t mps_pool_free_size(mps_pool_t pool)
+{
+  Arena arena;
+  Size size;
+
+  AVER(TESTT(Pool, pool));
+  arena = PoolArena(pool);
+
+  ArenaEnter(arena);
+
+  size = PoolFreeSize(pool);
+
+  ArenaLeave(arena);
+
+  return (size_t)size;
+}
+
 
 mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t pool, size_t size)
 {
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 8bfa5d87a0c..bda9faea9b0 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -72,6 +72,8 @@ Bool PoolClassCheck(PoolClass class)
   CHECKL(FUNCHECK(class->bufferClass));
   CHECKL(FUNCHECK(class->describe));
   CHECKL(FUNCHECK(class->debugMixin));
+  CHECKL(FUNCHECK(class->totalSize));
+  CHECKL(FUNCHECK(class->freeSize));
   CHECKS(PoolClass, class);
   return TRUE;
 }
@@ -521,6 +523,26 @@ void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
 }
 
 
+/* PoolTotalSize -- return total memory allocated from arena */
+
+Size PoolTotalSize(Pool pool)
+{
+  AVERT(Pool, pool);
+
+  return (*pool->class->totalSize)(pool);
+}
+
+
+/* PoolFreeSize -- return free memory (unused by client program) */
+
+Size PoolFreeSize(Pool pool)
+{
+  AVERT(Pool, pool);
+
+  return (*pool->class->freeSize)(pool);
+}
+
+
 /* PoolDescribe -- describe a pool */
 
 Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index aa2ee5adcbd..62b25498ecd 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -160,6 +160,8 @@ DEFINE_CLASS(AbstractPoolClass, class)
   class->bufferClass = PoolNoBufferClass;
   class->describe = PoolTrivDescribe;
   class->debugMixin = PoolNoDebugMixin;
+  class->totalSize = PoolNoSize;
+  class->freeSize = PoolNoSize;
   class->labelled = FALSE;
   class->sig = PoolClassSig;
 }
@@ -696,6 +698,14 @@ BufferClass PoolNoBufferClass(void)
 }
 
 
+Size PoolNoSize(Pool pool)
+{
+  AVERT(Pool, pool);
+  NOTREACHED;
+  return 0;
+}
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 92239f6e369..fa29f4a97fb 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -2266,6 +2266,50 @@ static Res AMCAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr)
 }
 
 
+/* AMCTotalSize -- total memory allocated from the arena */
+
+static Size AMCTotalSize(Pool pool)
+{
+  AMC amc;
+  Size size = 0;
+  Ring node, nextNode;
+
+  AVERT(Pool, pool);
+  amc = Pool2AMC(pool);
+  AVERT(AMC, amc);
+
+  RING_FOR(node, &amc->genRing, nextNode) {
+    amcGen gen = RING_ELT(amcGen, amcRing, node);
+    AVERT(amcGen, gen);
+    size += gen->pgen.totalSize;
+  }
+
+  return size;
+}
+
+
+/* AMCFreeSize -- free memory (unused by client program) */
+
+static Size AMCFreeSize(Pool pool)
+{
+  AMC amc;
+  Size size = 0;
+  Ring node, nextNode;
+
+  AVERT(Pool, pool);
+  amc = Pool2AMC(pool);
+  AVERT(AMC, amc);
+
+  RING_FOR(node, &amc->genRing, nextNode) {
+    amcGen gen = RING_ELT(amcGen, amcRing, node);
+    AVERT(amcGen, gen);
+    size += gen->pgen.freeSize;
+  }
+
+  return size;
+}
+
+
 /* AMCDescribe -- describe the contents of the AMC pool
  *
  * See <design/poolamc/#describe>.
@@ -2365,6 +2409,8 @@ DEFINE_POOL_CLASS(AMCZPoolClass, this)
   this->addrObject = AMCAddrObject;
   this->walk = AMCWalk;
   this->bufferClass = amcBufClassGet;
+  this->totalSize = AMCTotalSize;
+  this->freeSize = AMCFreeSize;  
   this->describe = AMCDescribe;
   AVERT(PoolClass, this);
 }
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index e6c4e7d4837..71cbaef0733 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -1658,6 +1658,34 @@ static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
 }
 
 
+/* AMSTotalSize -- total memory allocated from the arena */
+
+static Size AMSTotalSize(Pool pool)
+{
+  AMS ams;
+
+  AVERT(Pool, pool);
+  ams = Pool2AMS(pool);
+  AVERT(AMS, ams);
+
+  return ams->pgen.totalSize;
+}
+
+
+/* AMSFreeSize -- free memory (unused by client program) */
+
+static Size AMSFreeSize(Pool pool)
+{
+  AMS ams;
+
+  AVERT(Pool, pool);
+  ams = Pool2AMS(pool);
+  AVERT(AMS, ams);
+
+  return ams->pgen.freeSize;
+}
+
+
 /* AMSDescribe -- the pool class description method
  *
  * Iterates over the segments, describing all of them.
@@ -1729,6 +1757,8 @@ DEFINE_CLASS(AMSPoolClass, this)
   this->reclaim = AMSReclaim;
   this->walk = PoolNoWalk; /* TODO: job003738 */
   this->freewalk = AMSFreeWalk;
+  this->totalSize = AMSTotalSize;
+  this->freeSize = AMSFreeSize;
   this->describe = AMSDescribe;
   AVERT(PoolClass, this);
 }
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 775d29d2018..1d6a6c31bd9 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -1281,6 +1281,34 @@ static void AWLWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
 }
 
 
+/* AWLTotalSize -- total memory allocated from the arena */
+
+static Size AWLTotalSize(Pool pool)
+{
+  AWL awl;
+
+  AVERT(Pool, pool);
+  awl = Pool2AWL(pool);
+  AVERT(AWL, awl);
+
+  return awl->pgen.totalSize;
+}
+
+
+/* AWLFreeSize -- free memory (unused by client program) */
+
+static Size AWLFreeSize(Pool pool)
+{
+  AWL awl;
+
+  AVERT(Pool, pool);
+  awl = Pool2AWL(pool);
+  AVERT(AWL, awl);
+
+  return awl->pgen.freeSize;
+}
+
+
 /* AWLPoolClass -- the class definition */
 
 DEFINE_POOL_CLASS(AWLPoolClass, this)
@@ -1305,6 +1333,8 @@ DEFINE_POOL_CLASS(AWLPoolClass, this)
   this->fixEmergency = AWLFix;
   this->reclaim = AWLReclaim;
   this->walk = AWLWalk;
+  this->totalSize = AWLTotalSize;
+  this->freeSize = AWLFreeSize;
   AVERT(PoolClass, this);
 }
 
diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index 06d3e68160f..c2b562df421 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -797,6 +797,34 @@ static void LOReclaim(Pool pool, Trace trace, Seg seg)
 }
 
 
+/* LOTotalSize -- total memory allocated from the arena */
+
+static Size LOTotalSize(Pool pool)
+{
+  LO lo;
+
+  AVERT(Pool, pool);
+  lo = PoolPoolLO(pool);
+  AVERT(LO, lo);
+
+  return lo->pgen.totalSize;
+}
+
+
+/* LOFreeSize -- free memory (unused by client program) */
+
+static Size LOFreeSize(Pool pool)
+{
+  LO lo;
+
+  AVERT(Pool, pool);
+  lo = PoolPoolLO(pool);
+  AVERT(LO, lo);
+
+  return lo->pgen.freeSize;
+}
+
+
 /* LOPoolClass -- the class definition */
 
 DEFINE_POOL_CLASS(LOPoolClass, this)
@@ -817,6 +845,8 @@ DEFINE_POOL_CLASS(LOPoolClass, this)
   this->fixEmergency = LOFix;
   this->reclaim = LOReclaim;
   this->walk = LOWalk;
+  this->totalSize = LOTotalSize;
+  this->freeSize = LOFreeSize;
   AVERT(PoolClass, this);
 }
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index b40094d839c..6ab9fd8f08f 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -123,6 +123,8 @@ static Res MFSInit(Pool pool, ArgList args)
   mfs->unitSize = unitSize;
   mfs->freeList = NULL;
   mfs->tractList = NULL;
+  mfs->total = 0;
+  mfs->free = 0;
   mfs->sig = MFSSig;
 
   AVERT(MFS, mfs);
@@ -197,6 +199,10 @@ void MFSExtend(Pool pool, Addr base, Size size)
   TractSetP(tract, (void *)mfs->tractList);
   mfs->tractList = tract;
 
+  /* Update accounting */
+  mfs->total += size;
+  mfs->free += size;
+
   /* Sew together all the new empty units in the region, working down */
   /* from the top so that they are in ascending order of address on the */
   /* free list. */
@@ -270,6 +276,7 @@ static Res MFSAlloc(Addr *pReturn, Pool pool, Size size,
   /* Detach the first free unit from the free list and return its address. */
 
   mfs->freeList = f->next;
+  mfs->free -= mfs->unitSize;
 
   *pReturn = (Addr)f;
   return ResOK;
@@ -298,6 +305,35 @@ static void MFSFree(Pool pool, Addr old, Size size)
   h = (Header)old;
   h->next = mfs->freeList;
   mfs->freeList = h;
+  mfs->free += mfs->unitSize;
+}
+
+
+/* MFSTotalSize -- total memory allocated from the arena */
+
+static Size MFSTotalSize(Pool pool)
+{
+  MFS mfs;
+
+  AVERT(Pool, pool);
+  mfs = PoolPoolMFS(pool);
+  AVERT(MFS, mfs);
+
+  return mfs->total;
+}
+
+
+/* MFSFreeSize -- free memory (unused by client program) */
+
+static Size MFSFreeSize(Pool pool)
+{
+  MFS mfs;
+
+  AVERT(Pool, pool);
+  mfs = PoolPoolMFS(pool);
+  AVERT(MFS, mfs);
+
+  return mfs->free;
 }
 
 
@@ -336,6 +372,8 @@ DEFINE_POOL_CLASS(MFSPoolClass, this)
   this->finish = MFSFinish;
   this->alloc = MFSAlloc;
   this->free = MFSFree;
+  this->totalSize = MFSTotalSize;
+  this->freeSize = MFSFreeSize;  
   this->describe = MFSDescribe;
   AVERT(PoolClass, this);
 }
@@ -370,6 +408,8 @@ Bool MFSCheck(MFS mfs)
   if(mfs->tractList != NULL) {
     CHECKD_NOSIG(Tract, mfs->tractList);
   }
+  CHECKL(mfs->free <= mfs->total);
+  CHECKL((mfs->total - mfs->free) % mfs->unitSize == 0);
   return TRUE;
 }
 
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 5c9dc98c6b6..5fac5a17478 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -116,7 +116,7 @@ typedef struct MVSpanStruct {
   MVBlockStruct base;           /* sentinel at base of span */
   MVBlockStruct limit;          /* sentinel at limit of span */
   MVBlock blocks;               /* allocated blocks */
-  Size space;                   /* total free space in span */
+  Size free;                    /* free space in span */
   Size largest;                 /* .design.largest */
   Bool largestKnown;            /* .design.largest */
   unsigned blockCount;          /* number of blocks on chain */
@@ -160,11 +160,11 @@ static Bool MVSpanCheck(MVSpan span)
   /* The sentinels mustn't overlap. */
   CHECKL(span->base.limit <= span->limit.base);
   /* The free space can't be more than the gap between the sentinels. */
-  CHECKL(span->space <= SpanInsideSentinels(span));
+  CHECKL(span->free <= SpanInsideSentinels(span));
 
   CHECKL(BoolCheck(span->largestKnown));
   if (span->largestKnown) { /* .design.largest */
-    CHECKL(span->largest <= span->space);
+    CHECKL(span->largest <= span->free);
     /* at least this much is free */
   } else {
     CHECKL(span->largest == SpanSize(span)+1);
@@ -277,7 +277,7 @@ static Res MVInit(Pool pool, ArgList args)
   mv->maxSize  = maxSize;
   RingInit(&mv->spans);
    
-  mv->space = 0;
+  mv->free = 0;
   mv->lost = 0;
 
   mv->sig = MVSig;
@@ -368,7 +368,7 @@ static Bool MVSpanAlloc(Addr *addrReturn, MVSpan span, Size size,
         span->largest = SpanSize(span) + 1;  /* .design.largest */
       }
 
-      span->space -= size;
+      span->free -= size;
       *addrReturn = new;
       return TRUE;
     }
@@ -484,7 +484,7 @@ static Res MVSpanFree(MVSpan span, Addr base, Addr limit, Pool blockPool)
 
       AVERT(MVBlock, block);
 
-      span->space += AddrOffset(base, limit);
+      span->free += AddrOffset(base, limit);
 
       if (freeAreaSize > span->largest) { /* .design.largest */
         AVER(span->largestKnown);
@@ -528,16 +528,16 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
 
   size = SizeAlignUp(size, pool->alignment);
 
-  if(size <= mv->space) {
+  if(size <= mv->free) {
     spans = &mv->spans;
     RING_FOR(node, spans, nextNode) {
       span = RING_ELT(MVSpan, spans, node);
       if((size <= span->largest) &&          /* .design.largest.alloc */
-         (size <= span->space)) {
+         (size <= span->free)) {
         Addr new;
 
         if(MVSpanAlloc(&new, span, size, mvBlockPool(mv))) {
-          mv->space -= size;
+          mv->free -= size;
           AVER(AddrIsAligned(new, pool->alignment));
           *pReturn = new;
           return ResOK;
@@ -593,20 +593,20 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
   RingInit(&span->spans);
   span->base.base = span->base.limit = base;
   span->limit.base = span->limit.limit = limit;
-  span->space = AddrOffset(span->base.limit, span->limit.base);
+  span->free = AddrOffset(span->base.limit, span->limit.base);
   span->limit.next = NULL;
   span->base.next = &span->limit;
   span->blocks = &span->base;
   span->blockCount = 2;
   span->base.limit = AddrAdd(span->base.limit, size);
-  span->space -= size;
-  span->largest = span->space;
+  span->free -= size;
+  span->largest = span->free;
   span->largestKnown = TRUE;
 
   span->sig = MVSpanSig;
   AVERT(MVSpan, span);
 
-  mv->space += span->space;
+  mv->free += span->free;
   RingInsert(&mv->spans, &span->spans);
   /* use RingInsert so that we examine this new span first when allocating */
 
@@ -655,16 +655,16 @@ static void MVFree(Pool pool, Addr old, Size size)
   if(res != ResOK)
     mv->lost += size;
   else
-    mv->space += size;
+    mv->free += size;
  
   /* free space should be less than total space */
-  AVER(span->space <= SpanInsideSentinels(span));
-  if(span->space == SpanSize(span)) { /* the whole span is free */
+  AVER(span->free <= SpanInsideSentinels(span));
+  if(span->free == SpanSize(span)) { /* the whole span is free */
     AVER(span->blockCount == 2);
     /* both blocks are the trivial sentinel blocks */
     AVER(span->base.limit == span->base.base);
     AVER(span->limit.limit == span->limit.base);
-    mv->space -= span->space;
+    mv->free -= span->free;
     ArenaFree(TractBase(span->tract), span->size, pool);
     RingRemove(&span->spans);
     RingFinish(&span->spans);
@@ -687,6 +687,51 @@ static PoolDebugMixin MVDebugMixin(Pool pool)
 }
 
 
+/* MVTotalSize -- total memory allocated from the arena */
+
+static Size MVTotalSize(Pool pool)
+{
+  MV mv;
+  Size size = 0;
+  Ring node, next;
+
+  AVERT(Pool, pool);
+  mv = Pool2MV(pool);
+  AVERT(MV, mv);
+
+  RING_FOR(node, &mv->spans, next) {
+    MVSpan span = RING_ELT(MVSpan, spans, node);
+    AVERT(MVSpan, span);
+    size += span->size;
+  }
+
+  return size;
+}
+
+
+/* MVFreeSize -- free memory (unused by client program) */
+
+static Size MVFreeSize(Pool pool)
+{
+  MV mv;
+  Size size = 0;
+  Ring node, next;
+
+  AVERT(Pool, pool);
+  mv = Pool2MV(pool);
+  AVERT(MV, mv);
+
+  RING_FOR(node, &mv->spans, next) {
+    MVSpan span = RING_ELT(MVSpan, spans, node);
+    AVERT(MVSpan, span);
+    size += span->free;
+  }
+
+  AVER(size == mv->free + mv->lost);
+  return size;
+}
+
+
 static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
 {
   Res res;
@@ -710,7 +755,8 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
                "  extendBy  $W\n",  (WriteFW)mv->extendBy,
                "  avgSize   $W\n",  (WriteFW)mv->avgSize,
                "  maxSize   $W\n",  (WriteFW)mv->maxSize,
-               "  space     $P\n",  (WriteFP)mv->space,
+               "  free      $W\n",  (WriteFP)mv->free,
+               "  lost      $W\n",  (WriteFP)mv->lost,
                NULL);
   if(res != ResOK) return res;              
 
@@ -725,7 +771,8 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
     res = WriteF(stream,
                  "    span $P",   (WriteFP)span,
                  "  tract $P",    (WriteFP)span->tract,
-                 "  space $W",    (WriteFW)span->space,
+                 "  size $W",     (WriteFW)span->size,
+                 "  free $W",     (WriteFW)span->free,
                  "  blocks $U",   (WriteFU)span->blockCount,
                  "  largest ",
                  NULL);
@@ -806,6 +853,8 @@ DEFINE_POOL_CLASS(MVPoolClass, this)
   this->finish = MVFinish;
   this->alloc = MVAlloc;
   this->free = MVFree;
+  this->totalSize = MVTotalSize;
+  this->freeSize = MVFreeSize;
   this->describe = MVDescribe;
   AVERT(PoolClass, this);
 }
@@ -847,58 +896,6 @@ mps_class_t mps_class_mv_debug(void)
 }
 
 
-/* mps_mv_free_size -- free bytes in pool */
-
-size_t mps_mv_free_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MV mv;
-  MVSpan span;
-  Size f = 0;
-  Ring spans, node = NULL, nextNode; /* gcc whinge stop */
-
-  pool = (Pool)mps_pool;
-
-  AVERT(Pool, pool);
-  mv = Pool2MV(pool);
-  AVERT(MV, mv);
-
-  spans = &mv->spans;
-  RING_FOR(node, spans, nextNode) {
-  span = RING_ELT(MVSpan, spans, node);
-    AVERT(MVSpan, span);
-    f += span->space;
-  }
-
-  return (size_t)f;
-}
-
-
-size_t mps_mv_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MV mv;
-  MVSpan span;
-  Size f = 0;
-  Ring spans, node = NULL, nextNode; /* gcc whinge stop */
-
-  pool = (Pool)mps_pool;
-
-  AVERT(Pool, pool);
-  mv = Pool2MV(pool);
-  AVERT(MV, mv);
-
-  spans = &mv->spans;
-  RING_FOR(node, spans, nextNode) {
-  span = RING_ELT(MVSpan, spans, node);
-    AVERT(MVSpan, span);
-    f += span->size;
-  }
-
-  return (size_t)f;
-}
-
-
 /* MVCheck -- check the consistency of an MV structure */
 
 Bool MVCheck(MV mv)
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index a149178a8ef..412d235970e 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -40,6 +40,8 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn,
 static void MVTBufferEmpty(Pool pool, Buffer buffer, Addr base, Addr limit);
 static void MVTFree(Pool pool, Addr base, Size size);
 static Res MVTDescribe(Pool pool, mps_lib_FILE *stream);
+static Size MVTTotalSize(Pool pool);
+static Size MVTFreeSize(Pool pool);
 static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size,
                        Bool withReservoirPermit);
 
@@ -146,6 +148,8 @@ DEFINE_POOL_CLASS(MVTPoolClass, this)
   this->free = MVTFree;
   this->bufferFill = MVTBufferFill;
   this->bufferEmpty = MVTBufferEmpty;
+  this->totalSize = MVTTotalSize;
+  this->freeSize = MVTFreeSize;
   this->describe = MVTDescribe;
   AVERT(PoolClass, this);
 }
@@ -993,6 +997,34 @@ static void MVTFree(Pool pool, Addr base, Size size)
 }
 
 
+/* MVTTotalSize -- total memory allocated from the arena */
+
+static Size MVTTotalSize(Pool pool)
+{
+  MVT mvt;
+
+  AVERT(Pool, pool);
+  mvt = Pool2MVT(pool);
+  AVERT(MVT, mvt);
+
+  return mvt->size;
+}
+
+
+/* MVTFreeSize -- free memory (unused by client program) */
+
+static Size MVTFreeSize(Pool pool)
+{
+  MVT mvt;
+
+  AVERT(Pool, pool);
+  mvt = Pool2MVT(pool);
+  AVERT(MVT, mvt);
+
+  return mvt->available + mvt->unavailable;
+}
+
+
 /* MVTDescribe -- describe an MVT pool */
 
 static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
@@ -1093,44 +1125,6 @@ mps_class_t mps_class_mvt(void)
 }
 
 
-/* MPS Interface extensions --- should these be pool generics? */
-
-
-/* mps_mvt_size -- number of bytes committed to the pool */
-
-size_t mps_mvt_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MVT mvt;
-
-  pool = (Pool)mps_pool;
-
-  AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
-  AVERT(MVT, mvt);
-
-  return (size_t)mvt->size;
-}
-
-
-/* mps_mvt_free_size -- number of bytes comitted to the pool that are
- * available for allocation
- */
-size_t mps_mvt_free_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MVT mvt;
-
-  pool = (Pool)mps_pool;
-
-  AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
-  AVERT(MVT, mvt);
-
-  return (size_t)mvt->available;
-}
-
-
 /* Internal methods */
 
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 2e38c25aa3d..977fd34b085 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -639,6 +639,34 @@ static PoolDebugMixin MVFFDebugMixin(Pool pool)
 }
 
 
+/* MVFFTotalSize -- total memory allocated from the arena */
+
+static Size MVFFTotalSize(Pool pool)
+{
+  MVFF mvff;
+
+  AVERT(Pool, pool);
+  mvff = Pool2MVFF(pool);
+  AVERT(MVFF, mvff);
+
+  return LandSize(MVFFTotalCBS(mvff));
+}
+
+
+/* MVFFFreeSize -- free memory (unused by client program) */
+
+static Size MVFFFreeSize(Pool pool)
+{
+  MVFF mvff;
+
+  AVERT(Pool, pool);
+  mvff = Pool2MVFF(pool);
+  AVERT(MVFF, mvff);
+
+  return LandSize(MVFFFailover(mvff));
+}
+
+
 /* MVFFDescribe -- describe an MVFF pool */
 
 static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
@@ -695,6 +723,8 @@ DEFINE_POOL_CLASS(MVFFPoolClass, this)
   this->free = MVFFFree;
   this->bufferFill = MVFFBufferFill;
   this->bufferEmpty = MVFFBufferEmpty;
+  this->totalSize = MVFFTotalSize;
+  this->freeSize = MVFFFreeSize;
   this->describe = MVFFDescribe;
   AVERT(PoolClass, this);
 }
@@ -734,37 +764,6 @@ mps_class_t mps_class_mvff_debug(void)
 }
 
 
-/* Total free bytes. See <design/poolmvff/#design.arena-enter> */
-
-size_t mps_mvff_free_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MVFF mvff;
-
-  pool = (Pool)mps_pool;
-  AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
-  AVERT(MVFF, mvff);
-
-  return (size_t)LandSize(MVFFFailover(mvff));
-}
-
-/* Total owned bytes. See <design/poolmvff/#design.arena-enter> */
-
-size_t mps_mvff_size(mps_pool_t mps_pool)
-{
-  Pool pool;
-  MVFF mvff;
-
-  pool = (Pool)mps_pool;
-  AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
-  AVERT(MVFF, mvff);
-
-  return (size_t)LandSize(MVFFTotalCBS(mvff));
-}
-
-
 /* MVFFCheck -- check the consistency of an MVFF structure */
 
 ATTRIBUTE_UNUSED
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index 139865fc5ec..98a9bb82dad 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -24,9 +24,6 @@
 SRCID(poolsnc, "$Id$");
 
 
-#define SNCGen  ((Serial)1) /* "generation" for SNC pools */
-
-
 /* SNCStruct -- structure for an SNC pool
  *
  * See design.mps.poolsnc.poolstruct.
diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index d3b657cd6a5..a85e6fdd57e 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -39,6 +39,9 @@ New features
    was considered, and a chain was collected up to, but not including,
    the lowest generation whose new size was within its capacity.)
 
+#. New pool introspection functions :c:func:`mps_pool_total_size` and
+   :c:func:`mps_pool_free_size`.
+
 
 Interface changes
 .................
diff --git a/mps/manual/source/topic/pool.rst b/mps/manual/source/topic/pool.rst
index 5fe096f9aeb..0ba60e8c1ce 100644
--- a/mps/manual/source/topic/pool.rst
+++ b/mps/manual/source/topic/pool.rst
@@ -135,6 +135,31 @@ See the :ref:`pool` for a list of pool classes.
 Pool introspection
 ------------------
 
+.. c:function:: size_t mps_pool_total_size(mps_pool_t pool)
+
+    Return the total memory allocated from the arena and managed by
+    the pool.
+
+    ``pool`` is the pool.
+
+    The result includes memory in use by the client program, memory
+    that's available for use by the client program, and memory
+    that's lost to fragmentation. It does not include memory used by
+    the pool's internal control structures.
+
+
+.. c:function:: size_t mps_pool_free_size(mps_pool_t pool)
+
+    Return the free memory: memory managed by the pool but not in use
+    by the client program.
+
+    ``pool`` is the pool.
+
+    The result includes memory that's available for use by the client
+    program, and memory that's lost to fragmentation. It does not
+    include memory used by the pool's internal control structures.
+
+
 .. c:function:: mps_bool_t mps_addr_pool(mps_pool_t *pool_o, mps_arena_t arena, mps_addr_t addr)
 
     Determine the :term:`pool` to which an address belongs.

From c61d2e7df41efcca5b8acdaf87c61efe1fe40df6 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 15 May 2014 17:25:27 +0100
Subject: [PATCH 29/70] Add missing aver.

Copied from Perforce
 Change: 186119
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmfs.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 6ab9fd8f08f..59fe1849c5c 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -276,6 +276,7 @@ static Res MFSAlloc(Addr *pReturn, Pool pool, Size size,
   /* Detach the first free unit from the free list and return its address. */
 
   mfs->freeList = f->next;
+  AVER(mfs->free >= mfs->unitSize);
   mfs->free -= mfs->unitSize;
 
   *pReturn = (Addr)f;

From ec9a315e34b1a2c46f5287e8639fd04858a69195 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sat, 17 May 2014 10:02:47 +0100
Subject: [PATCH 30/70] Branching master to branch/2014-05-17/chunk-tree.

Copied from Perforce
 Change: 186152
 ServerID: perforce.ravenbrook.com

From 0b0a46567404ece617d03a5d10ad7837ade8705b Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sat, 17 May 2014 17:05:42 +0100
Subject: [PATCH 31/70] Replace the chunk ring with a chunk tree.

Fix bug in SplayFindNext (LESS and GREATER the wrong way round).

Copied from Perforce
 Change: 186157
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   |  88 ++++++++++++--------
 mps/code/arenacl.c |  37 +++++----
 mps/code/arenavm.c |  68 ++++++++-------
 mps/code/mpm.h     |   1 +
 mps/code/mpmst.h   |  17 +---
 mps/code/splay.c   |  44 ++++++----
 mps/code/splay.h   |   2 +
 mps/code/tract.c   | 201 +++++++++++++++++----------------------------
 mps/code/tract.h   |  20 +++--
 mps/code/tree.h    |  11 +++
 10 files changed, 247 insertions(+), 242 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 30f7687ce81..8a70303386f 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -147,9 +147,9 @@ Bool ArenaCheck(Arena arena)
   if (arena->primary != NULL) {
     CHECKD(Chunk, arena->primary);
   }
-  CHECKD_NOSIG(Ring, &arena->chunkRing);
+  /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
+  CHECKL(SplayTreeCheck(ArenaChunkTree(arena)));
   /* nothing to check for chunkSerial */
-  CHECKD(ChunkCacheEntry, &arena->chunkCache);
   
   CHECKL(LocusCheck(arena));
 
@@ -205,9 +205,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
   arena->zoned = zoned;
 
   arena->primary = NULL;
-  RingInit(&arena->chunkRing);
+  SplayTreeInit(ArenaChunkTree(arena), ChunkCompare, ChunkKey, SplayTrivUpdate);
   arena->chunkSerial = (Serial)0;
-  ChunkCacheEntryInit(&arena->chunkCache);
   
   LocusInit(arena);
   
@@ -349,7 +348,8 @@ void ArenaFinish(Arena arena)
   arena->sig = SigInvalid;
   GlobalsFinish(ArenaGlobals(arena));
   LocusFinish(arena);
-  RingFinish(&arena->chunkRing);
+  AVER(SplayTreeIsEmpty(ArenaChunkTree(arena)));
+  SplayTreeFinish(ArenaChunkTree(arena));
 }
 
 
@@ -606,52 +606,74 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
  * CBS or any pool, because it is used as part of the bootstrap.
  */
 
-static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
-{
-  Res res;
-  Index basePageIndex, limitPageIndex;
+typedef struct ArenaAllocPageClosureStruct {
   Arena arena;
+  Pool pool;
+  Chunk avoid;
+  Addr base;
+} ArenaAllocPageClosureStruct, *ArenaAllocPageClosure;
 
-  AVER(baseReturn != NULL);
+static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
+{
+  ArenaAllocPageClosure cl;
+  Chunk chunk;
+  Index basePageIndex, limitPageIndex;
+  Res res;
+
+  AVERT(Tree, tree);
+  chunk = ChunkOfTree(tree);
   AVERT(Chunk, chunk);
-  AVERT(Pool, pool);
-  arena = ChunkArena(chunk);
+  AVER(closureP != NULL);
+  cl = closureP;
+  AVER(cl->arena == ChunkArena(chunk));
+  UNUSED(closureS);
+
+  if (chunk == cl->avoid)
+    return TRUE;
   
   if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
                            chunk->allocTable,
                            chunk->allocBase, chunk->pages, 1))
-    return ResRESOURCE;
+    return TRUE;
   
-  res = (*arena->class->pagesMarkAllocated)(arena, chunk,
-                                            basePageIndex, 1,
-                                            pool);
+  res = (*cl->arena->class->pagesMarkAllocated)(cl->arena, chunk,
+                                                basePageIndex, 1, cl->pool);
   if (res != ResOK)
-    return res;
+    return TRUE;
   
-  *baseReturn = PageIndexBase(chunk, basePageIndex);
-  return ResOK;
+  cl->base = PageIndexBase(chunk, basePageIndex);
+  return FALSE;
 }
 
 static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
 {
-  Res res;
+  ArenaAllocPageClosureStruct closure;
   
+  AVER(baseReturn != NULL);
+  AVERT(Arena, arena);
+  AVERT(Pool, pool);
+
+  closure.arena = arena;
+  closure.pool = pool;
+  closure.base = NULL;
+
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
   /* TODO: Consider how the ArenaCBSBlockPool might free pages. */
-  res = arenaAllocPageInChunk(baseReturn, arena->primary, pool);
-  if (res != ResOK) {
-    Ring node, next;
-    RING_FOR(node, &arena->chunkRing, next) {
-      Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-      if (chunk != arena->primary) {
-        res = arenaAllocPageInChunk(baseReturn, chunk, pool);
-        if (res == ResOK)
-          break;
-      }
-    }
-  }
-  return res;
+  if (arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0) == FALSE)
+    goto found;
+
+  closure.avoid = arena->primary;
+  if (SplayTreeTraverse(ArenaChunkTree(arena), arenaAllocPageInChunk, &closure, 0)
+      == FALSE)
+    goto found;
+
+  return ResRESOURCE;
+
+found:
+  AVER(closure.base != NULL);
+  *baseReturn = closure.base;
+  return ResOK;
 }
 
 
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 1a0fcf3c6e3..1a2c52f30e0 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -290,15 +290,14 @@ failChunkCreate:
 static void ClientArenaFinish(Arena arena)
 {
   ClientArena clientArena;
-  Ring node, next;
 
   clientArena = Arena2ClientArena(arena);
   AVERT(ClientArena, clientArena);
 
-  /* destroy all chunks */
-  RING_FOR(node, &arena->chunkRing, next) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-    clientChunkDestroy(chunk);
+  /* destroy all chunks, including the primary */
+  arena->primary = NULL;
+  while (!SplayTreeIsEmpty(ArenaChunkTree(arena))) {
+    clientChunkDestroy(ChunkOfTree(SplayTreeRoot(ArenaChunkTree(arena))));
   }
 
   clientArena->sig = SigInvalid;
@@ -329,20 +328,30 @@ static Res ClientArenaExtend(Arena arena, Addr base, Size size)
 
 /* ClientArenaReserved -- return the amount of reserved address space */
 
+static Bool clientArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
+{
+  Size *size;
+  Chunk chunk;
+
+  AVERT(Tree, tree);
+  chunk = ChunkOfTree(tree);
+  AVERT(Chunk, chunk);
+  AVER(closureP != 0);
+  size = closureP;
+  UNUSED(closureS);
+
+  *size += ChunkSize(chunk);
+  return TRUE;
+}
+
 static Size ClientArenaReserved(Arena arena)
 {
-  Size size;
-  Ring node, nextNode;
+  Size size = 0;
 
   AVERT(Arena, arena);
 
-  size = 0;
-  /* .req.extend.slow */
-  RING_FOR(node, &arena->chunkRing, nextNode) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-    AVERT(Chunk, chunk);
-    size += AddrOffset(chunk->base, chunk->limit);
-  }
+  TreeTraverse(SplayTreeRoot(ArenaChunkTree(arena)), ChunkCompare, ChunkKey,
+               clientArenaReservedVisitor, &size, 0);
 
   return size;
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index f878092bd01..e5343c1329a 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -557,7 +557,7 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
   /* bits in a word).  Fail if the chunk is so small stripes are smaller */
   /* than pages.  Note that some zones are discontiguous in the chunk if */
   /* the size is not a power of 2.  See <design/arena/#class.fields>. */
-  chunkSize = AddrOffset(chunk->base, chunk->limit);
+  chunkSize = ChunkSize(chunk);
   arena->zoneShift = SizeFloorLog2(chunkSize >> MPS_WORD_SHIFT);
   AVER(chunk->pageSize == arena->alignment);
 
@@ -588,7 +588,6 @@ failVMCreate:
 static void VMArenaFinish(Arena arena)
 {
   VMArena vmArena;
-  Ring node, next;
   VM arenaVM;
 
   vmArena = Arena2VMArena(arena);
@@ -599,9 +598,8 @@ static void VMArenaFinish(Arena arena)
 
   /* destroy all chunks, including the primary */
   arena->primary = NULL;
-  RING_FOR(node, &arena->chunkRing, next) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-    vmChunkDestroy(chunk);
+  while (!SplayTreeIsEmpty(ArenaChunkTree(arena))) {
+    vmChunkDestroy(ChunkOfTree(SplayTreeRoot(ArenaChunkTree(arena))));
   }
   
   /* Destroying the chunks should have purged and removed all spare pages. */
@@ -623,17 +621,34 @@ static void VMArenaFinish(Arena arena)
  *
  * Add up the reserved space from all the chunks.
  */
+
+static Bool vmArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
+{
+  Size *size;
+  Chunk chunk;
+
+  AVERT(Tree, tree);
+  chunk = ChunkOfTree(tree);
+  AVERT(Chunk, chunk);
+  AVER(closureP != 0);
+  size = closureP;
+  UNUSED(closureS);
+
+  *size += VMReserved(Chunk2VMChunk(chunk)->vm);
+  return TRUE;
+}
+
+
 static Size VMArenaReserved(Arena arena)
 {
-  Size reserved;
-  Ring node, next;
+  Size size = 0;
 
-  reserved = 0;
-  RING_FOR(node, &arena->chunkRing, next) {
-    VMChunk vmChunk = Chunk2VMChunk(RING_ELT(Chunk, chunkRing, node));
-    reserved += VMReserved(vmChunk->vm);
-  }
-  return reserved;
+  AVERT(Arena, arena);
+
+  TreeTraverse(SplayTreeRoot(ArenaChunkTree(arena)), ChunkCompare, ChunkKey,
+               vmArenaReservedVisitor, &size, 0);
+
+  return size;
 }
 
 
@@ -996,9 +1011,7 @@ static Size VMPurgeSpare(Arena arena, Size size)
 static void chunkUnmapSpare(Chunk chunk)
 {
   AVERT(Chunk, chunk);
-  (void)arenaUnmapSpare(ChunkArena(chunk),
-                        AddrOffset(chunk->base, chunk->limit),
-                        chunk);
+  (void)arenaUnmapSpare(ChunkArena(chunk), ChunkSize(chunk), chunk);
 }
 
 
@@ -1071,8 +1084,8 @@ static void VMFree(Addr base, Size size, Pool pool)
 static void VMCompact(Arena arena, Trace trace)
 {
   VMArena vmArena;
-  Ring node, next;
   Size vmem1;
+  Tree tree;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -1080,24 +1093,21 @@ static void VMCompact(Arena arena, Trace trace)
 
   vmem1 = VMArenaReserved(arena);
 
-  RING_FOR(node, &arena->chunkRing, next) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
+  tree = SplayTreeFirst(ArenaChunkTree(arena));
+  while (tree != TreeEMPTY) {
+    Chunk chunk = ChunkOfTree(tree);
+    TreeKey key = ChunkKey(tree);
+    AVERT(Chunk, chunk);
     if(chunk != arena->primary
-       && BTIsResRange(chunk->allocTable, 0, chunk->pages)) {
+       && BTIsResRange(chunk->allocTable, 0, chunk->pages))
+    {
       Addr base = chunk->base;
-      Size size = AddrOffset(chunk->base, chunk->limit);
-
-      /* Ensure there are no spare (mapped) pages left in the chunk.
-         This could be short-cut if we're about to destroy the chunk,
-         provided we can do the correct accounting in the arena. */
-      chunkUnmapSpare(chunk);
-
+      Size size = ChunkSize(chunk);
       vmChunkDestroy(chunk);
-
       vmArena->contracted(arena, base, size);
     }
+    tree = SplayTreeNext(ArenaChunkTree(arena), key);
   }
-
   {
     Size vmem0 = trace->preTraceArenaReserved;
     Size vmem2 = VMArenaReserved(arena);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index e6a0da4e834..33c994c1236 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -518,6 +518,7 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
 #define ArenaAlign(arena)       ((arena)->alignment)
 #define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
 #define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
+#define ArenaChunkTree(arena) (&(arena)->chunkTree)
 
 extern void ArenaEnterLock(Arena arena, Bool recursive);
 extern void ArenaLeaveLock(Arena arena, Bool recursive);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 5d38f3a3319..7334ab56fa4 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -515,18 +515,6 @@ typedef struct TraceStruct {
 } TraceStruct;
 
 
-/* ChunkCacheEntryStruct -- cache entry in the chunk cache */
-
-#define ChunkCacheEntrySig ((Sig)0x519C80CE) /* SIGnature CHUnk Cache Entry */
-
-typedef struct ChunkCacheEntryStruct {
-  Sig sig;
-  Chunk chunk;
-  Addr base;
-  Addr limit;
-} ChunkCacheEntryStruct;
-
-
 /* ArenaClassStruct -- generic arena class interface */
 
 #define ArenaClassSig   ((Sig)0x519A6C1A) /* SIGnature ARena CLAss */
@@ -657,10 +645,9 @@ typedef struct mps_arena_s {
   Addr lastTractBase;           /* base address of lastTract */
 
   Chunk primary;                /* the primary chunk */
-  RingStruct chunkRing;         /* all the chunks */
+  SplayTreeStruct chunkTree;    /* all the chunks */
   Serial chunkSerial;           /* next chunk number */
-  ChunkCacheEntryStruct chunkCache; /* just one entry */
-  
+
   Bool hasFreeCBS;              /* Is freeCBS available? */
   MFSStruct freeCBSBlockPoolStruct;
   CBSStruct freeCBSStruct;
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 7e061cd14f4..e3d15e85037 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -679,7 +679,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
   SplayStateStruct stateStruct;
 
 #ifdef SPLAY_DEBUG
-  Count count = TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey);
+  Count count = TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
 #endif
 
   /* Short-circuit common cases.  Splay trees often bring recently
@@ -699,7 +699,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
   SplayTreeSetRoot(splay, stateStruct.middle);
 
 #ifdef SPLAY_DEBUG
-  AVER(count == TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey));
+  AVER(count == TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey));
 #endif
 
   return cmp;
@@ -894,7 +894,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
   Bool found;
   Compare cmp;
 #ifdef SPLAY_DEBUG
-  Count count = TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey);
+  Count count = TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
 #endif
 
 
@@ -936,7 +936,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
   SplayTreeSetRoot(splay, stateStruct.middle);
 
 #ifdef SPLAY_DEBUG
-  AVER(count == TreeDebugCount(SplayTreeRoot(tree), tree->compare, tree->nodeKey));
+  AVER(count == TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey));
 #endif
 
   return found;
@@ -945,10 +945,8 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
 
 /* SplayTreeFirst, SplayTreeNext -- iterators
  *
- * SplayTreeFirst receives a key that must precede all
- * nodes in the tree.  It returns TreeEMPTY if the tree is empty.
- * Otherwise, it splays the tree to the first node, and returns the
- * new root.
+ * SplayTreeFirst returns TreeEMPTY if the tree is empty. Otherwise,
+ * it splays the tree to the first node, and returns the new root.
  *
  * SplayTreeNext takes a tree and splays it to the successor of a key
  * and returns the new root.  Returns TreeEMPTY is there are no successors.
@@ -957,8 +955,9 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
  * unmodified.
  *
  * IMPORTANT: Iterating over the tree using these functions will leave
- * the tree totally unbalanced, throwing away optimisations of the tree
- * shape caused by previous splays.  Consider using TreeTraverse instead.
+ * the tree totally unbalanced, throwing away optimisations of the
+ * tree shape caused by previous splays. Consider using
+ * SplayTreeTraverse instead.
  */
 
 Tree SplayTreeFirst(SplayTree splay) {
@@ -989,16 +988,26 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
   default:
     NOTREACHED;
     /* defensive fall-through */
-  case CompareGREATER:
+  case CompareLESS:
     return SplayTreeRoot(splay);
 
-  case CompareLESS:
+  case CompareGREATER:
   case CompareEQUAL:
     return SplayTreeSuccessor(splay);
   }
 }
 
 
+/* SplayTreeTraverse -- iterate over splay tree without splaying it */
+
+Bool SplayTreeTraverse(SplayTree splay, TreeVisitor visitor,
+                       void *closureP, Size closureS)
+{
+  return TreeTraverse(splay->root, splay->compare, splay->nodeKey,
+                      visitor, closureP, closureS);
+}
+
+
 /* SplayNodeDescribe -- Describe a node in the splay tree
  *
  * Note that this breaks the restriction of .note.stack.
@@ -1009,10 +1018,9 @@ static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
                              SplayNodeDescribeMethod nodeDescribe) {
   Res res;
 
-#if defined(AVER_AND_CHECK)
   if (!TreeCheck(node)) return ResFAIL;
-  /* stream and nodeDescribe checked by SplayTreeDescribe */
-#endif
+  if (stream == NULL) return ResFAIL;
+  if (!FUNCHECK(nodeDescribe)) return ResFAIL;
 
   res = WriteF(stream, "( ", NULL);
   if (res != ResOK) return res;
@@ -1327,15 +1335,15 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
                       SplayNodeDescribeMethod nodeDescribe) {
   Res res;
 
-#if defined(AVER_AND_CHECK)
-  if (!SplayTreeCheck(splay)) return ResFAIL;
+  if (!TESTT(SplayTree, splay)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
   if (!FUNCHECK(nodeDescribe)) return ResFAIL;
-#endif
 
   res = WriteF(stream,
                "Splay $P {\n", (WriteFP)splay,
                "  compare $F\n", (WriteFF)splay->compare,
+               "  nodeKey $F\n", (WriteFF)splay->nodeKey,
+               "  updateNode $F\n", (WriteFF)splay->updateNode,
                NULL);
   if (res != ResOK) return res;
 
diff --git a/mps/code/splay.h b/mps/code/splay.h
index 86f7f470482..5103a2991e6 100644
--- a/mps/code/splay.h
+++ b/mps/code/splay.h
@@ -55,6 +55,8 @@ extern Bool SplayTreeNeighbours(Tree *leftReturn,
 
 extern Tree SplayTreeFirst(SplayTree splay);
 extern Tree SplayTreeNext(SplayTree splay, TreeKey oldKey);
+extern Bool SplayTreeTraverse(SplayTree splay, TreeVisitor visitor,
+                              void *closureP, Size closureS);
 
 typedef Bool (*SplayFindMethod)(Tree *nodeReturn, SplayTree splay,
                                 SplayTestNodeMethod testNode,
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 2468887bc17..dd2c2d6cd57 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -17,9 +17,6 @@
 SRCID(tract, "$Id$");
 
 
-static void ChunkDecache(Arena arena, Chunk chunk);
-
-
 /* TractArena -- get the arena of a tract */
 
 #define TractArena(tract) PoolArena(TractPool(tract))
@@ -113,17 +110,17 @@ Bool ChunkCheck(Chunk chunk)
   CHECKS(Chunk, chunk);
   CHECKU(Arena, chunk->arena);
   CHECKL(chunk->serial < chunk->arena->chunkSerial);
-  CHECKD_NOSIG(Ring, &chunk->chunkRing);
+  /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
+  CHECKL(TreeCheck(&chunk->chunkTree));
   CHECKL(ChunkPagesToSize(chunk, 1) == ChunkPageSize(chunk));
   CHECKL(ShiftCheck(ChunkPageShift(chunk)));
 
   CHECKL(chunk->base != (Addr)0);
   CHECKL(chunk->base < chunk->limit);
-  /* check chunk is in itself */
-  CHECKL(chunk->base <= (Addr)chunk);
+  /* .chunk.at.base: check chunk structure is at its own base */
+  CHECKL(chunk->base == (Addr)chunk);
   CHECKL((Addr)(chunk+1) <= chunk->limit);
-  CHECKL(ChunkSizeToPages(chunk, AddrOffset(chunk->base, chunk->limit))
-         == chunk->pages);
+  CHECKL(ChunkSizeToPages(chunk, ChunkSize(chunk)) == chunk->pages);
   /* check that the tables fit in the chunk */
   CHECKL(chunk->allocBase <= chunk->pages);
   CHECKL(chunk->allocBase >= chunk->pageTablePages);
@@ -176,14 +173,12 @@ Res ChunkInit(Chunk chunk, Arena arena,
 
   chunk->serial = (arena->chunkSerial)++;
   chunk->arena = arena;
-  RingInit(&chunk->chunkRing);
-  RingAppend(&arena->chunkRing, &chunk->chunkRing);
 
   chunk->pageSize = pageSize;
   chunk->pageShift = pageShift = SizeLog2(pageSize);
   chunk->base = base;
   chunk->limit = limit;
-  size = AddrOffset(base, limit);
+  size = ChunkSize(chunk);
 
   chunk->pages = pages = size >> pageShift;
   res = BootAlloc(&p, boot, (size_t)BTSize(pages), MPS_PF_ALIGN);
@@ -218,6 +213,9 @@ Res ChunkInit(Chunk chunk, Arena arena,
         goto failCBSInsert;
   }
 
+  TreeInit(&chunk->chunkTree);
+  SplayTreeInsert(ArenaChunkTree(arena), &chunk->chunkTree);
+
   chunk->sig = ChunkSig;
   AVERT(Chunk, chunk);
 
@@ -242,11 +240,17 @@ failAllocTable:
 
 void ChunkFinish(Chunk chunk)
 {
+  Bool res;
+
   AVERT(Chunk, chunk);
   AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
-  ChunkDecache(chunk->arena, chunk);
+
+  res = SplayTreeDelete(ArenaChunkTree(ChunkArena(chunk)), &chunk->chunkTree);
+  AVER(res);
+
   chunk->sig = SigInvalid;
-  RingRemove(&chunk->chunkRing);
+
+  TreeFinish(&chunk->chunkTree);
 
   if (ChunkArena(chunk)->hasFreeCBS)
     ArenaFreeCBSDelete(ChunkArena(chunk),
@@ -262,92 +266,39 @@ void ChunkFinish(Chunk chunk)
 }
 
 
-/* Chunk Cache
- *
- * Functions for manipulating the chunk cache in the arena.
- */
+/* ChunkCompare -- Compare key to [base,limit) */
 
-
-/* ChunkCacheEntryCheck -- check a chunk cache entry
- *
- * The cache is EITHER empty:
- *   - chunk is null; AND
- *   - base & limit are both null
- * OR full:
- *   - chunk is non-null, points to a ChunkStruct; AND
- *   - base & limit are not both null;
- *
- * .chunk.empty.fields: Fields of an empty cache are nonetheless read, 
- * and must be correct.
- */
-
-Bool ChunkCacheEntryCheck(ChunkCacheEntry entry)
+Compare ChunkCompare(Tree tree, TreeKey key)
 {
-  CHECKS(ChunkCacheEntry, entry);
-  if (entry->chunk == NULL) {
-    CHECKL(entry->base == NULL);   /* .chunk.empty.fields */
-    CHECKL(entry->limit == NULL);  /* .chunk.empty.fields */
-  } else {
-    CHECKL(!(entry->base == NULL && entry->limit == NULL));
-    CHECKD(Chunk, entry->chunk);
-    CHECKL(entry->base == entry->chunk->base);
-    CHECKL(entry->limit == entry->chunk->limit);
-  }
-  return TRUE;
-}
+  Addr base1, base2, limit2;
+  Chunk chunk;
 
+  AVERT_CRITICAL(Tree, tree);
+  AVER_CRITICAL(tree != TreeEMPTY);
 
-/* ChunkCacheEntryInit -- initialize a chunk cache entry */
-
-void ChunkCacheEntryInit(ChunkCacheEntry entry)
-{
-  entry->chunk = NULL;
-  entry->base = NULL;   /* .chunk.empty.fields */
-  entry->limit = NULL;  /* .chunk.empty.fields */
-  entry->sig = ChunkCacheEntrySig;
-  AVERT(ChunkCacheEntry, entry);
-  return;
-}
-
-
-/* ChunkEncache -- cache a chunk */
-
-static void ChunkEncache(Arena arena, Chunk chunk)
-{
-  /* [Critical path](../design/critical-path.txt); called by ChunkOfAddr */
-  AVERT_CRITICAL(Arena, arena);
+  chunk = ChunkOfTree(tree);
   AVERT_CRITICAL(Chunk, chunk);
-  AVER_CRITICAL(arena == chunk->arena);
-  AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
 
-  /* check chunk already in cache first */
-  if (arena->chunkCache.chunk == chunk) {
-    return;
-  }
+  base1 = AddrOfTreeKey(key);
+  base2 = chunk->base;
+  limit2 = chunk->limit;
 
-  arena->chunkCache.chunk = chunk;
-  arena->chunkCache.base = chunk->base;
-  arena->chunkCache.limit = chunk->limit;
-
-  AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
-  return;
+  if (base1 < base2)
+    return CompareLESS;
+  else if (base1 >= limit2)
+    return CompareGREATER;
+  else
+    return CompareEQUAL;
 }
 
 
-/* ChunkDecache -- make sure a chunk is not in the cache */
+/* ChunkKey -- Return the key corresponding to a chunk */
 
-static void ChunkDecache(Arena arena, Chunk chunk)
+TreeKey ChunkKey(Tree tree)
 {
-  AVERT(Arena, arena);
-  AVERT(Chunk, chunk);
-  AVER(arena == chunk->arena);
-  AVERT(ChunkCacheEntry, &arena->chunkCache);
-  if (arena->chunkCache.chunk == chunk) {
-    arena->chunkCache.chunk = NULL;
-    arena->chunkCache.base = NULL;   /* .chunk.empty.fields */
-    arena->chunkCache.limit = NULL;  /* .chunk.empty.fields */
-  }
-  AVERT(ChunkCacheEntry, &arena->chunkCache);
+  /* See .chunk.at.base. */
+  Chunk chunk = ChunkOfTree(tree);
+  return TreeKeyOfAddrVar(chunk);
 }
 
 
@@ -355,58 +306,42 @@ static void ChunkDecache(Arena arena, Chunk chunk)
 
 Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 {
-  Ring node, next;
+  Tree tree;
 
   AVER_CRITICAL(chunkReturn != NULL);
   AVERT_CRITICAL(Arena, arena);
   /* addr is arbitrary */
 
-  /* check cache first; see also .chunk.empty.fields */
-  AVERT_CRITICAL(ChunkCacheEntry, &arena->chunkCache);
-  if (arena->chunkCache.base <= addr && addr < arena->chunkCache.limit) {
-    *chunkReturn = arena->chunkCache.chunk;
-    AVER_CRITICAL(*chunkReturn != NULL);
+  if (SplayTreeFind(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr))) {
+    Chunk chunk = ChunkOfTree(tree);
+    AVER_CRITICAL(chunk->base <= addr && addr < chunk->limit);
+    *chunkReturn = chunk;
     return TRUE;
   }
-  RING_FOR(node, &arena->chunkRing, next) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-    if (chunk->base <= addr && addr < chunk->limit) {
-      /* Gotcha! */
-      ChunkEncache(arena, chunk);
-      *chunkReturn = chunk;
-      return TRUE;
-    }
-  }
   return FALSE;
 }
 
 
-/* ChunkOfNextAddr
+/* chunkAboveAddr
  *
- * Finds the next higher chunk in memory which does _not_ contain addr.
- * Returns FALSE if there is none.
- *
- * [The name is misleading; it should be "NextChunkAboveAddr" -- the 
- * word "Next" applies to chunks, not to addrs.  RHSK 2010-03-20.]
+ * Finds the next higher chunk in memory which does _not_ contain
+ * addr. If there is such a chunk, update *chunkReturn and return
+ * TRUE, otherwise return FALSE.
  */
 
-static Bool ChunkOfNextAddr(Chunk *chunkReturn, Arena arena, Addr addr)
+static Bool chunkAboveAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 {
-  Addr leastBase;
-  Chunk leastChunk;
-  Ring node, next;
+  Tree tree;
 
-  leastBase = (Addr)(Word)-1;
-  leastChunk = NULL;
-  RING_FOR(node, &arena->chunkRing, next) {
-    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
-    if (addr < chunk->base && chunk->base < leastBase) {
-      leastBase = chunk->base;
-      leastChunk = chunk;
-    }
-  }
-  if (leastChunk != NULL) {
-    *chunkReturn = leastChunk;
+  AVER_CRITICAL(chunkReturn != NULL);
+  AVERT_CRITICAL(Arena, arena);
+  /* addr is arbitrary */
+
+  tree = SplayTreeNext(ArenaChunkTree(arena), TreeKeyOfAddrVar(addr));
+  if (tree != TreeEMPTY) {
+    Chunk chunk = ChunkOfTree(tree);
+    AVER_CRITICAL(addr < chunk->base);
+    *chunkReturn = chunk;
     return TRUE;
   }
   return FALSE;
@@ -440,6 +375,24 @@ Index IndexOfAddr(Chunk chunk, Addr addr)
 }
 
 
+/* ChunkNodeDescribe -- describe a single node in the tree of chunks,
+ * for SplayTreeDescribe
+ */
+
+Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream)
+{
+  Chunk chunk;
+
+  if (!TreeCheck(node)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+  chunk = ChunkOfTree(node);
+  if (!TESTT(Chunk, chunk)) return ResFAIL;
+
+  return WriteF(stream, "[$P,$P)", (WriteFP)chunk->base,
+                (WriteFP)chunk->limit, NULL);
+}
+
+
 /* Page table functions */
 
 /* .tract.critical: These Tract functions are low-level and are on
@@ -562,7 +515,7 @@ static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
       return TRUE;
     }
   }
-  while (ChunkOfNextAddr(&chunk, arena, addr)) {
+  while (chunkAboveAddr(&chunk, arena, addr)) {
     /* If the ring was kept in address order, this could be improved. */
     addr = chunk->base;
     /* Start from allocBase to skip the tables. */
diff --git a/mps/code/tract.h b/mps/code/tract.h
index c359032feee..7aa20572bd7 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -9,8 +9,9 @@
 #define tract_h
 
 #include "mpmtypes.h"
-#include "ring.h"
 #include "bt.h"
+#include "ring.h"
+#include "tree.h"
 
 
 /* Page states
@@ -137,7 +138,7 @@ typedef struct ChunkStruct {
   Sig sig;              /* <design/sig/> */
   Serial serial;        /* serial within the arena */
   Arena arena;          /* parent arena */
-  RingStruct chunkRing; /* ring of all chunks in arena */
+  TreeStruct chunkTree; /* node in tree of all chunks in arena */
   Size pageSize;        /* size of pages */
   Shift pageShift;      /* log2 of page size, for shifts */
   Addr base;            /* base address of chunk */
@@ -151,21 +152,24 @@ typedef struct ChunkStruct {
 
 
 #define ChunkArena(chunk) RVALUE((chunk)->arena)
+#define ChunkSize(chunk) AddrOffset((chunk)->base, (chunk)->limit)
 #define ChunkPageSize(chunk) RVALUE((chunk)->pageSize)
 #define ChunkPageShift(chunk) RVALUE((chunk)->pageShift)
 #define ChunkPagesToSize(chunk, pages) ((Size)(pages) << (chunk)->pageShift)
 #define ChunkSizeToPages(chunk, size) ((Count)((size) >> (chunk)->pageShift))
 #define ChunkPage(chunk, pi) (&(chunk)->pageTable[pi])
+#define ChunkOfTree(tree) PARENT(ChunkStruct, chunkTree, tree)
 
 extern Bool ChunkCheck(Chunk chunk);
-extern Res ChunkInit(Chunk chunk, Arena arena,
-                     Addr base, Addr limit, Align pageSize, BootBlock boot);
+extern Res ChunkInit(Chunk chunk, Arena arena, Addr base, Addr limit,
+                     Align pageSize, BootBlock boot);
 extern void ChunkFinish(Chunk chunk);
-
+extern Compare ChunkCompare(Tree tree, TreeKey key);
+extern TreeKey ChunkKey(Tree tree);
 extern Bool ChunkCacheEntryCheck(ChunkCacheEntry entry);
 extern void ChunkCacheEntryInit(ChunkCacheEntry entry);
-
 extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr);
+extern Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream);
 
 /* CHUNK_OF_ADDR -- return the chunk containing an address
  *
@@ -173,9 +177,7 @@ extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr);
  */
 
 #define CHUNK_OF_ADDR(chunkReturn, arena, addr) \
-  (((arena)->chunkCache.base <= (addr) && (addr) < (arena)->chunkCache.limit) \
-   ? (*(chunkReturn) = (arena)->chunkCache.chunk, TRUE) \
-   : ChunkOfAddr(chunkReturn, arena, addr))
+  ChunkOfAddr(chunkReturn, arena, addr)
 
 
 /* AddrPageBase -- the base of the page this address is on */
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 69ee841d3c3..159550406ac 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -40,6 +40,17 @@ typedef Compare (*TreeCompare)(Tree tree, TreeKey key);
 typedef TreeKey (*TreeKeyMethod)(Tree tree);
 
 
+/* When storing Addrs in a tree, it is fastest to cast the Addr
+ * directly to a TreeKey. This assumes that Addr and TreeKey are
+ * compatible, possibly breaking <design/type/#addr.use>. On an exotic
+ * platform where the types are not convertible, take the address of
+ * the variable in TreeKeyOfAddrVar, and dereference the address in
+ * AddrOfTreeKey.
+ */
+#define TreeKeyOfAddrVar(var) ((TreeKey)(var))
+#define AddrOfTreeKey(key) ((Addr)(key))
+
+
 /* TreeEMPTY -- the empty tree
  *
  * TreeEMPTY is the tree with no nodes, and hence unable to satisfy its

From e2d346aa6701d8abc3fda16cc958bac8481e8976 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 18 May 2014 22:27:07 +0100
Subject: [PATCH 32/70] No need to store primary chunk in the closure: can get
 it via the arena.

Copied from Perforce
 Change: 186164
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 8a70303386f..2453769fca9 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -609,7 +609,6 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
 typedef struct ArenaAllocPageClosureStruct {
   Arena arena;
   Pool pool;
-  Chunk avoid;
   Addr base;
 } ArenaAllocPageClosureStruct, *ArenaAllocPageClosure;
 
@@ -628,7 +627,8 @@ static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
   AVER(cl->arena == ChunkArena(chunk));
   UNUSED(closureS);
 
-  if (chunk == cl->avoid)
+  /* Already searched in arenaAllocPage. */
+  if (chunk == cl->arena->primary)
     return TRUE;
   
   if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
@@ -663,7 +663,6 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   if (arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0) == FALSE)
     goto found;
 
-  closure.avoid = arena->primary;
   if (SplayTreeTraverse(ArenaChunkTree(arena), arenaAllocPageInChunk, &closure, 0)
       == FALSE)
     goto found;

From 632ac692a55c02fe72abe2cda03002486d65aeab Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 19 May 2014 12:24:11 +0100
Subject: [PATCH 33/70] Restore "avoid" mechanism in arenaallocpage.

Make sure that we can tear down the arena if ArenaCreate fails:
1. Don't set hasFreeCBS until the block pool has some pages.
2. Finish the CBS block pool in ArenaFinish, not ArenaDestroy.
3. Delete the chunk from the arena's free CBS before destroying the chunk, just in case the chunk contains pages from the CBS's block pool.

Copied from Perforce
 Change: 186177
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c |  9 ++++++---
 mps/code/tract.c | 12 ++++++------
 2 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 2453769fca9..36c989853cb 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -305,13 +305,13 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
 
   /* With the primary chunk initialised we can add page memory to the freeCBS
      that describes the free address space in the primary chunk. */
-  arena->hasFreeCBS = TRUE;
   res = ArenaFreeCBSInsert(arena,
                            PageIndexBase(arena->primary,
                                          arena->primary->allocBase),
                            arena->primary->limit);
   if (res != ResOK)
     goto failPrimaryCBS;
+  arena->hasFreeCBS = TRUE;
   
   res = ControlInit(arena);
   if (res != ResOK)
@@ -344,6 +344,7 @@ failInit:
 
 void ArenaFinish(Arena arena)
 {
+  PoolFinish(ArenaCBSBlockPool(arena));
   ReservoirFinish(ArenaReservoir(arena));
   arena->sig = SigInvalid;
   GlobalsFinish(ArenaGlobals(arena));
@@ -388,7 +389,6 @@ void ArenaDestroy(Arena arena)
      that would use the ZonedCBS. */
   MFSFinishTracts(ArenaCBSBlockPool(arena),
                   arenaMFSPageFreeVisitor, NULL, 0);
-  PoolFinish(ArenaCBSBlockPool(arena));
 
   /* Call class-specific finishing.  This will call ArenaFinish. */
   (*arena->class->finish)(arena);
@@ -610,6 +610,7 @@ typedef struct ArenaAllocPageClosureStruct {
   Arena arena;
   Pool pool;
   Addr base;
+  Chunk avoid;
 } ArenaAllocPageClosureStruct, *ArenaAllocPageClosure;
 
 static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
@@ -628,7 +629,7 @@ static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
   UNUSED(closureS);
 
   /* Already searched in arenaAllocPage. */
-  if (chunk == cl->arena->primary)
+  if (chunk == cl->avoid)
     return TRUE;
   
   if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
@@ -656,6 +657,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   closure.arena = arena;
   closure.pool = pool;
   closure.base = NULL;
+  closure.avoid = NULL;
 
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
@@ -663,6 +665,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   if (arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0) == FALSE)
     goto found;
 
+  closure.avoid = arena->primary;
   if (SplayTreeTraverse(ArenaChunkTree(arena), arenaAllocPageInChunk, &closure, 0)
       == FALSE)
     goto found;
diff --git a/mps/code/tract.c b/mps/code/tract.c
index dd2c2d6cd57..01bc65cd160 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -210,7 +210,7 @@ Res ChunkInit(Chunk chunk, Arena arena,
                              PageIndexBase(chunk, chunk->allocBase),
                              chunk->limit);
     if (res != ResOK)
-        goto failCBSInsert;
+      goto failCBSInsert;
   }
 
   TreeInit(&chunk->chunkTree);
@@ -245,6 +245,11 @@ void ChunkFinish(Chunk chunk)
   AVERT(Chunk, chunk);
   AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
 
+  if (ChunkArena(chunk)->hasFreeCBS)
+    ArenaFreeCBSDelete(ChunkArena(chunk),
+                       PageIndexBase(chunk, chunk->allocBase),
+                       chunk->limit);
+
   res = SplayTreeDelete(ArenaChunkTree(ChunkArena(chunk)), &chunk->chunkTree);
   AVER(res);
 
@@ -252,11 +257,6 @@ void ChunkFinish(Chunk chunk)
 
   TreeFinish(&chunk->chunkTree);
 
-  if (ChunkArena(chunk)->hasFreeCBS)
-    ArenaFreeCBSDelete(ChunkArena(chunk),
-                       PageIndexBase(chunk, chunk->allocBase),
-                       chunk->limit);
-
   if (chunk->arena->primary == chunk)
     chunk->arena->primary = NULL;
 

From 15b35c6e1c7c4762edaaaed162dd04c08c48abd7 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 19 May 2014 13:47:56 +0100
Subject: [PATCH 34/70] New function splaydebugcount counts the number of items
 in a splay tree (while checking its consistency).

Copied from Perforce
 Change: 186182
 ServerID: perforce.ravenbrook.com
---
 mps/code/splay.c | 15 +++++++++++++++
 mps/code/splay.h |  2 +-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/mps/code/splay.c b/mps/code/splay.c
index e3d15e85037..41cc3069412 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -164,6 +164,21 @@ void SplayDebugUpdate(SplayTree splay, Tree tree)
 }
 
 
+/* SplayDebugCount -- count and check order of tree
+ *
+ * This function may be called from a debugger or temporarily inserted
+ * during development to check a tree's integrity.  It may not be called
+ * from the production MPS because it uses indefinite stack depth.
+ * See <code/tree.c#.note.stack>.
+ */
+
+Count SplayDebugCount(SplayTree splay)
+{
+  AVERT(SplayTree, splay);
+  return TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
+}
+
+
 /* SplayZig -- move to left child, prepending to right tree
  *
  * Link the top node of the middle tree into the left child of the
diff --git a/mps/code/splay.h b/mps/code/splay.h
index 5103a2991e6..9bfb27c0ed1 100644
--- a/mps/code/splay.h
+++ b/mps/code/splay.h
@@ -77,7 +77,7 @@ extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
                              SplayNodeDescribeMethod nodeDescribe);
 
 extern void SplayDebugUpdate(SplayTree splay, Tree tree);
-
+extern Count SplayDebugCount(SplayTree splay);
 
 #endif /* splay_h */
 

From 5e702b6819be193997460e3851b3a9a9f552657b Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 19 May 2014 15:41:20 +0100
Subject: [PATCH 35/70] Gcbench now reports the number of chunks.

Copied from Perforce
 Change: 186188
 ServerID: perforce.ravenbrook.com
---
 mps/code/gcbench.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/mps/code/gcbench.c b/mps/code/gcbench.c
index c958128ce4f..8b841cbeeb0 100644
--- a/mps/code/gcbench.c
+++ b/mps/code/gcbench.c
@@ -12,6 +12,7 @@
 #include "testthr.h"
 #include "fmtdy.h"
 #include "fmtdytst.h"
+#include "mpm.h"
 
 #include <stdio.h> /* fprintf, printf, putchars, sscanf, stderr, stdout */
 #include <stdlib.h> /* alloca, exit, EXIT_FAILURE, EXIT_SUCCESS, strtoul */
@@ -244,6 +245,7 @@ static void arena_setup(gcthread_fn_t fn,
   } MPS_ARGS_END(args);
   watch(fn, name);
   mps_arena_park(arena);
+  printf("%u chunks\n", (unsigned)SplayDebugCount(ArenaChunkTree(arena)));
   mps_pool_destroy(pool);
   mps_fmt_destroy(format);
   if (ngen > 0)

From 47befaa46b1ca6ec08b66b934fc994d7b7b18522 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 19 May 2014 20:19:50 +0100
Subject: [PATCH 36/70] Use treefind instead of splaytreefind to search the
 chunk tree.

Balance the chunk tree after insertion and deletion.
Avoid calling TractFirst and TractNext in ArenaDescribeTracts and PoolOfRange.

Copied from Perforce
 Change: 186199
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c | 60 +++++++++++++++++++++++++-----------------------
 mps/code/pool.c  | 27 ++++++++++++----------
 mps/code/tract.c | 23 +++++++++++++++----
 mps/code/tract.h |  4 ++--
 mps/code/tree.c  | 12 +++-------
 5 files changed, 69 insertions(+), 57 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 36c989853cb..70e7931cb66 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -495,51 +495,53 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
 }
 
 
-/* ArenaDescribeTracts -- describe all the tracts in the arena */
+/* ArenaDescribeTractsInChunk -- describe all the tracts in a chunk */
 
-Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
+static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
 {
-  Res res;
+  mps_lib_FILE *stream = closureP;
+  Chunk chunk;
   Tract tract;
-  Bool b;
-  Addr oldLimit, base, limit;
-  Size size;
+  Addr addr;
+  Res res;
 
-  if (!TESTT(Arena, arena)) return ResFAIL;
+  chunk = ChunkOfTree(tree);
+  if (!TESTT(Chunk, chunk)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
+  UNUSED(closureS);
 
-  b = TractFirst(&tract, arena);
-  oldLimit = TractBase(tract);
-  while (b) {
-    base = TractBase(tract);
-    limit = TractLimit(tract);
-    size = ArenaAlign(arena);
-
-    if (TractBase(tract) > oldLimit) {
-      res = WriteF(stream,
-                   "[$P, $P) $W $U   ---\n",
-                   (WriteFP)oldLimit, (WriteFP)base,
-                   (WriteFW)AddrOffset(oldLimit, base),
-                   (WriteFU)AddrOffset(oldLimit, base),
-                   NULL);
-      if (res != ResOK) return res;
-    }
-
+  TRACT_TRACT_FOR(tract, addr, ChunkArena(chunk),
+                  PageTract(ChunkPage(chunk, chunk->allocBase)),
+                  chunk->limit)
+  {
     res = WriteF(stream,
-                 "[$P, $P) $W $U   $P ($S)\n",
-                 (WriteFP)base, (WriteFP)limit,
-                 (WriteFW)size, (WriteFW)size,
+                 "[$P, $P) $U   $P ($S)\n",
+                 (WriteFP)TractBase(tract), (WriteFP)TractLimit(tract),
+                 (WriteFW)ArenaAlign(ChunkArena(chunk)),
                  (WriteFP)TractPool(tract),
                  (WriteFS)(TractPool(tract)->class->name),
                  NULL);
     if (res != ResOK) return res;
-    b = TractNext(&tract, arena, TractBase(tract));
-    oldLimit = limit;
+    return ResOK;
   }
   return ResOK;
 }
 
 
+/* ArenaDescribeTracts -- describe all the tracts in the arena */
+
+Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
+{
+  if (!TESTT(Arena, arena)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  (void)SplayTreeTraverse(ArenaChunkTree(arena), arenaDescribeTractsInChunk, 
+                          stream, 0);
+
+  return ResOK;
+}
+
+
 /* ControlAlloc -- allocate a small block directly from the control pool
  *
  * .arena.control-pool: Actually the block will be allocated from the
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 5741470457a..060da7a47d5 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -625,29 +625,32 @@ Bool PoolOfAddr(Pool *poolReturn, Arena arena, Addr addr)
  */
 Bool PoolOfRange(Pool *poolReturn, Arena arena, Addr base, Addr limit)
 {
+  Bool havePool = FALSE;
   Pool pool;
   Tract tract;
+  Addr addr, alignedBase, alignedLimit;
 
   AVER(poolReturn != NULL);
   AVERT(Arena, arena);
   AVER(base < limit);
 
-  if (!TractOfAddr(&tract, arena, base)) 
-    return FALSE;
+  alignedBase = AddrAlignDown(base, ArenaAlign(arena));
+  alignedLimit = AddrAlignUp(limit, ArenaAlign(arena));
 
-  pool = TractPool(tract);
-  if (!pool)
-    return FALSE;
-
-  while (TractLimit(tract) < limit) {
-    if (!TractNext(&tract, arena, TractBase(tract)))
-      return FALSE;
-    if (TractPool(tract) != pool)
+  TRACT_FOR(tract, addr, arena, alignedBase, alignedLimit) {
+    Pool p = TractPool(tract);
+    if (havePool && pool != p)
       return FALSE;
+    pool = p;
+    havePool = TRUE;
   }
 
-  *poolReturn = pool;
-  return TRUE;
+  if (havePool) {
+    *poolReturn = pool;
+    return TRUE;
+  } else {
+    return FALSE;
+  }
 }
 
 
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 01bc65cd160..6f92178b4fe 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -160,6 +160,8 @@ Res ChunkInit(Chunk chunk, Arena arena,
   Size pageTableSize;
   void *p;
   Res res;
+  Bool inserted;
+  Tree updatedTree = NULL;
 
   /* chunk is supposed to be uninitialized, so don't check it. */
   AVERT(Arena, arena);
@@ -214,7 +216,12 @@ Res ChunkInit(Chunk chunk, Arena arena,
   }
 
   TreeInit(&chunk->chunkTree);
-  SplayTreeInsert(ArenaChunkTree(arena), &chunk->chunkTree);
+  inserted = TreeInsert(&updatedTree, SplayTreeRoot(ArenaChunkTree(arena)),
+                        &chunk->chunkTree, TreeKeyOfAddrVar(chunk),
+                        ChunkCompare);
+  AVER(inserted && updatedTree);
+  TreeBalance(&updatedTree);
+  ArenaChunkTree(arena)->root = updatedTree;
 
   chunk->sig = ChunkSig;
   AVERT(Chunk, chunk);
@@ -241,17 +248,20 @@ failAllocTable:
 void ChunkFinish(Chunk chunk)
 {
   Bool res;
+  Arena arena;
 
   AVERT(Chunk, chunk);
   AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
+  arena = ChunkArena(chunk);
 
-  if (ChunkArena(chunk)->hasFreeCBS)
-    ArenaFreeCBSDelete(ChunkArena(chunk),
+  if (arena->hasFreeCBS)
+    ArenaFreeCBSDelete(arena,
                        PageIndexBase(chunk, chunk->allocBase),
                        chunk->limit);
 
-  res = SplayTreeDelete(ArenaChunkTree(ChunkArena(chunk)), &chunk->chunkTree);
+  res = SplayTreeDelete(ArenaChunkTree(arena), &chunk->chunkTree);
   AVER(res);
+  TreeBalance(&ArenaChunkTree(arena)->root);
 
   chunk->sig = SigInvalid;
 
@@ -312,7 +322,10 @@ Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
   AVERT_CRITICAL(Arena, arena);
   /* addr is arbitrary */
 
-  if (SplayTreeFind(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr))) {
+  if (TreeFind(&tree, SplayTreeRoot(ArenaChunkTree(arena)),
+               TreeKeyOfAddrVar(addr), ChunkCompare)
+      == CompareEQUAL)
+  {
     Chunk chunk = ChunkOfTree(tree);
     AVER_CRITICAL(chunk->base <= addr && addr < chunk->limit);
     *chunkReturn = chunk;
diff --git a/mps/code/tract.h b/mps/code/tract.h
index 7aa20572bd7..b825e268c68 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -248,7 +248,7 @@ extern Bool TractFirst(Tract *tractReturn, Arena arena);
 extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
 
 
-/* TRACT_TRACT_FOR -- iterate over a range of tracts
+/* TRACT_TRACT_FOR -- iterate over a range of tracts in a chunk
  *
  * See <design/arena-tract-iter/#if.macro>.
  * Parameters arena & limit are evaluated multiple times.
@@ -265,7 +265,7 @@ extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
         (tract = NULL) /* terminate loop */))
 
 
-/* TRACT_FOR -- iterate over a range of tracts
+/* TRACT_FOR -- iterate over a range of tracts in a chunk
  *
  * See <design/arena/#tract.for>.
  * Parameters arena & limit are evaluated multiple times.
diff --git a/mps/code/tree.c b/mps/code/tree.c
index 9e19ef6edf9..0f17e0672f9 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -70,8 +70,6 @@ Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key)
 }
 
 
-#if 0 /* This code is not currently in use in the MPS */
-
 /* TreeFind -- search for a node matching the key
  *
  * If a matching node is found, sets *treeReturn to that node and returns
@@ -134,7 +132,7 @@ Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
   Compare cmp;
   
   AVER(treeReturn != NULL);
-  AVER(Tree, root);
+  AVERT(Tree, root);
   AVER(TreeCheckLeaf(node));
   AVER(FUNCHECK(compare));
   /* key is arbitrary */
@@ -166,6 +164,8 @@ Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
 }
 
 
+#if 0 /* This code is currently not in use in the MPS */
+
 /* TreeTraverseMorris -- traverse tree inorder in constant space
  *
  * The tree may not be accessed or modified during the traversal, and
@@ -432,9 +432,6 @@ Tree TreeReverseRightSpine(Tree tree)
 }
 
 
-#if 0 /* This code is currently not in use in the MPS */
-
-
 /* TreeToVine -- unbalance a tree into a single right spine */
 
 Count TreeToVine(Tree *link)
@@ -488,9 +485,6 @@ void TreeBalance(Tree *treeIO)
 }
 
 
-#endif /* not currently in use in the MPS */
-
-
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2014 Ravenbrook Limited <http://www.ravenbrook.com/>.

From 06088f0fb72035ac82997c118c299cde269db000 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 19 May 2014 20:20:09 +0100
Subject: [PATCH 37/70] Segfindaboveaddr is no longer used.

Copied from Perforce
 Change: 186200
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h |  1 -
 mps/code/seg.c | 37 -------------------------------------
 2 files changed, 38 deletions(-)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 9d5854b8cf6..5e959f1dd9c 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -659,7 +659,6 @@ extern Bool SegOfAddr(Seg *segReturn, Arena arena, Addr addr);
 extern Bool SegFirst(Seg *segReturn, Arena arena);
 extern Bool SegNext(Seg *segReturn, Arena arena, Seg seg);
 extern Bool SegNextOfRing(Seg *segReturn, Arena arena, Pool pool, Ring next);
-extern Bool SegFindAboveAddr(Seg *segReturn, Arena arena, Addr addr);
 extern void SegSetWhite(Seg seg, TraceSet white);
 extern void SegSetGrey(Seg seg, TraceSet grey);
 extern void SegSetRankSet(Seg seg, RankSet rankSet);
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 40f86081f29..a3ca5615b30 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -526,43 +526,6 @@ Bool SegNext(Seg *segReturn, Arena arena, Seg seg)
 }
 
 
-/* SegFindAboveAddr -- return the "next" seg in the arena
- *
- * Finds the seg with the lowest base address which is
- * greater than a specified address.  The address must be (or once
- * have been) the base address of a seg.
- */
-
-Bool SegFindAboveAddr(Seg *segReturn, Arena arena, Addr addr)
-{
-  Tract tract;
-  Addr base = addr;
-  AVER_CRITICAL(segReturn != NULL); /* .seg.critical */
-  AVERT_CRITICAL(Arena, arena);
-
-  while (TractNext(&tract, arena, base)) {
-    Seg seg;
-    if (TRACT_SEG(&seg, tract)) {
-      if (tract == seg->firstTract) {
-        *segReturn = seg;
-        return TRUE;
-      } else {
-        /* found the next tract in a large segment */
-        /* base & addr must be the base of this segment */
-        AVER_CRITICAL(TractBase(seg->firstTract) == addr);
-        AVER_CRITICAL(addr == base);
-        /* set base to the last tract in the segment */
-        base = AddrSub(seg->limit, ArenaAlign(arena));
-        AVER_CRITICAL(base > addr);
-      }
-    } else {
-      base = TractBase(tract);
-    }
-  }
-  return FALSE;
-}
-
-
 /* SegMerge -- Merge two adjacent segments
  *
  * See <design/seg/#merge>

From 2f0ef9355da932afb53cc343b1aebd8e8fb68173 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 20 May 2014 18:12:37 +0100
Subject: [PATCH 38/70] Clarify tracefix logic by unwinding the nested
 conditions.

Change the arena's chunk tree from a splay tree to an ordinary tree (so that it's not possible to accidentally splay it and leave it unbalanced).
New function TreeFindNext allows us to implement TractFirst and TractNext without having to splay the tree.
Make sure all operations on the chunk tree leave it balanced. But don't balance the tree directly in ChunkFinish() because this is only ever called in a loop where multiple chunks are being deleted from the tre. Instead use the sequence TreeToVine -- iterate and delete -- TreeBalance. The new macro TREE_DESTROY assists with this.
No need any more for ArenaIsReservedAddr, CHUNK_OF_ADDR, TRACT_OF_ADDR.
Update design documentation.

Copied from Perforce
 Change: 186212
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c               |  43 ++++++++--
 mps/code/arenacl.c             |   9 ++-
 mps/code/arenavm.c             |  38 ++++++---
 mps/code/gcbench.c             |   3 +-
 mps/code/mpm.h                 |   5 +-
 mps/code/mpmst.h               |   2 +-
 mps/code/trace.c               | 112 ++++++++++++++------------
 mps/code/tract.c               |  41 +++-------
 mps/code/tract.h               |  27 -------
 mps/code/tree.c                |  43 ++++++++++
 mps/code/tree.h                |  16 ++++
 mps/design/arena.txt           |  13 ++-
 mps/design/class-interface.txt |  13 ++-
 mps/design/critical-path.txt   |  21 ++---
 mps/design/scan.txt            |  16 ++--
 mps/design/trace.txt           | 140 ++++++++++++++++++++-------------
 16 files changed, 316 insertions(+), 226 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 70e7931cb66..1bee7fd7795 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -148,7 +148,7 @@ Bool ArenaCheck(Arena arena)
     CHECKD(Chunk, arena->primary);
   }
   /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
-  CHECKL(SplayTreeCheck(ArenaChunkTree(arena)));
+  CHECKL(TreeCheck(ArenaChunkTree(arena)));
   /* nothing to check for chunkSerial */
   
   CHECKL(LocusCheck(arena));
@@ -205,7 +205,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
   arena->zoned = zoned;
 
   arena->primary = NULL;
-  SplayTreeInit(ArenaChunkTree(arena), ChunkCompare, ChunkKey, SplayTrivUpdate);
+  arena->chunkTree = TreeEMPTY;
   arena->chunkSerial = (Serial)0;
   
   LocusInit(arena);
@@ -349,8 +349,7 @@ void ArenaFinish(Arena arena)
   arena->sig = SigInvalid;
   GlobalsFinish(ArenaGlobals(arena));
   LocusFinish(arena);
-  AVER(SplayTreeIsEmpty(ArenaChunkTree(arena)));
-  SplayTreeFinish(ArenaChunkTree(arena));
+  AVER(ArenaChunkTree(arena) == TreeEMPTY);
 }
 
 
@@ -535,8 +534,8 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream)
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  (void)SplayTreeTraverse(ArenaChunkTree(arena), arenaDescribeTractsInChunk, 
-                          stream, 0);
+  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
+                     arenaDescribeTractsInChunk, stream, 0);
 
   return ResOK;
 }
@@ -601,6 +600,33 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
 }
 
 
+/* ArenaChunkInsert -- insert chunk into arena's chunk tree
+ *
+ * Note that there's no corresponding ArenaChunkDelete. That's because
+ * we don't have a function that deletes an item from a balanced tree
+ * efficiently. Instead, deletions from the chunk tree are carried out
+ * by calling TreeToVine, iterating over the vine (where deletion is
+ * straightforward) and then calling TreeBalance. This is efficient
+ * when deleting all the chunks at a time in ArenaFinish, and
+ * acceptable in VMCompact when multiple chunks may be deleted from
+ * the tree.
+ */
+
+void ArenaChunkInsert(Arena arena, Tree tree) {
+  Bool inserted;
+  Tree updatedTree = NULL;
+
+  AVERT(Arena, arena);
+  AVERT(Tree, tree);
+
+  inserted = TreeInsert(&updatedTree, ArenaChunkTree(arena),
+                        tree, ChunkKey(tree), ChunkCompare);
+  AVER(inserted && updatedTree);
+  TreeBalance(&updatedTree);
+  arena->chunkTree = updatedTree;
+}
+
+
 /* arenaAllocPage -- allocate one page from the arena
  *
  * This is a primitive allocator used to allocate pages for the arena CBS.
@@ -668,7 +694,8 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
     goto found;
 
   closure.avoid = arena->primary;
-  if (SplayTreeTraverse(ArenaChunkTree(arena), arenaAllocPageInChunk, &closure, 0)
+  if (TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
+                   arenaAllocPageInChunk, &closure, 0)
       == FALSE)
     goto found;
 
@@ -907,7 +934,7 @@ static Res arenaAllocFromCBS(Tract *tractReturn, ZoneSet zones, Bool high,
   
   /* Step 2. Make memory available in the address space range. */
 
-  b = CHUNK_OF_ADDR(&chunk, arena, RangeBase(&range));
+  b = ChunkOfAddr(&chunk, arena, RangeBase(&range));
   AVER(b);
   AVER(RangeIsAligned(&range, ChunkPageSize(chunk)));
   baseIndex = INDEX_OF_ADDR(chunk, RangeBase(&range));
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 1a2c52f30e0..7d8c3143f3d 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -290,14 +290,15 @@ failChunkCreate:
 static void ClientArenaFinish(Arena arena)
 {
   ClientArena clientArena;
+  Tree *treeref, tree, next;
 
   clientArena = Arena2ClientArena(arena);
   AVERT(ClientArena, clientArena);
 
   /* destroy all chunks, including the primary */
   arena->primary = NULL;
-  while (!SplayTreeIsEmpty(ArenaChunkTree(arena))) {
-    clientChunkDestroy(ChunkOfTree(SplayTreeRoot(ArenaChunkTree(arena))));
+  TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
+    clientChunkDestroy(ChunkOfTree(tree));
   }
 
   clientArena->sig = SigInvalid;
@@ -350,8 +351,8 @@ static Size ClientArenaReserved(Arena arena)
 
   AVERT(Arena, arena);
 
-  TreeTraverse(SplayTreeRoot(ArenaChunkTree(arena)), ChunkCompare, ChunkKey,
-               clientArenaReservedVisitor, &size, 0);
+  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
+                     clientArenaReservedVisitor, &size, 0);
 
   return size;
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index e5343c1329a..210c943d047 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -589,6 +589,7 @@ static void VMArenaFinish(Arena arena)
 {
   VMArena vmArena;
   VM arenaVM;
+  Tree *treeref, tree, next;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -598,10 +599,10 @@ static void VMArenaFinish(Arena arena)
 
   /* destroy all chunks, including the primary */
   arena->primary = NULL;
-  while (!SplayTreeIsEmpty(ArenaChunkTree(arena))) {
-    vmChunkDestroy(ChunkOfTree(SplayTreeRoot(ArenaChunkTree(arena))));
+  TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
+    vmChunkDestroy(ChunkOfTree(tree));
   }
-  
+
   /* Destroying the chunks should have purged and removed all spare pages. */
   RingFinish(&vmArena->spareRing);
 
@@ -645,8 +646,8 @@ static Size VMArenaReserved(Arena arena)
 
   AVERT(Arena, arena);
 
-  TreeTraverse(SplayTreeRoot(ArenaChunkTree(arena)), ChunkCompare, ChunkKey,
-               vmArenaReservedVisitor, &size, 0);
+  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
+                     vmArenaReservedVisitor, &size, 0);
 
   return size;
 }
@@ -1067,8 +1068,9 @@ static void VMFree(Addr base, Size size, Pool pool)
   BTResRange(chunk->allocTable, piBase, piLimit);
 
   /* Consider returning memory to the OS. */
-  /* TODO: Chunks are only destroyed when ArenaCompact is called, and that is
-     only called from TraceReclaim.  Should consider destroying chunks here. */
+  /* TODO: Chunks are only destroyed when ArenaCompact is called, and
+     that is only called from traceReclaim. Should consider destroying
+     chunks here. See job003815. */
   if (arena->spareCommitted > arena->spareCommitLimit) {
     /* Purge half of the spare memory, not just the extra sliver, so
        that we return a reasonable amount of memory in one go, and avoid
@@ -1085,7 +1087,7 @@ static void VMCompact(Arena arena, Trace trace)
 {
   VMArena vmArena;
   Size vmem1;
-  Tree tree;
+  Tree *tree;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -1093,21 +1095,31 @@ static void VMCompact(Arena arena, Trace trace)
 
   vmem1 = VMArenaReserved(arena);
 
-  tree = SplayTreeFirst(ArenaChunkTree(arena));
-  while (tree != TreeEMPTY) {
-    Chunk chunk = ChunkOfTree(tree);
-    TreeKey key = ChunkKey(tree);
+  /* Destroy all the chunks that are completely free. Be very careful
+   * about the order of operations on the tree because vmChunkDestroy
+   * unmaps the memory that the tree node resides in, so the next tree
+   * node has to be looked up first. TODO: add hysteresis here. See
+   * job003815. */
+  tree = &arena->chunkTree;
+  TreeToVine(tree);
+  while (*tree != TreeEMPTY) {
+    Chunk chunk = ChunkOfTree(*tree);
     AVERT(Chunk, chunk);
     if(chunk != arena->primary
        && BTIsResRange(chunk->allocTable, 0, chunk->pages))
     {
       Addr base = chunk->base;
       Size size = ChunkSize(chunk);
+      Tree next = TreeRight(*tree);
       vmChunkDestroy(chunk);
       vmArena->contracted(arena, base, size);
+      *tree = next;
+    } else {
+      tree = &(*tree)->right;
     }
-    tree = SplayTreeNext(ArenaChunkTree(arena), key);
   }
+  TreeBalance(&arena->chunkTree);
+
   {
     Size vmem0 = trace->preTraceArenaReserved;
     Size vmem2 = VMArenaReserved(arena);
diff --git a/mps/code/gcbench.c b/mps/code/gcbench.c
index 8b841cbeeb0..09add03a10b 100644
--- a/mps/code/gcbench.c
+++ b/mps/code/gcbench.c
@@ -245,7 +245,8 @@ static void arena_setup(gcthread_fn_t fn,
   } MPS_ARGS_END(args);
   watch(fn, name);
   mps_arena_park(arena);
-  printf("%u chunks\n", (unsigned)SplayDebugCount(ArenaChunkTree(arena)));
+  printf("%u chunks\n", (unsigned)TreeDebugCount(ArenaChunkTree(arena),
+                                                 ChunkCompare, ChunkKey));
   mps_pool_destroy(pool);
   mps_fmt_destroy(format);
   if (ngen > 0)
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 33c994c1236..1457677e9df 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -518,7 +518,7 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
 #define ArenaAlign(arena)       ((arena)->alignment)
 #define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
 #define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
-#define ArenaChunkTree(arena) (&(arena)->chunkTree)
+#define ArenaChunkTree(arena) RVALUE((arena)->chunkTree)
 
 extern void ArenaEnterLock(Arena arena, Bool recursive);
 extern void ArenaLeaveLock(Arena arena, Bool recursive);
@@ -551,6 +551,7 @@ extern Res ArenaStartCollect(Globals globals, int why);
 extern Res ArenaCollect(Globals globals, int why);
 extern Bool ArenaHasAddr(Arena arena, Addr addr);
 extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
+extern void ArenaChunkInsert(Arena arena, Tree tree);
 
 extern void ArenaSetEmergency(Arena arena, Bool emergency);
 extern Bool ArenaEmergency(Arena arean);
@@ -615,8 +616,6 @@ extern void ArenaCompact(Arena arena, Trace trace);
 extern Res ArenaFinalize(Arena arena, Ref obj);
 extern Res ArenaDefinalize(Arena arena, Ref obj);
 
-extern Bool ArenaIsReservedAddr(Arena arena, Addr addr);
-
 #define ArenaReservoir(arena) (&(arena)->reservoirStruct)
 #define ReservoirPool(reservoir) (&(reservoir)->poolStruct)
 
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 7334ab56fa4..aa5324e9f27 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -645,7 +645,7 @@ typedef struct mps_arena_s {
   Addr lastTractBase;           /* base address of lastTract */
 
   Chunk primary;                /* the primary chunk */
-  SplayTreeStruct chunkTree;    /* all the chunks */
+  Tree chunkTree;               /* all the chunks */
   Serial chunkSerial;           /* next chunk number */
 
   Bool hasFreeCBS;              /* Is freeCBS available? */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 219c6d89a2c..db00cb6a201 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1259,7 +1259,12 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
 {
   ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss);
   Ref ref;
+  Chunk chunk;
+  Index i;
   Tract tract;
+  Seg seg;
+  Res res;
+  Pool pool;
 
   /* Special AVER macros are used on the critical path. */
   /* See <design/trace/#fix.noaver> */
@@ -1276,59 +1281,64 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
   STATISTIC(++ss->fixRefCount);
   EVENT4(TraceFix, ss, mps_ref_io, ref, ss->rank);
 
-  TRACT_OF_ADDR(&tract, ss->arena, ref);
-  if(tract) {
-    if(TraceSetInter(TractWhite(tract), ss->traces) != TraceSetEMPTY) {
-      Seg seg;
-      if(TRACT_SEG(&seg, tract)) {
-        Res res;
-        Pool pool;
-        STATISTIC(++ss->segRefCount);
-        STATISTIC(++ss->whiteSegRefCount);
-        EVENT1(TraceFixSeg, seg);
-        EVENT0(TraceFixWhite);
-        pool = TractPool(tract);
-        res = (*ss->fix)(pool, ss, seg, &ref);
-        if(res != ResOK) {
-          /* PoolFixEmergency should never fail. */
-          AVER_CRITICAL(ss->fix != PoolFixEmergency);
-          /* Fix protocol (de facto): if Fix fails, ref must be unchanged
-           * Justification for this restriction:
-           * A: it simplifies;
-           * B: it's reasonable (given what may cause Fix to fail);
-           * C: the code (here) already assumes this: it returns without 
-           *    updating ss->fixedSummary.  RHSK 2007-03-21.
-           */
-          AVER(ref == (Ref)*mps_ref_io);
-          return res;
-        }
-      } else {
-        /* Only tracts with segments ought to have been condemned. */
-        /* SegOfAddr FALSE => a ref into a non-seg Tract (poolmv etc) */
-        /* .notwhite: ...But it should NOT be white.  
-         * [I assert this both from logic, and from inspection of the 
-         * current condemn code.  RHSK 2010-11-30]
-         */
-        NOTREACHED;
-      }
-    } else {
-      /* Tract isn't white. Don't compute seg for non-statistical */
-      /* variety. See <design/trace/#fix.tractofaddr> */
-      STATISTIC_STAT
-        ({
-          Seg seg;
-          if(TRACT_SEG(&seg, tract)) {
-            ++ss->segRefCount;
-            EVENT1(TraceFixSeg, seg);
-          }
-        });
-    }
-  } else {
-    /* See <design/trace/#exact.legal> */
-    AVER(ss->rank < RankEXACT
-         || !ArenaIsReservedAddr(ss->arena, ref));
+  /* This sequence of tests is equivalent to calling TractOfAddr(),
+   * but inlined so that we can distinguish between "not pointing to
+   * chunk" and "pointing to chunk but not to tract" so that we can
+   * check the rank in the latter case. See
+   * <design/trace/#fix.tractofaddr.inline> */
+  if (!ChunkOfAddr(&chunk, ss->arena, ref))
+    /* Reference points outside MPS-managed address space: ignore. */
+    goto done;
+
+  i = INDEX_OF_ADDR(chunk, ref);
+  if (!BTGet(chunk->allocTable, i)) {
+    /* Reference points into a chunk but not to an allocated tract.
+     * See <design/trace/#exact.legal> */
+    AVER_CRITICAL(ss->rank < RankEXACT);
+    goto done;
   }
 
+  tract = PageTract(&chunk->pageTable[i]);
+  if (TraceSetInter(TractWhite(tract), ss->traces) == TraceSetEMPTY) {
+    /* Reference points to a tract that is not white for any of the
+     * active traces. See <design/trace/#fix.tractofaddr> */
+    STATISTIC_STAT
+      ({
+        if(TRACT_SEG(&seg, tract)) {
+          ++ss->segRefCount;
+          EVENT1(TraceFixSeg, seg);
+        }
+      });
+    goto done;
+  }
+
+  if (!TRACT_SEG(&seg, tract)) {
+    /* Tracts without segments must not be condemned. */
+    NOTREACHED;
+    goto done;
+  }
+
+  STATISTIC(++ss->segRefCount);
+  STATISTIC(++ss->whiteSegRefCount);
+  EVENT1(TraceFixSeg, seg);
+  EVENT0(TraceFixWhite);
+  pool = TractPool(tract);
+  res = (*ss->fix)(pool, ss, seg, &ref);
+  if (res != ResOK) {
+    /* PoolFixEmergency must not fail. */
+    AVER_CRITICAL(ss->fix != PoolFixEmergency);
+    /* Fix protocol (de facto): if Fix fails, ref must be unchanged
+     * Justification for this restriction:
+     * A: it simplifies;
+     * B: it's reasonable (given what may cause Fix to fail);
+     * C: the code (here) already assumes this: it returns without 
+     *    updating ss->fixedSummary.  RHSK 2007-03-21.
+     */
+    AVER_CRITICAL(ref == (Ref)*mps_ref_io);
+    return res;
+  }
+
+done:
   /* See <design/trace/#fix.fixed.all> */
   ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, ref);
   
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 6f92178b4fe..2a688bf5ea3 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -160,8 +160,6 @@ Res ChunkInit(Chunk chunk, Arena arena,
   Size pageTableSize;
   void *p;
   Res res;
-  Bool inserted;
-  Tree updatedTree = NULL;
 
   /* chunk is supposed to be uninitialized, so don't check it. */
   AVERT(Arena, arena);
@@ -216,16 +214,12 @@ Res ChunkInit(Chunk chunk, Arena arena,
   }
 
   TreeInit(&chunk->chunkTree);
-  inserted = TreeInsert(&updatedTree, SplayTreeRoot(ArenaChunkTree(arena)),
-                        &chunk->chunkTree, TreeKeyOfAddrVar(chunk),
-                        ChunkCompare);
-  AVER(inserted && updatedTree);
-  TreeBalance(&updatedTree);
-  ArenaChunkTree(arena)->root = updatedTree;
 
   chunk->sig = ChunkSig;
   AVERT(Chunk, chunk);
 
+  ArenaChunkInsert(arena, &chunk->chunkTree);
+
   /* As part of the bootstrap, the first created chunk becomes the primary
      chunk.  This step allows AreaFreeCBSInsert to allocate pages. */
   if (arena->primary == NULL)
@@ -247,10 +241,10 @@ failAllocTable:
 
 void ChunkFinish(Chunk chunk)
 {
-  Bool res;
   Arena arena;
 
   AVERT(Chunk, chunk);
+
   AVER(BTIsResRange(chunk->allocTable, 0, chunk->pages));
   arena = ChunkArena(chunk);
 
@@ -259,10 +253,6 @@ void ChunkFinish(Chunk chunk)
                        PageIndexBase(chunk, chunk->allocBase),
                        chunk->limit);
 
-  res = SplayTreeDelete(ArenaChunkTree(arena), &chunk->chunkTree);
-  AVER(res);
-  TreeBalance(&ArenaChunkTree(arena)->root);
-
   chunk->sig = SigInvalid;
 
   TreeFinish(&chunk->chunkTree);
@@ -322,8 +312,8 @@ Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
   AVERT_CRITICAL(Arena, arena);
   /* addr is arbitrary */
 
-  if (TreeFind(&tree, SplayTreeRoot(ArenaChunkTree(arena)),
-               TreeKeyOfAddrVar(addr), ChunkCompare)
+  if (TreeFind(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
+               ChunkCompare)
       == CompareEQUAL)
   {
     Chunk chunk = ChunkOfTree(tree);
@@ -345,14 +335,16 @@ Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 static Bool chunkAboveAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 {
   Tree tree;
+  Chunk chunk;
 
   AVER_CRITICAL(chunkReturn != NULL);
   AVERT_CRITICAL(Arena, arena);
   /* addr is arbitrary */
 
-  tree = SplayTreeNext(ArenaChunkTree(arena), TreeKeyOfAddrVar(addr));
-  if (tree != TreeEMPTY) {
-    Chunk chunk = ChunkOfTree(tree);
+  if (TreeFindNext(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
+                   ChunkCompare))
+  {
+    chunk = ChunkOfTree(tree);
     AVER_CRITICAL(addr < chunk->base);
     *chunkReturn = chunk;
     return TRUE;
@@ -361,19 +353,6 @@ static Bool chunkAboveAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 }
 
 
-/* ArenaIsReservedAddr -- is address managed by this arena? */
-
-Bool ArenaIsReservedAddr(Arena arena, Addr addr)
-{
-  Chunk dummy;
-
-  AVERT(Arena, arena);
-  /* addr is arbitrary */
-
-  return ChunkOfAddr(&dummy, arena, addr);
-}
-
-
 /* IndexOfAddr -- return the index of the page containing an address
  *
  * Function version of INDEX_OF_ADDR, for debugging purposes.
diff --git a/mps/code/tract.h b/mps/code/tract.h
index b825e268c68..0b9a86d1df2 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -171,14 +171,6 @@ extern void ChunkCacheEntryInit(ChunkCacheEntry entry);
 extern Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr);
 extern Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream);
 
-/* CHUNK_OF_ADDR -- return the chunk containing an address
- *
- * arena and addr are evaluated multiple times.
- */
-
-#define CHUNK_OF_ADDR(chunkReturn, arena, addr) \
-  ChunkOfAddr(chunkReturn, arena, addr)
-
 
 /* AddrPageBase -- the base of the page this address is on */
 
@@ -191,25 +183,6 @@ extern Res ChunkNodeDescribe(Tree node, mps_lib_FILE *stream);
 extern Tract TractOfBaseAddr(Arena arena, Addr addr);
 extern Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr);
 
-/* TRACT_OF_ADDR -- return the tract containing an address */
-
-#define TRACT_OF_ADDR(tractReturn, arena, addr) \
-  BEGIN \
-    Arena _arena = (arena); \
-    Addr _addr = (addr); \
-    Chunk _chunk; \
-    Index _i; \
-    \
-    if (CHUNK_OF_ADDR(&_chunk, _arena, _addr)) { \
-      _i = INDEX_OF_ADDR(_chunk, _addr); \
-      if (BTGet(_chunk->allocTable, _i)) \
-        *(tractReturn) = PageTract(&_chunk->pageTable[_i]); \
-      else \
-        *(tractReturn) = NULL; \
-    } else \
-        *(tractReturn) = NULL; \
-  END
-
 
 /* INDEX_OF_ADDR -- return the index of the page containing an address
  *
diff --git a/mps/code/tree.c b/mps/code/tree.c
index 0f17e0672f9..0e1bb372f65 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -117,6 +117,49 @@ Compare TreeFind(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
 }
 
 
+/* TreeFindNext -- search for node containing key, or next node
+ *
+ * If there is a node that is greater than key, set treeReturn to that
+ * node and return TRUE.
+ *
+ * Otherwise, key is greater than all nodes in the tree, so leave
+ * treeReturn unchanged and return FALSE.
+ */
+
+Bool TreeFindNext(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
+{
+  Tree node, best = NULL;
+  Bool result = FALSE;
+
+  AVERT(Tree, root);
+  AVER(treeReturn != NULL);
+  AVER(FUNCHECK(compare));
+  /* key is arbitrary */
+
+  node = root;
+  while (node != TreeEMPTY) {
+    Compare cmp = compare(node, key);
+    switch (cmp) {
+    case CompareLESS:
+      best = node;
+      result = TRUE;
+      node = node->left;
+      break;
+    case CompareEQUAL:
+    case CompareGREATER:
+      node = node->right;
+      break;
+    default:
+      NOTREACHED;
+      return FALSE;
+    }
+  }
+  
+  *treeReturn = best;
+  return result;
+}
+
+
 /* TreeInsert -- insert a node into a tree
  *
  * If the key doesn't exist in the tree, inserts a node as a leaf of the
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 159550406ac..757344c2c64 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -113,6 +113,8 @@ extern Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key);
 
 extern Compare TreeFind(Tree *treeReturn, Tree root,
                         TreeKey key, TreeCompare compare);
+extern Bool TreeFindNext(Tree *treeReturn, Tree root,
+                         TreeKey key, TreeCompare compare);
 
 extern Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
                        TreeKey key, TreeCompare compare);
@@ -132,6 +134,20 @@ extern Tree TreeReverseRightSpine(Tree tree);
 extern Count TreeToVine(Tree *treeIO);
 extern void TreeBalance(Tree *treeIO);
 
+/* TREE_DESTROY -- iterate over a tree while destroying it. 
+ *
+ * root is a lvalue storing the root of the tree.
+ * treeref is a variable of type Tree*.
+ * tree and next are variables of type Tree.
+ * In the body of the loop, tree is the current node.
+ */
+#define TREE_DESTROY(treeref, tree, next, root)   \
+  for ((treeref = &(root), TreeToVine(treeref));  \
+       (tree = *treeref) != TreeEMPTY             \
+         ? (next = tree->right, TRUE)             \
+         : (TreeBalance(treeref), FALSE);         \
+       *treeref = next)
+
 
 #endif /* tree_h */
 
diff --git a/mps/design/arena.txt b/mps/design/arena.txt
index a1fae81ce5e..6c48d2ad111 100644
--- a/mps/design/arena.txt
+++ b/mps/design/arena.txt
@@ -273,7 +273,9 @@ memory represented by the tract.
 _`.tract.field.white`: The white bit-field indicates for which traces
 the tract is white (`.req.fun.trans.white`_). This information is also
 stored in the segment, but is duplicated here for efficiency during a
-call to ``TraceFix`` (see design.mps.trace.fix).
+call to ``TraceFix`` (see `design.mps.trace.fix`_).
+
+.. _design.mps.trace.fix: trace#fix
 
 _`.tract.limit`: The limit of the tract's memory may be determined by
 adding the arena alignment to the base address.
@@ -283,9 +285,8 @@ design.mps.arena.tract-iter(0).
 
 ``Bool TractOfAddr(Tract *tractReturn, Arena arena, Addr addr)``
 
-_`.tract.if.tractofaddr`: The function ``TractOfAddr()`` finds the tract
-corresponding to an address in memory. (See `.req.fun.trans`_.)
-
+_`.tract.if.tractofaddr`: The function ``TractOfAddr()`` finds the
+tract corresponding to an address in memory. (See `.req.fun.trans`_.)
 If ``addr`` is an address which has been allocated to some pool, then
 ``TractOfAddr()`` returns ``TRUE``, and sets ``*tractReturn`` to the
 tract corresponding to that address. Otherwise, it returns ``FALSE``.
@@ -293,10 +294,6 @@ This function is similar to ``TractOfBaseAddr()`` (see
 design.mps.arena.tract-iter.if.contig-base) but serves a more general
 purpose and is less efficient.
 
-_`.tract.if.TRACT_OF_ADDR`: ``TRACT_OF_ADDR()`` is a macro version of
-``TractOfAddr()``. It's provided for efficiency during a call to
-``TraceFix()`` (see design.mps.trace.fix.tractofaddr).
-
 
 Control pool
 ............
diff --git a/mps/design/class-interface.txt b/mps/design/class-interface.txt
index 1f716703dfd..ba0b6124d8d 100644
--- a/mps/design/class-interface.txt
+++ b/mps/design/class-interface.txt
@@ -171,13 +171,12 @@ reference in them.
     jumping through hoops required. David Jones, 1998-01-30.
 
 The ``fix`` field is used to perform fixing. This method is called via
-the generic function ``TraceFix()``. It indicates that the specified
-reference has been found and the class should consider the object
-live. There is provision for adjusting the value of the reference (to
-allow for classes that move objects). Classes are not required to
-provide this method, and not doing so indicates that the class is not
-automatic style (ie it does not use global tracing to determine
-liveness).
+the function ``TraceFix()``. It indicates that the specified reference
+has been found and the class should consider the object live. There is
+provision for adjusting the value of the reference (to allow for
+classes that move objects). Classes are not required to provide this
+method, and not doing so indicates that the class is not automatic
+style (ie it does not use global tracing to determine liveness).
 
 The ``reclaim`` field is used to reclaim memory. This method is called
 via the generic function ``PoolReclaim()``. It indicates that the trace
diff --git a/mps/design/critical-path.txt b/mps/design/critical-path.txt
index 9bcac7e17e8..f5714cee04e 100644
--- a/mps/design/critical-path.txt
+++ b/mps/design/critical-path.txt
@@ -230,20 +230,21 @@ If a pointer gets past the first-stage fix filters, it is passed to
 yet more pointers using information about segments before it has to
 consult the pool class.
 
-The first test applied is the "tract test". The MPS looks up the tract
-containing the address in the tract table, which is a simple linear
-table indexed by the address shifted -- a kind of flat page table.
+The first test is to determine if the address points to a *chunk* (a
+contiguous regions of address space managed by the arena). Addresses
+that do not point to any chunk (for example, ambiguous references that
+are not in fact pointers) are rejected immediately.
 
-Note that if the arena has been extended, the tract table becomes less
-simple, and this test may involved looking in more than one table.
-This will cause a considerable slow-down in garbage collection
-scanning. This is the reason that it's important to give a good
+When there are many chunks (that is, when the arena has been extended
+many times), this test can consume the majority of the garbage
+collection time. This is the reason that it's important to give a good
 estimate of the amount of address space you will ever occupy with
 objects when you initialize the arena.
 
-The pointer might not even be in the arena (and so not in any tract).
-The first stage fix doesn't guarantee it. So we eliminate any pointers
-not in the arena at this stage.
+The second test applied is the "tract test". The MPS looks up the
+tract containing the address in the tract table, which is a simple
+linear table indexed by the address shifted -- a kind of flat page
+table.
 
 If the pointer is in an allocated tract, then the table also contains
 a cache of the "white set" -- the set of garbage collection traces for
diff --git a/mps/design/scan.txt b/mps/design/scan.txt
index 1683fecc366..a1822a3ce6a 100644
--- a/mps/design/scan.txt
+++ b/mps/design/scan.txt
@@ -19,8 +19,8 @@ Scanned summary
 ...............
 
 _`.summary.subset`: The summary of reference seens by scan
-(ss.unfixedSummary) is a subset of the summary previously computed
-(SegSummary).
+(``ss.unfixedSummary``) is a subset of the summary previously computed
+(``SegSummary()``).
 
 There are two reasons that it is not an equality relation:
 
@@ -34,9 +34,11 @@ There are two reasons that it is not an equality relation:
 
 #. A write barrier hit will set the summary to ``RefSetUNIV``.
 
-The reason that ss.unfixedSummary is always a subset of the previous
-summary is due to an "optimization" which has not been made in
-``TraceFix``. See impl.c.trace.fix.fixed.all.
+The reason that ``ss.unfixedSummary`` is always a subset of the
+previous summary is due to an "optimization" which has not been made
+in ``TraceFix``. See `design.mps.trace.fix.fixed.all`_.
+
+.. _design.mps.trace.fix.fixed.all: trace#fix.fixed.all
 
 
 Partial scans
@@ -54,8 +56,8 @@ partial scans of condemned segments contribute to the segment summary.
 
 _`.clever-summary.acc`: Each time we partially scan a segment, we
 accumulate the post-scan summary of the scanned objects into a field
-in the group, called 'summarySoFar'. The post-scan summary is (summary
-\ white) U fixed.
+in the group, called ``summarySoFar``. The post-scan summary is
+(summary \ white) ∪ fixed.
 
 _`.clever-summary.acc.condemn`: The cumulative summary is only
 meaningful while the segment is condemned. Otherwise it is set to
diff --git a/mps/design/trace.txt b/mps/design/trace.txt
index 4186a90215d..f1d25bf25bc 100644
--- a/mps/design/trace.txt
+++ b/mps/design/trace.txt
@@ -25,15 +25,16 @@ Introduction
 Architecture
 ------------
 
-_`.instance.limit`: There will be a limit on the number of traces that
-can be created at any one time. This effectively limits the number of
-concurrent traces. This limitation is expressed in the symbol
-``TRACE_MAX``.
+_`.instance.limit`: There is a limit on the number of traces that can
+be created at any one time. This limits the number of concurrent
+traces. This limitation is expressed in the symbol ``TraceLIMIT``.
 
 .. note::
 
-    ``TRACE_MAX`` is currently set to 1, see request.mps.160020_
-    "Multiple traces would not work". David Jones, 1998-06-15.
+    ``TraceLIMIT`` is currently set to 1 as the MPS assumes in various
+    places that only a single trace is active at a time. See
+    request.mps.160020_ "Multiple traces would not work". David Jones,
+    1998-06-15.
 
 .. _request.mps.160020: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/mps/160020
 
@@ -46,26 +47,32 @@ _`.rate`: See `mail.nickb.1997-07-31.14-37 </project/mps/mail/1997/07/31/14-37/0
 
 .. _request.epcore.160062: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/epcore/160062
 
-_`.exact.legal`: Exact references should either point outside the
-arena (to non-managed address space) or to a tract allocated to a
-pool. Exact references that are to addresses which the arena has
-reserved but hasn't allocated memory to are illegal (the exact
-reference couldn't possibly refer to a real object). Depending on the
-future semantics of ``PoolDestroy()`` we might need to adjust our
-strategy here. See mail.dsm.1996-02-14.18-18 for a strategy of coping
-gracefully with ``PoolDestroy()``. We check that this is the case in the
-fixer. It may be sensible to make this check CRITICAL in certain
-configurations.
+_`.exact.legal`: Exact references must either point outside the arena
+(to non-managed address space) or to a tract allocated to a pool.
+Exact references that are to addresses which the arena has reserved
+but hasn't allocated memory to are illegal (such a reference cannot
+possibly refer to a real object, and so cannot be exact). We check
+that this is the case in ``TraceFix()``.
 
-_`.fix.fixed.all`: ``ss->fixedSummary`` is accumulated (in the fixer)
-for all the pointers whether or not they are genuine references. We
-could accumulate fewer pointers here; if a pointer fails the
-``TractOfAddr()`` test then we know it isn't a reference, so we needn't
-accumulate it into the fixed summary. The design allows this, but it
-breaks a useful post-condition on scanning (if the accumulation of
-``ss->fixedSummary`` was moved the accuracy of ``ss->fixedSummary``
-would vary according to the "width" of the white summary). See
-mail.pekka.1998-02-04.16-48 for improvement suggestions.
+.. note::
+
+    Depending on the future semantics of ``PoolDestroy()`` we might
+    need to adjust our strategy here. See `mail.dsm.1996-02-14.18-18`_
+    for a strategy of coping gracefully with ``PoolDestroy()``.
+
+.. _mail.dsm.1996-02-14.18-18: https://info.ravenbrook.com/project/mps/mail/1996/02/14/18-18/0.txt
+
+_`.fix.fixed.all`: ``ss->fixedSummary`` is accumulated (in
+``TraceFix()``) for all pointers, whether or not they are genuine
+references. We could accumulate fewer pointers here; if a pointer
+fails the ``TractOfAddr()`` test then we know it isn't a reference, so
+we needn't accumulate it into the fixed summary. The design allows
+this, but it breaks a useful post-condition on scanning (if the
+accumulation of ``ss->fixedSummary`` was moved the accuracy of
+``ss->fixedSummary`` would vary according to the "width" of the white
+summary). See `mail.pekka.1998-02-04.16-48`_ for improvement suggestions.
+
+.. _mail.pekka.1998-02-04.16-48: https://info.ravenbrook.com/project/mps/mail/1998/02/04/16-48/0.txt
 
 
 Analysis
@@ -81,6 +88,7 @@ memory for copying.
 
 .. _request.dylan.170560: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/170560
 
+
 Ideas
 -----
 
@@ -96,30 +104,56 @@ Implementation
 Speed
 .....
 
-_`.fix`: The fix path is critical to garbage collection speed.
-Abstractly fix is applied to all the references in the non-white heap
-and all the references in the copied heap. Remembered sets cut down
-the number of segments we have to scan. The zone test cuts down the
-number of references we call fix on. The speed of the remainder of the
-fix path is still critical to system performance. Various
-modifications to and aspects of the system are concerned with
-maintaining the speed along this path.
+_`.fix`: The function implementing the fix operation should be called
+``TraceFix()`` and this name is pervasive in the MPS and its documents
+to describe this function. Nonethless, optimisation and strict
+aliasing rules have meant that we need to use the external name for
+it, ``_mps_fix2()``.
 
-_`.fix.tractofaddr`: ``TractOfAddr()`` is called on every reference that
-passes the zone test and is on the critical path, to determine whether
-the segment is white. There is no need to examine the segment to
-perform this test, since whiteness information is duplicated in
-tracts, specifically to optimize this test. ``TractOfAddr()`` itself is
-a simple class dispatch function (which dispatches to the arena
-class's ``TractOfAddr()`` method). Inlining the dispatch and inlining
-the functions called by ``VMTractOfAddr()`` makes a small but noticable
-difference to the speed of the dylan compiler.
+_`.fix.speed`: The fix path is critical to garbage collection speed.
+Abstractly, the fix operation is applied to all references in the
+non-white heap and all references in the copied heap. Remembered sets
+cut down the number of segments we have to scan. The zone test cuts
+down the number of references we call fix on. The speed of the
+remainder of the fix path is still critical to system performance.
+Various modifications to and aspects of the system are concerned with
+maintaining the speed along this path. See
+`design.mps.critical_path`_.
+
+.. _design.mps.critical_path: critical_path
+
+_`.fix.tractofaddr`: A reference that passes the zone test is then
+looked up to find the tract it points to, an operation equivalent to
+calling ``TractOfAddr()``.
+
+_`.fix.tractofaddr.inline`: ``TraceFix()`` doesn't actually call
+``TractOfAddr()``. Instead, it expands this operation inline (calling
+``ChunkOfAddr()``, then ``INDEX_OF_ADDR()``, checking the appropriate
+bit in the chunk's ``allocTable``, and finally looking up the tract in
+the chunk's page table). The reason for inlining this code is that we
+need to know whether the reference points to a chunk (and not just
+whether it points to a tract) in order to check the `.exact.legal`_
+condition.
+
+_`.fix.whiteseg`: The reason for looking up the tract is to determine
+whether the segment is white. There is no need to examine the segment
+to perform this test, since whiteness information is duplicated in
+tracts, specifically to optimize this test.
+
+.. note::
+
+    Nonetheless, it is likely to be more efficient to maintain a
+    separate lookup table from address to white segment, rather than
+    indirecting through the chunk and the tract. See job003796_.
+
+.. _job003796: http://www.ravenbrook.com/project/mps/issue/job003796/
 
 _`.fix.noaver`: ``AVER()`` statements in the code add bulk to the code
 (reducing I-cache efficacy) and add branches to the path (polluting
-the branch pedictors) resulting in a slow down. Removing all the
-``AVER()`` statements from the fix path improves the overall speed of
-the Dylan compiler by as much as 9%.
+the branch pedictors) resulting in a slow down. Replacing the
+``AVER()`` statements with ``AVER_CRITICAL()`` on the critical path
+improves the overall speed of the Dylan compiler by as much as 9%. See
+`design.mps.critical_path`_.
 
 _`.fix.nocopy`: ``AMCFix()`` used to copy objects by using the format's
 copy method. This involved a function call (through an indirection)
@@ -131,19 +165,15 @@ inlined by the C compiler. This change results in a 4–5% speed-up in
 the Dylan compiler.
 
 _`.reclaim`: Because the reclaim phase of the trace (implemented by
-``TraceReclaim()``) examines every segment it is fairly time intensive.
-rit's profiles presented in request.dylan.170551_ show a gap between
-the two varieties variety.hi and variety.wi.
+``TraceReclaim()``) examines every segment it is fairly time
+intensive. Richard Tucker's profiles presented in
+request.dylan.170551_ show a gap between the two varieties variety.hi
+and variety.wi.
 
 .. _request.dylan.170551: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/170551
 
-_`.reclaim.noaver`: Converting ``AVER()`` statements in the loops of
-``TraceReclaim()``, ``PoolReclaim()``, ``AMCReclaim()`` (``LOReclaim()``?
-``AWLReclaim()``?) will result in a noticeable speed improvement.
-
-.. note::
-
-    Insert actual speed improvement here, if any.
+_`.reclaim.noaver`: Accordingly, reclaim methods use
+``AVER_CRITICAL()`` instead of ``AVER()``.
 
 
 Life cycle of a trace object

From dbfe3ca4258fff6bba2ddb3ab80ce6324eb2768c Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 20 May 2014 19:19:14 +0100
Subject: [PATCH 39/70] Fix compilation on windows.

Fix bug in ArenaDescribeTracts (only described the first tract).

Copied from Perforce
 Change: 186215
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c |  1 -
 mps/code/pool.c  |  2 +-
 mps/code/tree.h  | 10 +++++-----
 3 files changed, 6 insertions(+), 7 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 1bee7fd7795..6c1990ee880 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -521,7 +521,6 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
                  (WriteFS)(TractPool(tract)->class->name),
                  NULL);
     if (res != ResOK) return res;
-    return ResOK;
   }
   return ResOK;
 }
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 060da7a47d5..0bcae0e0648 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -626,7 +626,7 @@ Bool PoolOfAddr(Pool *poolReturn, Arena arena, Addr addr)
 Bool PoolOfRange(Pool *poolReturn, Arena arena, Addr base, Addr limit)
 {
   Bool havePool = FALSE;
-  Pool pool;
+  Pool pool = NULL;
   Tract tract;
   Addr addr, alignedBase, alignedLimit;
 
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 757344c2c64..6c5ea33320e 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -141,11 +141,11 @@ extern void TreeBalance(Tree *treeIO);
  * tree and next are variables of type Tree.
  * In the body of the loop, tree is the current node.
  */
-#define TREE_DESTROY(treeref, tree, next, root)   \
-  for ((treeref = &(root), TreeToVine(treeref));  \
-       (tree = *treeref) != TreeEMPTY             \
-         ? (next = tree->right, TRUE)             \
-         : (TreeBalance(treeref), FALSE);         \
+#define TREE_DESTROY(treeref, tree, next, root) \
+  for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY); \
+       (tree = *treeref) != TreeEMPTY \
+         ? (next = tree->right, TRUE) \
+         : (TreeBalance(treeref), FALSE); \
        *treeref = next)
 
 

From a0e076be57fe455e7dededa6b925cbaff875d428 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 21 May 2014 00:43:06 +0100
Subject: [PATCH 40/70] Improvements following review.

Copied from Perforce
 Change: 186227
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c     | 37 +++++++++++++--------------
 mps/code/arenacl.c   |  3 ++-
 mps/code/arenavm.c   | 13 +++++-----
 mps/code/splay.c     | 23 +++++------------
 mps/code/splay.h     |  3 +--
 mps/code/tree.c      |  4 +--
 mps/code/tree.h      |  4 +--
 mps/design/arena.txt | 61 ++++++++++++++++++++++++++++++++++++++------
 mps/design/locus.txt |  5 +++-
 mps/design/seg.txt   | 17 ++++++------
 mps/design/type.txt  |  8 +++---
 11 files changed, 107 insertions(+), 71 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 6c1990ee880..89abc7e0e7c 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -494,7 +494,7 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
 }
 
 
-/* ArenaDescribeTractsInChunk -- describe all the tracts in a chunk */
+/* ArenaDescribeTractsInChunk -- describe the tracts in a chunk */
 
 static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
 {
@@ -509,20 +509,30 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
   if (stream == NULL) return ResFAIL;
   UNUSED(closureS);
 
+  res = WriteF(stream, "Chunk [$P, $P) ($U) {\n",
+               (WriteFP)chunk->base, (WriteFP)chunk->limit,
+               (WriteFU)chunk->serial,
+               NULL);
+  if (res != ResOK) return res;
+  
   TRACT_TRACT_FOR(tract, addr, ChunkArena(chunk),
                   PageTract(ChunkPage(chunk, chunk->allocBase)),
                   chunk->limit)
   {
     res = WriteF(stream,
-                 "[$P, $P) $U   $P ($S)\n",
+                 "  [$P, $P) $P $U ($S)\n",
                  (WriteFP)TractBase(tract), (WriteFP)TractLimit(tract),
-                 (WriteFW)ArenaAlign(ChunkArena(chunk)),
                  (WriteFP)TractPool(tract),
+                 (WriteFU)(TractPool(tract)->serial),
                  (WriteFS)(TractPool(tract)->class->name),
                  NULL);
     if (res != ResOK) return res;
   }
-  return ResOK;
+
+  res = WriteF(stream, "} Chunk [$P, $P)\n",
+               (WriteFP)chunk->base, (WriteFP)chunk->limit,
+               NULL);
+  return res;
 }
 
 
@@ -599,17 +609,7 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
 }
 
 
-/* ArenaChunkInsert -- insert chunk into arena's chunk tree
- *
- * Note that there's no corresponding ArenaChunkDelete. That's because
- * we don't have a function that deletes an item from a balanced tree
- * efficiently. Instead, deletions from the chunk tree are carried out
- * by calling TreeToVine, iterating over the vine (where deletion is
- * straightforward) and then calling TreeBalance. This is efficient
- * when deleting all the chunks at a time in ArenaFinish, and
- * acceptable in VMCompact when multiple chunks may be deleted from
- * the tree.
- */
+/* ArenaChunkInsert -- insert chunk into arena's chunk tree */
 
 void ArenaChunkInsert(Arena arena, Tree tree) {
   Bool inserted;
@@ -689,13 +689,12 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
   /* TODO: Consider how the ArenaCBSBlockPool might free pages. */
-  if (arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0) == FALSE)
+  if (!arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0))
     goto found;
 
   closure.avoid = arena->primary;
-  if (TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                   arenaAllocPageInChunk, &closure, 0)
-      == FALSE)
+  if (!TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
+                    arenaAllocPageInChunk, &closure, 0))
     goto found;
 
   return ResRESOURCE;
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 7d8c3143f3d..0129c63fea9 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -295,7 +295,8 @@ static void ClientArenaFinish(Arena arena)
   clientArena = Arena2ClientArena(arena);
   AVERT(ClientArena, clientArena);
 
-  /* destroy all chunks, including the primary */
+  /* Destroy all chunks, including the primary. See
+   * <design/arena/#chunk.delete> */
   arena->primary = NULL;
   TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
     clientChunkDestroy(ChunkOfTree(tree));
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 210c943d047..538f50b134a 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -597,12 +597,13 @@ static void VMArenaFinish(Arena arena)
 
   EVENT1(ArenaDestroy, vmArena);
 
-  /* destroy all chunks, including the primary */
+  /* Destroy all chunks, including the primary. See
+   * <design/arena/#chunk.delete> */
   arena->primary = NULL;
   TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
     vmChunkDestroy(ChunkOfTree(tree));
   }
-
+  
   /* Destroying the chunks should have purged and removed all spare pages. */
   RingFinish(&vmArena->spareRing);
 
@@ -1095,11 +1096,9 @@ static void VMCompact(Arena arena, Trace trace)
 
   vmem1 = VMArenaReserved(arena);
 
-  /* Destroy all the chunks that are completely free. Be very careful
-   * about the order of operations on the tree because vmChunkDestroy
-   * unmaps the memory that the tree node resides in, so the next tree
-   * node has to be looked up first. TODO: add hysteresis here. See
-   * job003815. */
+  /* Destroy chunks that are completely free, but not the primary
+   * chunk. See <design/arena/#chunk.delete>
+   * TODO: add hysteresis here. See job003815. */
   tree = &arena->chunkTree;
   TreeToVine(tree);
   while (*tree != TreeEMPTY) {
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 41cc3069412..fe677a3c866 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -694,7 +694,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
   SplayStateStruct stateStruct;
 
 #ifdef SPLAY_DEBUG
-  Count count = TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
+  Count count = SplayDebugCount(splay);
 #endif
 
   /* Short-circuit common cases.  Splay trees often bring recently
@@ -714,7 +714,7 @@ static Compare SplaySplay(SplayTree splay, TreeKey key, TreeCompare compare)
   SplayTreeSetRoot(splay, stateStruct.middle);
 
 #ifdef SPLAY_DEBUG
-  AVER(count == TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey));
+  AVER(count == SplayDebugCount(splay));
 #endif
 
   return cmp;
@@ -909,7 +909,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
   Bool found;
   Compare cmp;
 #ifdef SPLAY_DEBUG
-  Count count = TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey);
+  Count count = SplayDebugCount(splay);
 #endif
 
 
@@ -951,7 +951,7 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
   SplayTreeSetRoot(splay, stateStruct.middle);
 
 #ifdef SPLAY_DEBUG
-  AVER(count == TreeDebugCount(SplayTreeRoot(splay), splay->compare, splay->nodeKey));
+  AVER(count == SplayDebugCount(splay));
 #endif
 
   return found;
@@ -970,9 +970,8 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
  * unmodified.
  *
  * IMPORTANT: Iterating over the tree using these functions will leave
- * the tree totally unbalanced, throwing away optimisations of the
- * tree shape caused by previous splays. Consider using
- * SplayTreeTraverse instead.
+ * the tree totally unbalanced, throwing away optimisations of the tree
+ * shape caused by previous splays. Consider using TreeTraverse instead.
  */
 
 Tree SplayTreeFirst(SplayTree splay) {
@@ -1013,16 +1012,6 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
 }
 
 
-/* SplayTreeTraverse -- iterate over splay tree without splaying it */
-
-Bool SplayTreeTraverse(SplayTree splay, TreeVisitor visitor,
-                       void *closureP, Size closureS)
-{
-  return TreeTraverse(splay->root, splay->compare, splay->nodeKey,
-                      visitor, closureP, closureS);
-}
-
-
 /* SplayNodeDescribe -- Describe a node in the splay tree
  *
  * Note that this breaks the restriction of .note.stack.
diff --git a/mps/code/splay.h b/mps/code/splay.h
index 9bfb27c0ed1..8aa335e88a1 100644
--- a/mps/code/splay.h
+++ b/mps/code/splay.h
@@ -55,8 +55,6 @@ extern Bool SplayTreeNeighbours(Tree *leftReturn,
 
 extern Tree SplayTreeFirst(SplayTree splay);
 extern Tree SplayTreeNext(SplayTree splay, TreeKey oldKey);
-extern Bool SplayTreeTraverse(SplayTree splay, TreeVisitor visitor,
-                              void *closureP, Size closureS);
 
 typedef Bool (*SplayFindMethod)(Tree *nodeReturn, SplayTree splay,
                                 SplayTestNodeMethod testNode,
@@ -79,6 +77,7 @@ extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
 extern void SplayDebugUpdate(SplayTree splay, Tree tree);
 extern Count SplayDebugCount(SplayTree splay);
 
+
 #endif /* splay_h */
 
 
diff --git a/mps/code/tree.c b/mps/code/tree.c
index 0e1bb372f65..dbf112f31bc 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -119,11 +119,11 @@ Compare TreeFind(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
 
 /* TreeFindNext -- search for node containing key, or next node
  *
- * If there is a node that is greater than key, set treeReturn to that
+ * If there is a node that is greater than key, set *treeReturn to that
  * node and return TRUE.
  *
  * Otherwise, key is greater than all nodes in the tree, so leave
- * treeReturn unchanged and return FALSE.
+ * *treeReturn unchanged and return FALSE.
  */
 
 Bool TreeFindNext(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 6c5ea33320e..6d2fde3ea6f 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -136,7 +136,7 @@ extern void TreeBalance(Tree *treeIO);
 
 /* TREE_DESTROY -- iterate over a tree while destroying it. 
  *
- * root is a lvalue storing the root of the tree.
+ * root is an lvalue storing the root of the tree.
  * treeref is a variable of type Tree*.
  * tree and next are variables of type Tree.
  * In the body of the loop, tree is the current node.
@@ -145,7 +145,7 @@ extern void TreeBalance(Tree *treeIO);
   for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY); \
        (tree = *treeref) != TreeEMPTY \
          ? (next = tree->right, TRUE) \
-         : (TreeBalance(treeref), FALSE); \
+         : FALSE; \
        *treeref = next)
 
 
diff --git a/mps/design/arena.txt b/mps/design/arena.txt
index 6c48d2ad111..28dd6334065 100644
--- a/mps/design/arena.txt
+++ b/mps/design/arena.txt
@@ -220,6 +220,49 @@ implementations of those methods which must be overridden. Instead
 each abstract method is initialized to ``NULL``.
 
 
+Chunks
+......
+
+_`.chunk`: Each contiguous region of address space managed by the MPS
+is represented by a *chunk*.
+
+_`.chunk.tracts`: A chunk contains a table of tracts. See `.tract`_.
+
+_`.chunk.lookup`: Looking of the chunk of an address is the first
+step in the second-stage fix operation, and so on the critical path.
+See `design.mps.critical-path`_.
+
+.. _design.mps.critical-path: critical-path
+
+_`.chunk.tree`: For efficient lookup, chunks are stored in a balanced
+tree; ``arena->chunkTree`` points to the root of the tree. Operations
+on this tree must ensure that the tree remains balanced, otherwise
+performance degrades badly with many chunks.
+
+_`.chunk.insert`: New chunks are inserted into the tree by calling
+``ArenaChunkInsert()``. This calls ``TreeInsert()``, followed by
+``TreeBalance()`` to ensure that the tree is balanced.
+
+_`.chunk.delete`: There is no corresponding function
+``ArenaChunkDelete()``. Instead, deletions from the chunk tree are
+carried out by calling ``TreeToVine()``, iterating over the vine
+(where deletion is straightforward, with care) and then calling
+``TreeBalance()`` if any chunks might remain. The macro
+``TREE_DESTROY()`` assists with the common case.
+
+_`.chunk.delete.justify`: This is because we don't have a function
+that deletes an item from a balanced tree efficiently, and because all
+functions that delete chunks do so in a loop that may delete multiple
+chunks. The procedure is efficient when deleting all the chunks in
+``ArenaFinish()``, and has acceptable performance in ``VMCompact()``
+where multiple chunks may be deleted from the tree.
+
+_`.chunk.delete.tricky`: Deleting chunks from the chunk tree is tricky
+in the virtual memory arena because ``vmChunkDestroy()`` unmaps the
+memory containing the chunk, which includes the tree node. So the next
+chunk must be looked up before deleting the current chunk.
+
+
 Tracts
 ......
 
@@ -233,11 +276,11 @@ associating their own data with each allocation grain.
 _`.tract.structure`: The tract structure definition looks like this::
 
     typedef struct TractStruct { /* Tract structure */
-      PagePoolUnion pool; /* MUST BE FIRST (design.mps.arena.tract.field.pool) */
-      void *p;                    /* pointer for use of owning pool */
-      Addr base;                  /* Base address of the tract */
-      TraceSet white : TRACE_MAX; /* traces for which tract is white */
-      unsigned int hasSeg : 1;    /* does tract have a seg in p?  */
+      PagePoolUnion pool; /* MUST BE FIRST (<design/arena/#tract.field> pool) */
+      void *p;                     /* pointer for use of owning pool */
+      Addr base;                   /* Base address of the tract */
+      TraceSet white : TraceLIMIT; /* traces for which tract is white */
+      unsigned hasSeg : 1;         /* does tract have a seg in p? See .bool */
     } TractStruct;
 
 _`.tract.field.pool`: The pool.pool field indicates to which pool the tract
@@ -263,9 +306,11 @@ use it for any purpose.
 _`.tract.field.hasSeg`: The ``hasSeg`` bit-field is a Boolean which
 indicates whether the ``p`` field is being used by the segment module.
 If this field is ``TRUE``, then the value of ``p`` is a ``Seg``.
-``hasSeg`` is typed as an ``unsigned int``, rather than a ``Bool``.
-This ensures that there won't be sign conversion problems when
-converting the bit-field value.
+``hasSeg`` has type ``unsigned:1`` rather than ``Bool:1`` to avoid
+sign conversion problems when converting the bit-field value. See
+`design.mps.type.bool.bitfield`_.
+
+.. _design.mps.type.bool.bitfield: type#bool.bitfield
 
 _`.tract.field.base`: The base field contains the base address of the
 memory represented by the tract.
diff --git a/mps/design/locus.txt b/mps/design/locus.txt
index 1e70de035bd..501578ee724 100644
--- a/mps/design/locus.txt
+++ b/mps/design/locus.txt
@@ -511,7 +511,10 @@ requested (to allow for large objects).
 _`.arch.chunk`: Arenas may allocate more address space in additional
 chunks, which may be disjoint from the existing chunks. Inter-chunk
 space will be represented by dummy regions. There are also sentinel
-regions at both ends of the address space.
+regions at both ends of the address space. See
+`design.mps.arena.chunk`_.
+
+.. _design.mps.arena.chunk: arena#chunk
 
 
 Overview of strategy
diff --git a/mps/design/seg.txt b/mps/design/seg.txt
index 87ff87575f6..55634a92092 100644
--- a/mps/design/seg.txt
+++ b/mps/design/seg.txt
@@ -63,21 +63,20 @@ Data Structure
 The implementations are as follows::
 
     typedef struct SegStruct {      /* segment structure */
-      Sig sig;                      /* impl.h.misc.sig */
+      Sig sig;                      /* <code/misc.h#sig> */
       SegClass class;               /* segment class structure */
       Tract firstTract;             /* first tract of segment */
       RingStruct poolRing;          /* link in list of segs in pool */
       Addr limit;                   /* limit of segment */
-      unsigned depth : SHIELD_DEPTH_WIDTH; /* see impl.c.shield.def.depth */
-      AccessSet pm : AccessMAX;     /* protection mode, impl.c.shield */
-      AccessSet sm : AccessMAX;     /* shield mode, impl.c.shield */
-      TraceSet grey : TRACE_MAX;    /* traces for which seg is grey */
-      TraceSet white : TRACE_MAX;   /* traces for which seg is white */
-      TraceSet nailed : TRACE_MAX;  /* traces for which seg has nailed objects */
-      RankSet rankSet : RankMAX;    /* ranks of references in this seg */
+      unsigned depth : ShieldDepthWIDTH; /* see <code/shield.c#def.depth> */
+      AccessSet pm : AccessLIMIT;   /* protection mode, <code/shield.c> */
+      AccessSet sm : AccessLIMIT;   /* shield mode, <code/shield.c> */
+      TraceSet grey : TraceLIMIT;   /* traces for which seg is grey */
+      TraceSet white : TraceLIMIT;  /* traces for which seg is white */
+      TraceSet nailed : TraceLIMIT; /* traces for which seg has nailed objects */
+      RankSet rankSet : RankLIMIT;  /* ranks of references in this seg */
     } SegStruct;
 
-
     typedef struct GCSegStruct {    /* GC segment structure */
       SegStruct segStruct;          /* superclass fields must come first */
       RingStruct greyRing;          /* link in list of grey segs */
diff --git a/mps/design/type.txt b/mps/design/type.txt
index baee04ef3d2..f60ac1d7ba3 100644
--- a/mps/design/type.txt
+++ b/mps/design/type.txt
@@ -564,9 +564,11 @@ space as the client data.
 ``typedef unsigned TraceId``
 
 _`.traceid`: A ``TraceId`` is an unsigned integer which is less than
-``TRACE_MAX``. Each running trace has a different ``TraceId`` which is
-used to index into tables and bitfields used to remember the state of
-that trace.
+``TraceLIMIT``. Each running trace has a different ``TraceId`` which
+is used to index into the tables and bitfields that record the state
+of that trace. See `design.mps.trace.instance.limit`_.
+
+.. _design.mps.trace.instance.limit: trace#instance.limit
 
 
 ``typedef unsigned TraceSet``

From 58f35172c7fdac22a9c3698931bf086e92c53ed2 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 21 May 2014 11:38:59 +0100
Subject: [PATCH 41/70] Tree_traverse_and_delete is a better name than
 tree_destroy.

Generalize this macro so it can be used in all three cases.

Copied from Perforce
 Change: 186228
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenacl.c   |  4 ++--
 mps/code/arenavm.c   | 18 +++++++-----------
 mps/code/tree.h      | 26 +++++++++++++++++---------
 mps/design/arena.txt | 15 +++++++--------
 4 files changed, 33 insertions(+), 30 deletions(-)

diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 0129c63fea9..a288b420b20 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -290,7 +290,7 @@ failChunkCreate:
 static void ClientArenaFinish(Arena arena)
 {
   ClientArena clientArena;
-  Tree *treeref, tree, next;
+  Tree *treeref, *nextref, tree, next;
 
   clientArena = Arena2ClientArena(arena);
   AVERT(ClientArena, clientArena);
@@ -298,7 +298,7 @@ static void ClientArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
+  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
     clientChunkDestroy(ChunkOfTree(tree));
   }
 
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 538f50b134a..83f042e265c 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -589,7 +589,7 @@ static void VMArenaFinish(Arena arena)
 {
   VMArena vmArena;
   VM arenaVM;
-  Tree *treeref, tree, next;
+  Tree *treeref, *nextref, tree, next;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -600,7 +600,7 @@ static void VMArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  TREE_DESTROY(treeref, tree, next, arena->chunkTree) {
+  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
     vmChunkDestroy(ChunkOfTree(tree));
   }
   
@@ -1088,7 +1088,7 @@ static void VMCompact(Arena arena, Trace trace)
 {
   VMArena vmArena;
   Size vmem1;
-  Tree *tree;
+  Tree *treeref, *nextref, tree, next;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -1099,25 +1099,21 @@ static void VMCompact(Arena arena, Trace trace)
   /* Destroy chunks that are completely free, but not the primary
    * chunk. See <design/arena/#chunk.delete>
    * TODO: add hysteresis here. See job003815. */
-  tree = &arena->chunkTree;
-  TreeToVine(tree);
-  while (*tree != TreeEMPTY) {
-    Chunk chunk = ChunkOfTree(*tree);
+  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
+    Chunk chunk = ChunkOfTree(tree);
     AVERT(Chunk, chunk);
     if(chunk != arena->primary
        && BTIsResRange(chunk->allocTable, 0, chunk->pages))
     {
       Addr base = chunk->base;
       Size size = ChunkSize(chunk);
-      Tree next = TreeRight(*tree);
       vmChunkDestroy(chunk);
       vmArena->contracted(arena, base, size);
-      *tree = next;
     } else {
-      tree = &(*tree)->right;
+      /* Keep this chunk. */
+      treeref = nextref;
     }
   }
-  TreeBalance(&arena->chunkTree);
 
   {
     Size vmem0 = trace->preTraceArenaReserved;
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 6d2fde3ea6f..9c6e2543f7e 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -134,18 +134,26 @@ extern Tree TreeReverseRightSpine(Tree tree);
 extern Count TreeToVine(Tree *treeIO);
 extern void TreeBalance(Tree *treeIO);
 
-/* TREE_DESTROY -- iterate over a tree while destroying it. 
+/* TREE_TRAVERSE_AND_DELETE -- traverse a tree while deleting nodes 
  *
- * root is an lvalue storing the root of the tree.
- * treeref is a variable of type Tree*.
+ * root is an lvalue storing a pointer to the root of the tree. It is
+ * evaluated twice.
+ * treeref and nextref are variable of type Tree*.
  * tree and next are variables of type Tree.
- * In the body of the loop, tree is the current node.
+ *
+ * In the body of the loop, tree and next are the current and next
+ * node respectively, and treeref and nextref are the locations where
+ * pointers to these nodes are stored. Nodes are deleted from the tree
+ * by default, or you can assign treeref = nextref in the body of the
+ * loop to keep the current node.
+ *
+ * See <design/arena/#chunk.delete.tricky>.
  */
-#define TREE_DESTROY(treeref, tree, next, root) \
-  for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY); \
-       (tree = *treeref) != TreeEMPTY \
-         ? (next = tree->right, TRUE) \
-         : FALSE; \
+#define TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, root)    \
+  for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY);      \
+       (tree = *treeref) != TreeEMPTY                                   \
+         ? (nextref = &tree->right, next = *nextref, TRUE)              \
+         : (TreeBalance(&(root)), FALSE);                               \
        *treeref = next)
 
 
diff --git a/mps/design/arena.txt b/mps/design/arena.txt
index 28dd6334065..cf243e2877d 100644
--- a/mps/design/arena.txt
+++ b/mps/design/arena.txt
@@ -246,21 +246,20 @@ _`.chunk.insert`: New chunks are inserted into the tree by calling
 _`.chunk.delete`: There is no corresponding function
 ``ArenaChunkDelete()``. Instead, deletions from the chunk tree are
 carried out by calling ``TreeToVine()``, iterating over the vine
-(where deletion is straightforward, with care) and then calling
-``TreeBalance()`` if any chunks might remain. The macro
-``TREE_DESTROY()`` assists with the common case.
+(where deletion is possible, if care is taken) and then calling
+``TreeBalance()`` on the remaining tree. The macro
+``TREE_TRAVERSE_AND_DELETE()`` assists with this.
 
 _`.chunk.delete.justify`: This is because we don't have a function
 that deletes an item from a balanced tree efficiently, and because all
-functions that delete chunks do so in a loop that may delete multiple
-chunks. The procedure is efficient when deleting all the chunks in
-``ArenaFinish()``, and has acceptable performance in ``VMCompact()``
-where multiple chunks may be deleted from the tree.
+functions that delete chunks do so in a loop over the chunks (so the
+best we can do is O(*n*) time in any case).
 
 _`.chunk.delete.tricky`: Deleting chunks from the chunk tree is tricky
 in the virtual memory arena because ``vmChunkDestroy()`` unmaps the
 memory containing the chunk, which includes the tree node. So the next
-chunk must be looked up before deleting the current chunk.
+chunk must be looked up before deleting the current chunk. The macro
+``TREE_TRAVERSE_AND_DELETE()`` helps get this right.
 
 
 Tracts

From a066764cc86ed4eb8d0a1abab06f6b71d8e0e5b9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 22 May 2014 13:05:40 +0100
Subject: [PATCH 42/70] Add -m command-line option to the scheme example so
 that we can test it with different initial arena sizes.

Copied from Perforce
 Change: 186243
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme.c | 47 ++++++++++++++++++++++++++++++-------
 1 file changed, 39 insertions(+), 8 deletions(-)

diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 8a8dcf48ed7..72fbe9f9ff4 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -39,6 +39,7 @@
 #include <assert.h>
 #include <ctype.h>
 #include <errno.h>
+#include <getopt.h>
 #include <setjmp.h>
 #include <stdarg.h>
 #include <stddef.h>
@@ -4246,7 +4247,7 @@ static int start(int argc, char *argv[])
   mps_addr_t ref;
   mps_res_t res;
   mps_root_t globals_root;
-  int exit_code;
+  int exit_code = EXIT_SUCCESS;
 
   total = (size_t)0;
   
@@ -4302,15 +4303,14 @@ static int start(int argc, char *argv[])
     abort();
   }
 
-  if(argc >= 2) {
+  if (argc > 0) {
     /* Non-interactive file execution */
-    if(setjmp(*error_handler) != 0) {
+    if (setjmp(*error_handler) != 0) {
       fprintf(stderr, "%s\n", error_message);
       exit_code = EXIT_FAILURE;
-    } else {
-      load(env, op_env, make_string(strlen(argv[1]), argv[1]));
-      exit_code = EXIT_SUCCESS;
-    }
+    } else
+      for (i = 0; i < argc; ++i)
+        load(env, op_env, make_string(strlen(argv[i]), argv[i]));
   } else {
     /* Ask the MPS to tell us when it's garbage collecting so that we can
        print some messages.  Completely optional. */
@@ -4376,6 +4376,7 @@ static mps_gen_param_s obj_gen_params[] = {
 
 int main(int argc, char *argv[])
 {
+  size_t arenasize = 32ul * 1024 * 1024;
   mps_res_t res;
   mps_chain_t obj_chain;
   mps_fmt_t obj_fmt;
@@ -4383,11 +4384,41 @@ int main(int argc, char *argv[])
   mps_root_t reg_root;
   int exit_code;
   void *marker = &marker;
+  int ch;
   
+  while ((ch = getopt(argc, argv, "m:")) != -1)
+    switch (ch) {
+    case 'm': {
+        char *p;
+        arenasize = (unsigned)strtoul(optarg, &p, 10);
+        switch(toupper(*p)) {
+        case 'G': arenasize <<= 30; break;
+        case 'M': arenasize <<= 20; break;
+        case 'K': arenasize <<= 10; break;
+        case '\0': break;
+        default:
+          fprintf(stderr, "Bad arena size %s\n", optarg);
+          return EXIT_FAILURE;
+        }
+      }
+      break;
+    default:
+      fprintf(stderr,
+              "Usage: %s [option...] [file...]\n"
+              "Options:\n"
+              "  -m n, --arena-size=n[KMG]?\n"
+              "    Initial size of arena (default %lu).\n",
+              argv[0],
+              (unsigned long)arenasize);
+      return EXIT_FAILURE;
+    }
+  argc -= optind;
+  argv += optind;
+
   /* Create an MPS arena.  There is usually only one of these in a process.
      It holds all the MPS "global" state and is where everything happens. */
   MPS_ARGS_BEGIN(args) {
-    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 32 * 1024 * 1024);
+    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, arenasize);
     res = mps_arena_create_k(&arena, mps_arena_class_vm(), args);
   } MPS_ARGS_END(args);
   if (res != MPS_RES_OK) error("Couldn't create arena");

From 4dc70cba7cbf72e19535c2596d08759827eac489 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 22 May 2014 13:16:29 +0100
Subject: [PATCH 43/70] All versions of the scheme interpreter now take
 multiple files on the command line.

Integrate change 186243 to scheme-{advanced,malloc,boehm}.c.

Copied from Perforce
 Change: 186244
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme-advanced.c | 48 ++++++++++++++++++++++------
 mps/example/scheme/scheme-malloc.c   |  3 +-
 mps/example/scheme/scheme.c          |  1 -
 3 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c
index 476b790f0a4..28afdcc0671 100644
--- a/mps/example/scheme/scheme-advanced.c
+++ b/mps/example/scheme/scheme-advanced.c
@@ -37,6 +37,7 @@
 #include <assert.h>
 #include <ctype.h>
 #include <errno.h>
+#include <getopt.h>
 #include <setjmp.h>
 #include <stdarg.h>
 #include <stddef.h>
@@ -4318,7 +4319,7 @@ static int start(int argc, char *argv[])
   mps_addr_t ref;
   mps_res_t res;
   mps_root_t globals_root;
-  int exit_code;
+  int exit_code = EXIT_SUCCESS;
 
   total = (size_t)0;
   error_handler = &jb;
@@ -4372,15 +4373,14 @@ static int start(int argc, char *argv[])
     abort();
   }
 
-  if(argc >= 2) {
+  if (argc > 0) {
     /* Non-interactive file execution */
-    if(setjmp(*error_handler) != 0) {
+    if (setjmp(*error_handler) != 0) {
       fprintf(stderr, "%s\n", error_message);
       exit_code = EXIT_FAILURE;
-    } else {
-      load(env, op_env, make_string(strlen(argv[1]), argv[1]));
-      exit_code = EXIT_SUCCESS;
-    }
+    } else
+      for (i = 0; i < argc; ++i)
+        load(env, op_env, make_string(strlen(argv[i]), argv[i]));
   } else {
     /* Ask the MPS to tell us when it's garbage collecting so that we can
        print some messages.  Completely optional. */
@@ -4409,7 +4409,6 @@ static int start(int argc, char *argv[])
       }
     }
     puts("Bye.");
-    exit_code = EXIT_SUCCESS;
   }
 
   /* See comment at the end of `main` about cleaning up. */
@@ -4442,6 +4441,7 @@ static mps_gen_param_s obj_gen_params[] = {
 
 int main(int argc, char *argv[])
 {
+  size_t arenasize = 32ul * 1024 * 1024;
   mps_res_t res;
   mps_chain_t obj_chain;
   mps_fmt_t obj_fmt, buckets_fmt;
@@ -4449,11 +4449,41 @@ int main(int argc, char *argv[])
   mps_root_t reg_root;
   int exit_code;
   void *marker = &marker;
+  int ch;
   
+  while ((ch = getopt(argc, argv, "m:")) != -1)
+    switch (ch) {
+    case 'm': {
+        char *p;
+        arenasize = (unsigned)strtoul(optarg, &p, 10);
+        switch(toupper(*p)) {
+        case 'G': arenasize <<= 30; break;
+        case 'M': arenasize <<= 20; break;
+        case 'K': arenasize <<= 10; break;
+        case '\0': break;
+        default:
+          fprintf(stderr, "Bad arena size %s\n", optarg);
+          return EXIT_FAILURE;
+        }
+      }
+      break;
+    default:
+      fprintf(stderr,
+              "Usage: %s [option...] [file...]\n"
+              "Options:\n"
+              "  -m n, --arena-size=n[KMG]?\n"
+              "    Initial size of arena (default %lu).\n",
+              argv[0],
+              (unsigned long)arenasize);
+      return EXIT_FAILURE;
+    }
+  argc -= optind;
+  argv += optind;
+
   /* Create an MPS arena.  There is usually only one of these in a process.
      It holds all the MPS "global" state and is where everything happens. */
   MPS_ARGS_BEGIN(args) {
-    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 32 * 1024 * 1024);
+    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, arenasize);
     res = mps_arena_create_k(&arena, mps_arena_class_vm(),  args);
   } MPS_ARGS_END(args);
   if (res != MPS_RES_OK) error("Couldn't create arena");
diff --git a/mps/example/scheme/scheme-malloc.c b/mps/example/scheme/scheme-malloc.c
index 1333ce73aef..2b27c50ab0f 100644
--- a/mps/example/scheme/scheme-malloc.c
+++ b/mps/example/scheme/scheme-malloc.c
@@ -3608,7 +3608,8 @@ int main(int argc, char *argv[])
       fprintf(stderr, "%s\n", error_message);
       return EXIT_FAILURE;
     }
-    load(env, op_env, argv[1]);
+    for (i = 1; i < argc; ++i)
+      load(env, op_env, argv[i]);
     return EXIT_SUCCESS;
   } else {
     /* Interactive read-eval-print loop */
diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 72fbe9f9ff4..b3bc0c6801d 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -4339,7 +4339,6 @@ static int start(int argc, char *argv[])
       }
     }
     puts("Bye.");
-    exit_code = EXIT_SUCCESS;
   }
 
   /* See comment at the end of `main` about cleaning up. */

From 299bfb2992027c6131c6166db15e37548a766a60 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 22 May 2014 15:38:02 +0100
Subject: [PATCH 44/70] Scheme-boehm also processes multiple files.

Copied from Perforce
 Change: 186245
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme-boehm.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/mps/example/scheme/scheme-boehm.c b/mps/example/scheme/scheme-boehm.c
index 8d039433bb4..8ac42699512 100644
--- a/mps/example/scheme/scheme-boehm.c
+++ b/mps/example/scheme/scheme-boehm.c
@@ -3611,7 +3611,8 @@ int main(int argc, char *argv[])
       fprintf(stderr, "%s\n", error_message);
       return EXIT_FAILURE;
     }
-    load(env, op_env, argv[1]);
+    for (i = 1; i < argc; ++i)
+      load(env, op_env, argv[i]);
     return EXIT_SUCCESS;
   } else {
     /* Interactive read-eval-print loop */

From 254d116f09c96c2e9636f38b1aa64d2ee9ad4364 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 30 May 2014 12:13:40 +0100
Subject: [PATCH 45/70] Landvisitor no longer takes a deletereturn.

Copied from Perforce
 Change: 186366
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index c3e18df5aec..a14d0d44a91 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -581,11 +581,11 @@ failBlockPoolInit:
 
 /* MVFFFinish -- finish method for MVFF */
 
-static Bool mvffFinishVisitor(Bool *deleteReturn, Land land, Range range,
+static Bool mvffFinishVisitor(Land land, Range range,
                               void *closureP, Size closureS)
 {
   Pool pool;
-  AVER(deleteReturn != NULL);
+
   AVERT(Land, land);
   AVERT(Range, range);
   AVER(closureP != NULL);
@@ -594,7 +594,6 @@ static Bool mvffFinishVisitor(Bool *deleteReturn, Land land, Range range,
   UNUSED(closureS);
 
   ArenaFree(RangeBase(range), RangeSize(range), pool);
-  *deleteReturn = FALSE;
   return TRUE;
 }
 
@@ -610,7 +609,8 @@ static void MVFFFinish(Pool pool)
   LandIterate(MVFFTotalCBS(mvff), mvffFinishVisitor, pool, 0);
 
   /* TODO: would like to check that LandSize(MVFFTotalCBS(mvff)) == 0
-   * now, but CBS doesn't support deletion while iterating. */
+   * now, but CBS doesn't support deletion while iterating. See
+   * job003826. */
 
   LandFinish(MVFFFailover(mvff));
   LandFinish(MVFFFreelist(mvff));

From 220e23a758ffcc61006f2ff55ad6b24ef79f20d4 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 8 Jun 2014 17:45:44 +0100
Subject: [PATCH 46/70] Fix problems identified by dl in review
 <https://info.ravenbrook.com/mail/2014/06/05/14-49-13/0/>.

Copied from Perforce
 Change: 186445
 ServerID: perforce.ravenbrook.com
---
 mps/code/tract.c | 14 +++++++++++++-
 mps/code/tree.c  |  6 +++---
 mps/code/tree.h  |  2 +-
 3 files changed, 17 insertions(+), 5 deletions(-)

diff --git a/mps/code/tract.c b/mps/code/tract.c
index 2a688bf5ea3..c40eb3ac784 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -7,6 +7,17 @@
  * free but never allocated as alloc starts searching after the tables.
  * TractOfAddr uses the fact that these pages are marked as free in order
  * to detect "references" to these pages as being bogus.
+ *
+ * .chunk.at.base: The chunks are stored in a balanced binary tree.
+ * Looking up an address in this tree is on the critical path, and
+ * therefore vital that it runs quickly. It is an implementation
+ * detail of chunks that they are always stored at the base of the
+ * region of address space they represent. Thus chunk happens to
+ * always be the same as chunk->base. We take advantage of this in the
+ * tree search by using chunk as its own key (instead of looking up
+ * chunk->base): this saves a dereference and perhaps a cache miss.
+ * See ChunkKey and ChunkCompare for this optimization. The necessary
+ * property is asserted in ChunkCheck.
  */
 
 #include "tract.h"
@@ -117,7 +128,7 @@ Bool ChunkCheck(Chunk chunk)
 
   CHECKL(chunk->base != (Addr)0);
   CHECKL(chunk->base < chunk->limit);
-  /* .chunk.at.base: check chunk structure is at its own base */
+  /* check chunk structure is at its own base: see .chunk.at.base. */
   CHECKL(chunk->base == (Addr)chunk);
   CHECKL((Addr)(chunk+1) <= chunk->limit);
   CHECKL(ChunkSizeToPages(chunk, ChunkSize(chunk)) == chunk->pages);
@@ -276,6 +287,7 @@ Compare ChunkCompare(Tree tree, TreeKey key)
   AVERT_CRITICAL(Tree, tree);
   AVER_CRITICAL(tree != TreeEMPTY);
 
+  /* See .chunk.at.base. */
   chunk = ChunkOfTree(tree);
   AVERT_CRITICAL(Chunk, chunk);
 
diff --git a/mps/code/tree.c b/mps/code/tree.c
index dbf112f31bc..7936383b5a9 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -85,9 +85,9 @@ Compare TreeFind(Tree *treeReturn, Tree root, TreeKey key, TreeCompare compare)
   Tree node, parent;
   Compare cmp = CompareEQUAL;
   
-  AVERT(Tree, root);
-  AVER(treeReturn != NULL);
-  AVER(FUNCHECK(compare));
+  AVERT_CRITICAL(Tree, root);
+  AVER_CRITICAL(treeReturn != NULL);
+  AVER_CRITICAL(FUNCHECK(compare));
   /* key is arbitrary */
 
   parent = NULL;
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 9c6e2543f7e..e7f70d8efd4 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -138,7 +138,7 @@ extern void TreeBalance(Tree *treeIO);
  *
  * root is an lvalue storing a pointer to the root of the tree. It is
  * evaluated twice.
- * treeref and nextref are variable of type Tree*.
+ * treeref and nextref are variables of type Tree*.
  * tree and next are variables of type Tree.
  *
  * In the body of the loop, tree and next are the current and next

From d04cd204c363e5ced53345b95ae2486912438995 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 8 Jun 2014 20:08:38 +0100
Subject: [PATCH 47/70] Add comments addressing points noted by dl in review
 <https://info.ravenbrook.com/mail/2014/06/04/14-08-35/0/>.

Copied from Perforce
 Change: 186448
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index a14d0d44a91..fd61da0d341 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -108,6 +108,13 @@ static void MVFFReduce(MVFF mvff)
 
   AVERT(MVFF, mvff);
   arena = PoolArena(MVFF2Pool(mvff));
+
+  /* NOTE: Memory is returned to the arena in the smallest units
+     possible (arena grains). There's a possibility that this could
+     lead to fragmentation in the arena (because allocation is in
+     multiples of mvff->extendBy). If so, try setting align =
+     mvff->extendBy here. */
+
   align = ArenaAlign(arena);
 
   /* Try to return memory when the amount of free memory exceeds a
@@ -122,6 +129,8 @@ static void MVFFReduce(MVFF mvff)
   if (freeSize < freeLimit)
     return;
 
+  /* For hysteresis, return only a proportion of the free memory. */
+
   targetFree = freeLimit / 2;
 
   /* Each time around this loop we either break, or we free at least

From 8eb003846da9c384aa7eb2acb6d8cc4fd3d559aa Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 8 Jun 2014 20:28:33 +0100
Subject: [PATCH 48/70] Fix problems identified by rb in review
 <https://info.ravenbrook.com/mail/2014/06/04/15-13-24/0/>.

Copied from Perforce
 Change: 186449
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c    |  8 ++++----
 mps/code/cbs.c      | 21 ++++++++++----------
 mps/code/cbs.h      |  1 +
 mps/code/failover.h |  2 ++
 mps/code/freelist.c |  4 ++--
 mps/code/freelist.h |  2 ++
 mps/code/landtest.c |  8 ++++----
 mps/code/poolmfs.c  |  7 -------
 mps/code/poolmfs.h  |  4 ++--
 mps/code/poolmv.c   |  8 ++++----
 mps/code/poolmv2.c  |  6 +++---
 mps/code/poolmvff.c | 48 ++++++++++++++++++++++-----------------------
 12 files changed, 58 insertions(+), 61 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index d270adf7499..a9dec4cd267 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -18,8 +18,8 @@ SRCID(arena, "$Id$");
 
 
 #define ArenaControlPool(arena) MV2Pool(&(arena)->controlPoolStruct)
-#define ArenaCBSBlockPool(arena)  (&(arena)->freeCBSBlockPoolStruct.poolStruct)
-#define ArenaFreeLand(arena) (&(arena)->freeLandStruct.landStruct)
+#define ArenaCBSBlockPool(arena) MFSPool(&(arena)->freeCBSBlockPoolStruct)
+#define ArenaFreeLand(arena) CBSLand(&(arena)->freeLandStruct)
 
 
 /* Forward declarations */
@@ -409,7 +409,7 @@ Res ControlInit(Arena arena)
   AVERT(Arena, arena);
   MPS_ARGS_BEGIN(args) {
     MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, CONTROL_EXTEND_BY);
-    res = PoolInit(&arena->controlPoolStruct.poolStruct, arena,
+    res = PoolInit(MV2Pool(&arena->controlPoolStruct), arena,
                    PoolClassMV(), args);
   } MPS_ARGS_END(args);
   if (res != ResOK)
@@ -425,7 +425,7 @@ void ControlFinish(Arena arena)
 {
   AVERT(Arena, arena);
   arena->poolReady = FALSE;
-  PoolFinish(&arena->controlPoolStruct.poolStruct);
+  PoolFinish(MV2Pool(&arena->controlPoolStruct));
 }
 
 
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 2cb93d1dc64..28d0ae3a6d4 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -26,7 +26,6 @@ SRCID(cbs, "$Id$");
 #define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit)
 
 
-#define cbsLand(cbs) (&((cbs)->landStruct))
 #define cbsOfLand(land) PARENT(CBSStruct, landStruct, land)
 #define cbsSplay(cbs) (&((cbs)->splayTreeStruct))
 #define cbsOfSplay(_splay) PARENT(CBSStruct, splayTreeStruct, _splay)
@@ -54,7 +53,7 @@ Bool CBSCheck(CBS cbs)
   /* See .enter-leave.simple. */
   Land land;
   CHECKS(CBS, cbs);
-  land = cbsLand(cbs);
+  land = CBSLand(cbs);
   CHECKD(Land, land);
   CHECKD(SplayTree, cbsSplay(cbs));
   CHECKD(Pool, cbs->blockPool);
@@ -126,7 +125,7 @@ static Bool cbsTestNode(SplayTree splay, Tree tree,
   AVERT(Tree, tree);
   AVER(closureP == NULL);
   AVER(size > 0);
-  AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
+  AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
 
   block = cbsBlockOfTree(tree);
 
@@ -142,7 +141,7 @@ static Bool cbsTestTree(SplayTree splay, Tree tree,
   AVERT(Tree, tree);
   AVER(closureP == NULL);
   AVER(size > 0);
-  AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
+  AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
 
   block = cbsFastBlockOfTree(tree);
 
@@ -158,7 +157,7 @@ static void cbsUpdateFastNode(SplayTree splay, Tree tree)
 
   AVERT_CRITICAL(SplayTree, splay);
   AVERT_CRITICAL(Tree, tree);
-  AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
+  AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
 
   maxSize = CBSBlockSize(cbsBlockOfTree(tree));
 
@@ -189,13 +188,13 @@ static void cbsUpdateZonedNode(SplayTree splay, Tree tree)
 
   AVERT_CRITICAL(SplayTree, splay);
   AVERT_CRITICAL(Tree, tree);
-  AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSZonedLandClass));
+  AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSZonedLandClass));
 
   cbsUpdateFastNode(splay, tree);
 
   zonedBlock = cbsZonedBlockOfTree(tree);
   block = &zonedBlock->cbsFastBlockStruct.cbsBlockStruct;
-  arena = LandArena(cbsLand(cbsOfSplay(splay)));
+  arena = LandArena(CBSLand(cbsOfSplay(splay)));
   zones = ZoneSetOfRange(arena, CBSBlockBase(block), CBSBlockLimit(block));
 
   if (TreeHasLeft(tree))
@@ -840,7 +839,7 @@ static Bool cbsFindFirst(Range rangeReturn, Range oldRangeReturn,
   AVERT(Land, land);
   cbs = cbsOfLand(land);
   AVERT(CBS, cbs);
-  AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
+  AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
 
   AVER(rangeReturn != NULL);
   AVER(oldRangeReturn != NULL);
@@ -925,7 +924,7 @@ static Bool cbsFindLast(Range rangeReturn, Range oldRangeReturn,
   AVERT(Land, land);
   cbs = cbsOfLand(land);
   AVERT(CBS, cbs);
-  AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
+  AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
 
   AVER(rangeReturn != NULL);
   AVER(oldRangeReturn != NULL);
@@ -962,7 +961,7 @@ static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
   AVERT(Land, land);
   cbs = cbsOfLand(land);
   AVERT(CBS, cbs);
-  AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
+  AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
 
   AVER(rangeReturn != NULL);
   AVER(oldRangeReturn != NULL);
@@ -1013,7 +1012,7 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
   AVERT(Land, land);
   cbs = cbsOfLand(land);
   AVERT(CBS, cbs);
-  AVER(IsLandSubclass(cbsLand(cbs), CBSZonedLandClass));
+  AVER(IsLandSubclass(CBSLand(cbs), CBSZonedLandClass));
   /* AVERT(ZoneSet, zoneSet); */
   AVER(BoolCheck(high));
 
diff --git a/mps/code/cbs.h b/mps/code/cbs.h
index e6bc276f067..a1496b3f771 100644
--- a/mps/code/cbs.h
+++ b/mps/code/cbs.h
@@ -37,6 +37,7 @@ typedef struct CBSZonedBlockStruct {
 typedef struct CBSStruct *CBS;
 
 extern Bool CBSCheck(CBS cbs);
+#define CBSLand(cbs) (&(cbs)->landStruct)
 
 extern LandClass CBSLandClassGet(void);
 extern LandClass CBSFastLandClassGet(void);
diff --git a/mps/code/failover.h b/mps/code/failover.h
index 56e6149e05e..3676bade103 100644
--- a/mps/code/failover.h
+++ b/mps/code/failover.h
@@ -13,6 +13,8 @@
 
 typedef struct FailoverStruct *Failover;
 
+#define FailoverLand(fo) (&(fo)->landStruct)
+
 extern Bool FailoverCheck(Failover failover);
 
 extern LandClass FailoverLandClassGet(void);
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 2be00189aa8..ffd21b347bc 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -14,7 +14,7 @@ SRCID(freelist, "$Id$");
 
 
 #define freelistOfLand(land) PARENT(FreelistStruct, landStruct, land)
-#define freelistAlignment(fl) LandAlignment(&(fl)->landStruct)
+#define freelistAlignment(fl) LandAlignment(FreelistLand(fl))
 
 
 typedef union FreelistBlockUnion {
@@ -178,7 +178,7 @@ Bool FreelistCheck(Freelist fl)
 {
   Land land;
   CHECKS(Freelist, fl);
-  land = &fl->landStruct;
+  land = FreelistLand(fl);
   CHECKD(Land, land);
   /* See <design/freelist/#impl.grain.align> */
   CHECKL(AlignIsAligned(freelistAlignment(fl), freelistMinimumAlignment));
diff --git a/mps/code/freelist.h b/mps/code/freelist.h
index c46ab57bc15..8e46f085626 100644
--- a/mps/code/freelist.h
+++ b/mps/code/freelist.h
@@ -13,6 +13,8 @@
 
 typedef struct FreelistStruct *Freelist;
 
+#define FreelistLand(fl) (&(fl)->landStruct)
+
 extern Bool FreelistCheck(Freelist freelist);
 
 extern LandClass FreelistLandClassGet(void);
diff --git a/mps/code/landtest.c b/mps/code/landtest.c
index af6beff29ac..78e828ad225 100644
--- a/mps/code/landtest.c
+++ b/mps/code/landtest.c
@@ -486,10 +486,10 @@ extern int main(int argc, char *argv[])
   CBSStruct cbsStruct;
   FreelistStruct flStruct;
   FailoverStruct foStruct;
-  Land cbs = &cbsStruct.landStruct;
-  Land fl = &flStruct.landStruct;
-  Land fo = &foStruct.landStruct;
-  Pool mfs = &blockPool.poolStruct;
+  Land cbs = CBSLand(&cbsStruct);
+  Land fl = FreelistLand(&flStruct);
+  Land fo = FailoverLand(&foStruct);
+  Pool mfs = MFSPool(&blockPool);
   Align align;
   int i;
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index c203c5697b6..18ffb1f1dec 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -60,13 +60,6 @@ typedef struct MFSHeaderStruct {
 #define UNIT_MIN        sizeof(HeaderStruct)
 
 
-Pool (MFSPool)(MFS mfs)
-{
-  AVERT(MFS, mfs);
-  return &mfs->poolStruct;
-}
-
-
 /* MFSVarargs -- decode obsolete varargs */
 
 static void MFSVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs)
diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h
index 5f2fd0780ed..e08682329b0 100644
--- a/mps/code/poolmfs.h
+++ b/mps/code/poolmfs.h
@@ -33,11 +33,11 @@
 
 typedef struct MFSStruct *MFS;
 
+#define MFSPool(mfs) (&(mfs)->poolStruct)
+
 extern PoolClass PoolClassMFS(void);
 
 extern Bool MFSCheck(MFS mfs);
-extern Pool (MFSPool)(MFS mfs);
-
 
 extern const struct mps_key_s _mps_key_MFSExtendSelf;
 #define MFSExtendSelf (&_mps_key_MFSExtendSelf)
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 88addcd5722..d619ca1566a 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -252,7 +252,7 @@ static Res MVInit(Pool pool, ArgList args)
   MPS_ARGS_BEGIN(piArgs) {
     MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, blockExtendBy);
     MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(MVBlockStruct));
-    res = PoolInit(&mv->blockPoolStruct.poolStruct, arena, PoolClassMFS(), piArgs);
+    res = PoolInit(mvBlockPool(mv), arena, PoolClassMFS(), piArgs);
   } MPS_ARGS_END(piArgs);
   if(res != ResOK)
     return res;
@@ -262,7 +262,7 @@ static Res MVInit(Pool pool, ArgList args)
   MPS_ARGS_BEGIN(piArgs) {
     MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, spanExtendBy);
     MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(MVSpanStruct));
-    res = PoolInit(&mv->spanPoolStruct.poolStruct, arena, PoolClassMFS(), piArgs);
+    res = PoolInit(mvSpanPool(mv), arena, PoolClassMFS(), piArgs);
   } MPS_ARGS_END(piArgs);
   if(res != ResOK)
     return res;
@@ -304,8 +304,8 @@ static void MVFinish(Pool pool)
 
   mv->sig = SigInvalid;
 
-  PoolFinish(&mv->blockPoolStruct.poolStruct);
-  PoolFinish(&mv->spanPoolStruct.poolStruct);
+  PoolFinish(mvBlockPool(mv));
+  PoolFinish(mvSpanPool(mv));
 }
 
 
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 4dd85c184e5..c6dcb28dae2 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -167,19 +167,19 @@ static ABQ MVTABQ(MVT mvt)
 
 static Land MVTCBS(MVT mvt)
 {
-  return &mvt->cbsStruct.landStruct;
+  return CBSLand(&mvt->cbsStruct);
 }
 
 
 static Land MVTFreelist(MVT mvt)
 {
-  return &mvt->flStruct.landStruct;
+  return FreelistLand(&mvt->flStruct);
 }
 
 
 static Land MVTFailover(MVT mvt)
 {
-  return &mvt->foStruct.landStruct;
+  return FailoverLand(&mvt->foStruct);
 }
 
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index fd61da0d341..def8438f51f 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -65,13 +65,13 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
 
 
 #define Pool2MVFF(pool)     PARENT(MVFFStruct, poolStruct, pool)
-#define MVFF2Pool(mvff)     (&((mvff)->poolStruct))
-#define MVFFTotalCBS(mvff)  (&((mvff)->totalCBSStruct.landStruct))
-#define MVFFFreeCBS(mvff)   (&((mvff)->freeCBSStruct.landStruct))
-#define MVFFFreelist(mvff)  (&((mvff)->flStruct.landStruct))
-#define MVFFFailover(mvff)  (&((mvff)->foStruct.landStruct))
-#define MVFFSegPref(mvff)   (&((mvff)->segPrefStruct))
-#define MVFFBlockPool(mvff) (&((mvff)->cbsBlockPoolStruct.poolStruct))
+#define MVFF2Pool(mvff)     (&(mvff)->poolStruct)
+#define MVFFTotalCBS(mvff)  CBSLand(&(mvff)->totalCBSStruct)
+#define MVFFFreeCBS(mvff)   CBSLand(&(mvff)->freeCBSStruct)
+#define MVFFFreelist(mvff)  FreelistLand(&(mvff)->flStruct)
+#define MVFFFreeLand(mvff)  FailoverLand(&(mvff)->foStruct)
+#define MVFFSegPref(mvff)   (&(mvff)->segPrefStruct)
+#define MVFFBlockPool(mvff) MFSPool(&(mvff)->cbsBlockPoolStruct)
 
 static Bool MVFFCheck(MVFF mvff);
 
@@ -125,7 +125,7 @@ static void MVFFReduce(MVFF mvff)
      stored at the root node. */
 
   freeLimit = (Size)(LandSize(MVFFTotalCBS(mvff)) * mvff->spare);
-  freeSize = LandSize(MVFFFailover(mvff));
+  freeSize = LandSize(MVFFFreeLand(mvff));
   if (freeSize < freeLimit)
     return;
 
@@ -138,7 +138,7 @@ static void MVFFReduce(MVFF mvff)
      loop will terminate */
 
   while (freeSize > targetFree
-         && LandFindLargest(&freeRange, &oldFreeRange, MVFFFailover(mvff),
+         && LandFindLargest(&freeRange, &oldFreeRange, MVFFFreeLand(mvff),
                             align, FindDeleteNONE))
   {
     RangeStruct pageRange, oldRange;
@@ -177,16 +177,16 @@ static void MVFFReduce(MVFF mvff)
        to delete from the TotalCBS we add back to the free list, which
        can't fail. */
 
-    res = LandDelete(&oldRange, MVFFFailover(mvff), &pageRange);
+    res = LandDelete(&oldRange, MVFFFreeLand(mvff), &pageRange);
     if (res != ResOK)
       break;
     freeSize -= RangeSize(&pageRange);
-    AVER(freeSize == LandSize(MVFFFailover(mvff)));
+    AVER(freeSize == LandSize(MVFFFreeLand(mvff)));
 
     res = LandDelete(&oldRange, MVFFTotalCBS(mvff), &pageRange);
     if (res != ResOK) {
       RangeStruct coalescedRange;
-      res = LandInsert(&coalescedRange, MVFFFailover(mvff), &pageRange);
+      res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &pageRange);
       AVER(res == ResOK);
       break;
     }
@@ -253,7 +253,7 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
   }
 
   DebugPoolFreeSplat(pool, RangeBase(&range), RangeLimit(&range));
-  res = LandInsert(rangeReturn, MVFFFailover(mvff), &range);
+  res = LandInsert(rangeReturn, MVFFFreeLand(mvff), &range);
   AVER(res == ResOK);
 
   /* Don't call MVFFReduce; that would be silly. */
@@ -287,7 +287,7 @@ static Bool MVFFFindFree(Range rangeReturn, MVFF mvff, Size size)
 
   foundBlock =
     (mvff->firstFit ? LandFindFirst : LandFindLast)
-    (rangeReturn, &oldRange, MVFFFailover(mvff), size, findDelete);
+    (rangeReturn, &oldRange, MVFFFreeLand(mvff), size, findDelete);
 
   return foundBlock;
 }
@@ -352,7 +352,7 @@ static void MVFFFree(Pool pool, Addr old, Size size)
   AVER(size > 0);
 
   RangeInitSize(&range, old, SizeAlignUp(size, PoolAlignment(pool)));
-  res = LandInsert(&coalescedRange, MVFFFailover(mvff), &range);
+  res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range);
   AVER(res == ResOK);
   MVFFReduce(mvff);
 }
@@ -381,14 +381,14 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(SizeIsAligned(size, PoolAlignment(pool)));
   AVERT(Bool, withReservoirPermit);
 
-  found = LandFindLargest(&range, &oldRange, MVFFFailover(mvff), size,
+  found = LandFindLargest(&range, &oldRange, MVFFFreeLand(mvff), size,
                           FindDeleteENTIRE);
   if (!found) {
     /* Add a new range to the free lists and try again. */
     res = MVFFExtend(&newRange, mvff, size, withReservoirPermit);
     if (res != ResOK)
       return res;
-    found = LandFindLargest(&range, &oldRange, MVFFFailover(mvff), size,
+    found = LandFindLargest(&range, &oldRange, MVFFFreeLand(mvff), size,
                             FindDeleteENTIRE);
     AVER(found && RangesOverlap(&range, &newRange));
   }
@@ -421,7 +421,7 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer,
   if (RangeIsEmpty(&range))
     return;
 
-  res = LandInsert(&coalescedRange, MVFFFailover(mvff), &range);
+  res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range);
   AVER(res == ResOK);
   MVFFReduce(mvff);
 }
@@ -563,7 +563,7 @@ static Res MVFFInit(Pool pool, ArgList args)
   MPS_ARGS_BEGIN(foArgs) {
     MPS_ARGS_ADD(foArgs, FailoverPrimary, MVFFFreeCBS(mvff));
     MPS_ARGS_ADD(foArgs, FailoverSecondary, MVFFFreelist(mvff));
-    res = LandInit(MVFFFailover(mvff), FailoverLandClassGet(), arena, align,
+    res = LandInit(MVFFFreeLand(mvff), FailoverLandClassGet(), arena, align,
                    mvff, foArgs);
   } MPS_ARGS_END(foArgs);
   if (res != ResOK)
@@ -621,7 +621,7 @@ static void MVFFFinish(Pool pool)
    * now, but CBS doesn't support deletion while iterating. See
    * job003826. */
 
-  LandFinish(MVFFFailover(mvff));
+  LandFinish(MVFFFreeLand(mvff));
   LandFinish(MVFFFreelist(mvff));
   LandFinish(MVFFFreeCBS(mvff));
   LandFinish(MVFFTotalCBS(mvff));
@@ -750,7 +750,7 @@ size_t mps_mvff_free_size(mps_pool_t mps_pool)
   mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
-  return (size_t)LandSize(MVFFFailover(mvff));
+  return (size_t)LandSize(MVFFFreeLand(mvff));
 }
 
 /* Total owned bytes. See <design/poolmvff/#design.arena-enter> */
@@ -786,9 +786,9 @@ static Bool MVFFCheck(MVFF mvff)
   CHECKD(Land, MVFFTotalCBS(mvff));
   CHECKD(Land, MVFFFreeCBS(mvff));
   CHECKD(Land, MVFFFreelist(mvff));
-  CHECKD(Land, MVFFFailover(mvff));
-  CHECKL(LandSize(MVFFTotalCBS(mvff)) >= LandSize(MVFFFailover(mvff)));
-  CHECKL(SizeIsAligned(LandSize(MVFFFailover(mvff)), PoolAlignment(MVFF2Pool(mvff))));
+  CHECKD(Land, MVFFFreeLand(mvff));
+  CHECKL(LandSize(MVFFTotalCBS(mvff)) >= LandSize(MVFFFreeLand(mvff)));
+  CHECKL(SizeIsAligned(LandSize(MVFFFreeLand(mvff)), PoolAlignment(MVFF2Pool(mvff))));
   CHECKL(SizeIsAligned(LandSize(MVFFTotalCBS(mvff)), ArenaAlign(PoolArena(MVFF2Pool(mvff)))));
   CHECKL(BoolCheck(mvff->slotHigh));
   CHECKL(BoolCheck(mvff->firstFit));

From 208768896427848cf003a279b4131663ef5e0bd2 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 8 Jun 2014 22:10:21 +0100
Subject: [PATCH 49/70] Fix problems identified by rb in review
 <https://info.ravenbrook.com/mail/2014/06/05/14-58-24/0/>.

Copied from Perforce
 Change: 186451
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c     | 16 +++++++++--
 mps/code/arenacl.c   | 19 +++++++++----
 mps/code/arenavm.c   | 68 ++++++++++++++++++++++++++++++--------------
 mps/code/tract.c     |  1 -
 mps/code/tree.c      | 35 +++++++++++++++++++++++
 mps/code/tree.h      | 24 ++--------------
 mps/design/arena.txt |  8 +++---
 7 files changed, 115 insertions(+), 56 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 89abc7e0e7c..8491c1976dd 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -638,6 +638,7 @@ typedef struct ArenaAllocPageClosureStruct {
   Pool pool;
   Addr base;
   Chunk avoid;
+  Res res;
 } ArenaAllocPageClosureStruct, *ArenaAllocPageClosure;
 
 static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
@@ -656,18 +657,25 @@ static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
   UNUSED(closureS);
 
   /* Already searched in arenaAllocPage. */
-  if (chunk == cl->avoid)
+  if (chunk == cl->avoid) {
+    cl->res = ResRESOURCE;
     return TRUE;
+  }
   
   if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
                            chunk->allocTable,
                            chunk->allocBase, chunk->pages, 1))
+  {
+    cl->res = ResRESOURCE;
     return TRUE;
+  }
   
   res = (*cl->arena->class->pagesMarkAllocated)(cl->arena, chunk,
                                                 basePageIndex, 1, cl->pool);
-  if (res != ResOK)
+  if (res != ResOK) {
+    cl->res = res;
     return TRUE;
+  }
   
   cl->base = PageIndexBase(chunk, basePageIndex);
   return FALSE;
@@ -685,6 +693,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   closure.pool = pool;
   closure.base = NULL;
   closure.avoid = NULL;
+  closure.res = ResOK;
 
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
@@ -697,7 +706,8 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
                     arenaAllocPageInChunk, &closure, 0))
     goto found;
 
-  return ResRESOURCE;
+  AVER(closure.res != ResOK);
+  return closure.res;
 
 found:
   AVER(closure.base != NULL);
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index a288b420b20..58d1abce445 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -173,15 +173,26 @@ static Res ClientChunkInit(Chunk chunk, BootBlock boot)
 
 /* clientChunkDestroy -- destroy a ClientChunk */
 
-static void clientChunkDestroy(Chunk chunk)
+static Bool clientChunkDestroy(Tree tree, void *closureP, Size closureS)
 {
+  Chunk chunk;
   ClientChunk clChunk;
 
+  AVERT(Tree, tree);
+  /* FIXME: AVER(closureP == UNUSED_POINTER); */
+  UNUSED(closureP);
+  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  UNUSED(closureS);
+  
+  chunk = ChunkOfTree(tree);
+  AVERT(Chunk, chunk);
   clChunk = Chunk2ClientChunk(chunk);
   AVERT(ClientChunk, clChunk);
 
   clChunk->sig = SigInvalid;
   ChunkFinish(chunk);
+
+  return TRUE;
 }
 
 
@@ -290,7 +301,6 @@ failChunkCreate:
 static void ClientArenaFinish(Arena arena)
 {
   ClientArena clientArena;
-  Tree *treeref, *nextref, tree, next;
 
   clientArena = Arena2ClientArena(arena);
   AVERT(ClientArena, clientArena);
@@ -298,9 +308,8 @@ static void ClientArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
-    clientChunkDestroy(ChunkOfTree(tree));
-  }
+  /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */
+  TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy, NULL, 0);
 
   clientArena->sig = SigInvalid;
 
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 83f042e265c..800e7aeca21 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -401,11 +401,19 @@ failSaMapped:
 
 /* vmChunkDestroy -- destroy a VMChunk */
 
-static void vmChunkDestroy(Chunk chunk)
+static Bool vmChunkDestroy(Tree tree, void *closureP, Size closureS)
 {
   VM vm;
+  Chunk chunk;
   VMChunk vmChunk;
 
+  AVERT(Tree, tree);
+  /* FIXME: AVER(closureP == UNUSED_POINTER); */
+  UNUSED(closureP);
+  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  UNUSED(closureS);
+
+  chunk = ChunkOfTree(tree);
   AVERT(Chunk, chunk);
   vmChunk = Chunk2VMChunk(chunk);
   AVERT(VMChunk, vmChunk);
@@ -418,6 +426,8 @@ static void vmChunkDestroy(Chunk chunk)
   vm = vmChunk->vm;
   ChunkFinish(chunk);
   VMDestroy(vm);
+
+  return TRUE;
 }
 
 
@@ -589,7 +599,6 @@ static void VMArenaFinish(Arena arena)
 {
   VMArena vmArena;
   VM arenaVM;
-  Tree *treeref, *nextref, tree, next;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -600,9 +609,8 @@ static void VMArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
-    vmChunkDestroy(ChunkOfTree(tree));
-  }
+  /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */
+  TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy, NULL, 0);
   
   /* Destroying the chunks should have purged and removed all spare pages. */
   RingFinish(&vmArena->spareRing);
@@ -1084,11 +1092,42 @@ static void VMFree(Addr base, Size size, Pool pool)
 }
 
 
+/* vmChunkCompact -- delete chunk if empty and not primary */
+
+static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
+{
+  Chunk chunk;
+  Arena arena = closureP;
+  VMArena vmArena;
+
+  AVERT(Tree, tree);
+  AVERT(Arena, arena);
+  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  UNUSED(closureS);
+
+  vmArena = Arena2VMArena(arena);
+  AVERT(VMArena, vmArena);
+  chunk = ChunkOfTree(tree);
+  AVERT(Chunk, chunk);
+  if(chunk != arena->primary
+     && BTIsResRange(chunk->allocTable, 0, chunk->pages))
+  {
+    Addr base = chunk->base;
+    Size size = ChunkSize(chunk);
+    vmChunkDestroy(tree, closureP, closureS);
+    vmArena->contracted(arena, base, size);
+    return TRUE;
+  } else {
+    /* Keep this chunk. */
+    return FALSE;
+  }
+}
+
+
 static void VMCompact(Arena arena, Trace trace)
 {
   VMArena vmArena;
   Size vmem1;
-  Tree *treeref, *nextref, tree, next;
 
   vmArena = Arena2VMArena(arena);
   AVERT(VMArena, vmArena);
@@ -1099,21 +1138,8 @@ static void VMCompact(Arena arena, Trace trace)
   /* Destroy chunks that are completely free, but not the primary
    * chunk. See <design/arena/#chunk.delete>
    * TODO: add hysteresis here. See job003815. */
-  TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, arena->chunkTree) {
-    Chunk chunk = ChunkOfTree(tree);
-    AVERT(Chunk, chunk);
-    if(chunk != arena->primary
-       && BTIsResRange(chunk->allocTable, 0, chunk->pages))
-    {
-      Addr base = chunk->base;
-      Size size = ChunkSize(chunk);
-      vmChunkDestroy(chunk);
-      vmArena->contracted(arena, base, size);
-    } else {
-      /* Keep this chunk. */
-      treeref = nextref;
-    }
-  }
+  /* FIXME: use UNUSED_SIZE instead of 0 */
+  TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena, 0);
 
   {
     Size vmem0 = trace->preTraceArenaReserved;
diff --git a/mps/code/tract.c b/mps/code/tract.c
index c40eb3ac784..ec159458e25 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -520,7 +520,6 @@ static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
     }
   }
   while (chunkAboveAddr(&chunk, arena, addr)) {
-    /* If the ring was kept in address order, this could be improved. */
     addr = chunk->base;
     /* Start from allocBase to skip the tables. */
     if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) {
diff --git a/mps/code/tree.c b/mps/code/tree.c
index 7936383b5a9..e6dd902f3fd 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -528,6 +528,41 @@ void TreeBalance(Tree *treeIO)
 }
 
 
+/* TreeTraverseAndDelete -- traverse a tree while deleting nodes 
+ *
+ * The visitor function must return TRUE to delete the current node,
+ * or FALSE to keep it.
+ *
+ * See <design/arena/#chunk.delete.tricky>.
+ */
+void TreeTraverseAndDelete(Tree *treeIO, TreeVisitor visitor,
+                           void *closureP, Size closureS)
+{
+  Tree *treeref = treeIO;
+
+  AVER(treeIO != NULL);
+  AVERT(Tree, *treeIO);
+  AVER(FUNCHECK(visitor));
+  /* closureP and closureS are arbitrary */
+
+  TreeToVine(treeIO);
+
+  while (*treeref != TreeEMPTY) {
+    Tree tree = *treeref;         /* Current node. */
+    Tree *nextref = &tree->right; /* Location of pointer to next node. */
+    Tree next = *nextref;         /* Next node. */
+    if ((*visitor)(tree, closureP, closureS)) {
+      /* Delete current node. */
+      *treeref = next;
+    } else {
+      /* Keep current node. */
+      treeref = nextref;
+    }
+  }
+  TreeBalance(treeIO);
+}
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
diff --git a/mps/code/tree.h b/mps/code/tree.h
index e7f70d8efd4..2b5636fd087 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -134,28 +134,8 @@ extern Tree TreeReverseRightSpine(Tree tree);
 extern Count TreeToVine(Tree *treeIO);
 extern void TreeBalance(Tree *treeIO);
 
-/* TREE_TRAVERSE_AND_DELETE -- traverse a tree while deleting nodes 
- *
- * root is an lvalue storing a pointer to the root of the tree. It is
- * evaluated twice.
- * treeref and nextref are variables of type Tree*.
- * tree and next are variables of type Tree.
- *
- * In the body of the loop, tree and next are the current and next
- * node respectively, and treeref and nextref are the locations where
- * pointers to these nodes are stored. Nodes are deleted from the tree
- * by default, or you can assign treeref = nextref in the body of the
- * loop to keep the current node.
- *
- * See <design/arena/#chunk.delete.tricky>.
- */
-#define TREE_TRAVERSE_AND_DELETE(treeref, nextref, tree, next, root)    \
-  for ((treeref = &(root), TreeToVine(treeref), next = TreeEMPTY);      \
-       (tree = *treeref) != TreeEMPTY                                   \
-         ? (nextref = &tree->right, next = *nextref, TRUE)              \
-         : (TreeBalance(&(root)), FALSE);                               \
-       *treeref = next)
-
+extern void TreeTraverseAndDelete(Tree *treeIO, TreeVisitor visitor,
+                                  void *closureP, Size closureS);
 
 #endif /* tree_h */
 
diff --git a/mps/design/arena.txt b/mps/design/arena.txt
index cf243e2877d..980d716f229 100644
--- a/mps/design/arena.txt
+++ b/mps/design/arena.txt
@@ -247,8 +247,8 @@ _`.chunk.delete`: There is no corresponding function
 ``ArenaChunkDelete()``. Instead, deletions from the chunk tree are
 carried out by calling ``TreeToVine()``, iterating over the vine
 (where deletion is possible, if care is taken) and then calling
-``TreeBalance()`` on the remaining tree. The macro
-``TREE_TRAVERSE_AND_DELETE()`` assists with this.
+``TreeBalance()`` on the remaining tree. The function
+``TreeTraverseAndDelete()`` implements this.
 
 _`.chunk.delete.justify`: This is because we don't have a function
 that deletes an item from a balanced tree efficiently, and because all
@@ -258,8 +258,8 @@ best we can do is O(*n*) time in any case).
 _`.chunk.delete.tricky`: Deleting chunks from the chunk tree is tricky
 in the virtual memory arena because ``vmChunkDestroy()`` unmaps the
 memory containing the chunk, which includes the tree node. So the next
-chunk must be looked up before deleting the current chunk. The macro
-``TREE_TRAVERSE_AND_DELETE()`` helps get this right.
+chunk must be looked up before deleting the current chunk. The function
+``TreeTraverseAndDelete()`` ensures that this is done.
 
 
 Tracts

From 0253f20ede0942529e058e252b277e2ac7b60cb8 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 11 Jun 2014 12:47:13 +0100
Subject: [PATCH 50/70] Rename mvtfailover to mvtfreeland, as suggested by rb
 in review.

Copied from Perforce
 Change: 186485
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmv2.c | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 5ba465156b3..47fee298e53 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -54,7 +54,7 @@ static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena);
 static ABQ MVTABQ(MVT mvt);
 static Land MVTCBS(MVT mvt);
 static Land MVTFreelist(MVT mvt);
-static Land MVTFailover(MVT mvt);
+static Land MVTFreeLand(MVT mvt);
 
 
 /* Types */
@@ -176,7 +176,7 @@ static Land MVTFreelist(MVT mvt)
 }
 
 
-static Land MVTFailover(MVT mvt)
+static Land MVTFreeLand(MVT mvt)
 {
   return FailoverLand(&mvt->foStruct);
 }
@@ -289,7 +289,7 @@ static Res MVTInit(Pool pool, ArgList args)
   MPS_ARGS_BEGIN(foArgs) {
     MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTCBS(mvt));
     MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreelist(mvt));
-    res = LandInit(MVTFailover(mvt), FailoverLandClassGet(), arena, align, mvt,
+    res = LandInit(MVTFreeLand(mvt), FailoverLandClassGet(), arena, align, mvt,
                    foArgs);
   } MPS_ARGS_END(foArgs);
   if (res != ResOK)
@@ -362,7 +362,7 @@ static Res MVTInit(Pool pool, ArgList args)
   return ResOK;
 
 failABQ:
-  LandFinish(MVTFailover(mvt));
+  LandFinish(MVTFreeLand(mvt));
 failFailover:
   LandFinish(MVTFreelist(mvt));
 failFreelist:
@@ -436,7 +436,7 @@ static void MVTFinish(Pool pool)
 
   /* Finish the ABQ, Failover, Freelist and CBS structures */
   ABQFinish(arena, MVTABQ(mvt));
-  LandFinish(MVTFailover(mvt));
+  LandFinish(MVTFreeLand(mvt));
   LandFinish(MVTFreelist(mvt));
   LandFinish(MVTCBS(mvt));
 }
@@ -816,7 +816,7 @@ static Res MVTInsert(MVT mvt, Addr base, Addr limit)
   AVER(base < limit);
   
   RangeInit(&range, base, limit);
-  res = LandInsert(&newRange, MVTFailover(mvt), &range);
+  res = LandInsert(&newRange, MVTFreeLand(mvt), &range);
   if (res != ResOK)
     return res;
 
@@ -845,7 +845,7 @@ static Res MVTDelete(MVT mvt, Addr base, Addr limit)
   AVER(base < limit);
 
   RangeInit(&range, base, limit);
-  res = LandDelete(&rangeOld, MVTFailover(mvt), &range);
+  res = LandDelete(&rangeOld, MVTFreeLand(mvt), &range);
   if (res != ResOK)
     return res;
   AVER(RangesNest(&rangeOld, &range));
@@ -1023,7 +1023,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
   if(res != ResOK) return res;
   res = LandDescribe(MVTFreelist(mvt), stream);
   if(res != ResOK) return res;
-  res = LandDescribe(MVTFailover(mvt), stream);
+  res = LandDescribe(MVTFreeLand(mvt), stream);
   if(res != ResOK) return res;
   res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream);
   if(res != ResOK) return res;
@@ -1240,7 +1240,7 @@ static void MVTRefillABQIfEmpty(MVT mvt, Size size)
     mvt->abqOverflow = FALSE;
     METER_ACC(mvt->refills, size);
     /* The iteration stops if the ABQ overflows, so may finish or not. */
-    (void)LandIterate(MVTFailover(mvt), MVTRefillVisitor, mvt, UNUSED_SIZE);
+    (void)LandIterate(MVTFreeLand(mvt), MVTRefillVisitor, mvt, UNUSED_SIZE);
   }
 }
  
@@ -1311,7 +1311,7 @@ static Bool MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
   cls.steps = 0;
   cls.hardSteps = 0;
 
-  if (LandIterate(MVTFailover(mvt), MVTContingencyVisitor, &cls, UNUSED_SIZE))
+  if (LandIterate(MVTFreeLand(mvt), MVTContingencyVisitor, &cls, UNUSED_SIZE))
     return FALSE;
 
   AVER(RangeSize(&cls.range) >= min);

From 577c0a0ca0da91a4cde3e181611666c58746b1c1 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 11 Jun 2014 13:29:01 +0100
Subject: [PATCH 51/70] Restore assertions on spare keyword argument,
 accidentally removed in change 186484.

Copied from Perforce
 Change: 186488
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmvff.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 2e02b40d855..ab8858c4d68 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -507,6 +507,8 @@ static Res MVFFInit(Pool pool, ArgList args)
   AVER(extendBy > 0);           /* .arg.check */
   AVER(avgSize > 0);            /* .arg.check */
   AVER(avgSize <= extendBy);    /* .arg.check */
+  AVER(spare >= 0.0);           /* .arg.check */
+  AVER(spare <= 1.0);           /* .arg.check */
   AVERT(Align, align);
   /* This restriction on the alignment is necessary because of the use
    * of a Freelist to store the free address ranges in low-memory

From b0d4fb39bebb20b06f47e9b274464e1092491189 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 11 Jun 2014 13:32:25 +0100
Subject: [PATCH 52/70] Fix incorrect merges.

Copied from Perforce
 Change: 186490
 ServerID: perforce.ravenbrook.com
---
 mps/code/freelist.h           |  5 +++--
 mps/code/gc.gmk               |  3 ++-
 mps/manual/source/release.rst | 14 --------------
 3 files changed, 5 insertions(+), 17 deletions(-)

diff --git a/mps/code/freelist.h b/mps/code/freelist.h
index fe20d48f985..dab791c9c03 100644
--- a/mps/code/freelist.h
+++ b/mps/code/freelist.h
@@ -15,10 +15,11 @@ typedef struct FreelistStruct *Freelist;
 
 #define FreelistLand(fl) (&(fl)->landStruct)
 
-#define FreelistMinimumAlignment ((Align)sizeof(FreelistBlock))
-
 extern Bool FreelistCheck(Freelist freelist);
 
+/* See <design/freelist/#impl.grain.align> */
+#define FreelistMinimumAlignment ((Align)sizeof(FreelistBlock))
+
 extern LandClass FreelistLandClassGet(void);
 
 #endif /* freelist.h */
diff --git a/mps/code/gc.gmk b/mps/code/gc.gmk
index d0ea64d404f..76716dc0785 100644
--- a/mps/code/gc.gmk
+++ b/mps/code/gc.gmk
@@ -25,7 +25,8 @@ CFLAGSCOMPILER := \
 	-Wshadow \
 	-Wstrict-aliasing=2 \
 	-Wstrict-prototypes \
-	-Wswitch-default
+	-Wswitch-default \
+	-Wwrite-strings
 CFLAGSCOMPILERSTRICT := -ansi -pedantic
 
 # A different set of compiler flags for less strict compilation, for
diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index 2696ad26998..a866fb566f4 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -74,20 +74,6 @@ Interface changes
    pools that they are used with. This makes it easier to reuse these
    structures.
 
-#. There is now a default value (currently 1 \ :term:`megabyte`) for
-   the :c:macro:`MPS_KEY_ARENA_SIZE` keyword argument to
-   :c:func:`mps_arena_create_k` when creating a virtual memory arena.
-   See :c:func:`mps_arena_class_vm`.
-
-#. The keyword argument :c:macro:`MPS_KEY_AMS_SUPPORT_AMBIGUOUS` now
-   defaults to ``TRUE`` in order to better support the general case:
-   the value ``FALSE`` is appropriate only when you know that all
-   references are exact. See :ref:`pool-ams`.
-
-#. The :ref:`pool-mvff` pool class takes a new keyword argument
-   :c:macro:`MPS_KEY_SPARE`. This specifies the maximum proportion of
-   memory that the pool will keep spare for future allocations.
-
 
 Other changes
 .............

From a331b13075b76e5e0c7aa6bc77d4042b0980c08d Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 11 Jun 2014 13:59:02 +0100
Subject: [PATCH 53/70] Use unused_pointer and unused_size now we have 'em.

Copied from Perforce
 Change: 186492
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   |  1 +
 mps/code/arenacl.c |  8 ++++----
 mps/code/arenavm.c | 16 ++++++++--------
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 5101908875b..12d7af1137b 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -388,6 +388,7 @@ void ArenaDestroy(Arena arena)
   LandFinish(ArenaFreeLand(arena));
 
   /* The CBS block pool can't free its own memory via ArenaFree because
+     that would use the ZonedCBS. */
   MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
                   UNUSED_POINTER, UNUSED_SIZE);
 
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 58d1abce445..cb4d9865ae3 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -179,9 +179,9 @@ static Bool clientChunkDestroy(Tree tree, void *closureP, Size closureS)
   ClientChunk clChunk;
 
   AVERT(Tree, tree);
-  /* FIXME: AVER(closureP == UNUSED_POINTER); */
+  AVER(closureP == UNUSED_POINTER);
   UNUSED(closureP);
-  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
   
   chunk = ChunkOfTree(tree);
@@ -308,8 +308,8 @@ static void ClientArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */
-  TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy, NULL, 0);
+  TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy,
+                        UNUSED_POINTER, UNUSED_SIZE);
 
   clientArena->sig = SigInvalid;
 
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 800e7aeca21..73ea711f39c 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -408,9 +408,9 @@ static Bool vmChunkDestroy(Tree tree, void *closureP, Size closureS)
   VMChunk vmChunk;
 
   AVERT(Tree, tree);
-  /* FIXME: AVER(closureP == UNUSED_POINTER); */
+  AVER(closureP == UNUSED_POINTER);
   UNUSED(closureP);
-  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
 
   chunk = ChunkOfTree(tree);
@@ -609,8 +609,8 @@ static void VMArenaFinish(Arena arena)
   /* Destroy all chunks, including the primary. See
    * <design/arena/#chunk.delete> */
   arena->primary = NULL;
-  /* FIXME: use UNUSED_POINTER, UNUSED_SIZE instead of NULL, 0 */
-  TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy, NULL, 0);
+  TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy,
+                        UNUSED_POINTER, UNUSED_SIZE);
   
   /* Destroying the chunks should have purged and removed all spare pages. */
   RingFinish(&vmArena->spareRing);
@@ -1102,7 +1102,7 @@ static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
 
   AVERT(Tree, tree);
   AVERT(Arena, arena);
-  /* FIXME: AVER(closureS == UNUSED_SIZE); */
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
 
   vmArena = Arena2VMArena(arena);
@@ -1114,7 +1114,7 @@ static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
   {
     Addr base = chunk->base;
     Size size = ChunkSize(chunk);
-    vmChunkDestroy(tree, closureP, closureS);
+    vmChunkDestroy(tree, UNUSED_POINTER, UNUSED_SIZE);
     vmArena->contracted(arena, base, size);
     return TRUE;
   } else {
@@ -1138,8 +1138,8 @@ static void VMCompact(Arena arena, Trace trace)
   /* Destroy chunks that are completely free, but not the primary
    * chunk. See <design/arena/#chunk.delete>
    * TODO: add hysteresis here. See job003815. */
-  /* FIXME: use UNUSED_SIZE instead of 0 */
-  TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena, 0);
+  TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena,
+                        UNUSED_SIZE);
 
   {
     Size vmem0 = trace->preTraceArenaReserved;

From 17070893194d406b845dd76b7c41100a342450e9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Wed, 11 Jun 2014 14:02:22 +0100
Subject: [PATCH 54/70] Oops, fumbled the merge.

Copied from Perforce
 Change: 186493
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 12d7af1137b..73703277f07 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -388,7 +388,7 @@ void ArenaDestroy(Arena arena)
   LandFinish(ArenaFreeLand(arena));
 
   /* The CBS block pool can't free its own memory via ArenaFree because
-     that would use the ZonedCBS. */
+     that would use the freeLand. */
   MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
                   UNUSED_POINTER, UNUSED_SIZE);
 

From e79e0ee1dd4b5a32cd5781b1d0e41dd9d1fdce1f Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 11:22:55 +0100
Subject: [PATCH 55/70] Need to synchronize stdout and stdin for the benefit of
 windows.

Copied from Perforce
 Change: 186516
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme-advanced.c | 1 +
 mps/example/scheme/scheme-boehm.c    | 1 +
 mps/example/scheme/scheme-malloc.c   | 1 +
 mps/example/scheme/scheme.c          | 1 +
 4 files changed, 4 insertions(+)

diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c
index 476b790f0a4..28a0c2cda52 100644
--- a/mps/example/scheme/scheme-advanced.c
+++ b/mps/example/scheme/scheme-advanced.c
@@ -4400,6 +4400,7 @@ static int start(int argc, char *argv[])
       mps_chat();
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
+      fflush(stdout);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-boehm.c b/mps/example/scheme/scheme-boehm.c
index 8d039433bb4..57dc44d79cd 100644
--- a/mps/example/scheme/scheme-boehm.c
+++ b/mps/example/scheme/scheme-boehm.c
@@ -3620,6 +3620,7 @@ int main(int argc, char *argv[])
       if(setjmp(*error_handler) != 0)
         fprintf(stderr, "%s\n", error_message);
       printf("%lu> ", (unsigned long)total);
+      fflush(stdout);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-malloc.c b/mps/example/scheme/scheme-malloc.c
index 1333ce73aef..395a5638e87 100644
--- a/mps/example/scheme/scheme-malloc.c
+++ b/mps/example/scheme/scheme-malloc.c
@@ -3617,6 +3617,7 @@ int main(int argc, char *argv[])
       if(setjmp(*error_handler) != 0)
         fprintf(stderr, "%s\n", error_message);
       printf("%lu> ", (unsigned long)total);
+      fflush(stdout);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 8a8dcf48ed7..26c7a4b7f54 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -4330,6 +4330,7 @@ static int start(int argc, char *argv[])
       mps_chat();
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
+      fflush(stdout);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);

From e93033f28968aee150f2ddddf26ab82d10792332 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 11:28:41 +0100
Subject: [PATCH 56/70] Must fflush stderr too--it's buffered on windows!

Copied from Perforce
 Change: 186517
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme-advanced.c | 1 +
 mps/example/scheme/scheme-boehm.c    | 1 +
 mps/example/scheme/scheme-malloc.c   | 1 +
 mps/example/scheme/scheme.c          | 1 +
 4 files changed, 4 insertions(+)

diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c
index 28a0c2cda52..418cd64b5f5 100644
--- a/mps/example/scheme/scheme-advanced.c
+++ b/mps/example/scheme/scheme-advanced.c
@@ -4401,6 +4401,7 @@ static int start(int argc, char *argv[])
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
       fflush(stdout);
+      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-boehm.c b/mps/example/scheme/scheme-boehm.c
index 57dc44d79cd..8bbd25f9e7a 100644
--- a/mps/example/scheme/scheme-boehm.c
+++ b/mps/example/scheme/scheme-boehm.c
@@ -3621,6 +3621,7 @@ int main(int argc, char *argv[])
         fprintf(stderr, "%s\n", error_message);
       printf("%lu> ", (unsigned long)total);
       fflush(stdout);
+      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-malloc.c b/mps/example/scheme/scheme-malloc.c
index 395a5638e87..98128cbf59a 100644
--- a/mps/example/scheme/scheme-malloc.c
+++ b/mps/example/scheme/scheme-malloc.c
@@ -3618,6 +3618,7 @@ int main(int argc, char *argv[])
         fprintf(stderr, "%s\n", error_message);
       printf("%lu> ", (unsigned long)total);
       fflush(stdout);
+      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 26c7a4b7f54..8ff551b7034 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -4331,6 +4331,7 @@ static int start(int argc, char *argv[])
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
       fflush(stdout);
+      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);

From 6e72fe4da3b42800002a9148835f7b3479d16218 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 11:37:50 +0100
Subject: [PATCH 57/70] Synchronize stdout and stderr (for the benefit of
 windows).

Copied from Perforce
 Change: 186519
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme-advanced.c | 9 ++++++++-
 mps/example/scheme/scheme-boehm.c    | 9 +++++++--
 mps/example/scheme/scheme-malloc.c   | 9 +++++++--
 mps/example/scheme/scheme.c          | 9 ++++++++-
 4 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c
index 418cd64b5f5..57ee56c9510 100644
--- a/mps/example/scheme/scheme-advanced.c
+++ b/mps/example/scheme/scheme-advanced.c
@@ -409,6 +409,7 @@ static void error(const char *format, ...)
   if (error_handler) {
     longjmp(*error_handler, 1);
   } else {
+    fflush(stdout);
     fprintf(stderr, "Fatal error during initialization: %s\n",
             error_message);
     abort();
@@ -4003,6 +4004,7 @@ static mps_res_t obj_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit)
         break;
       default:
         assert(0);
+        fflush(stdout);
         fprintf(stderr, "Unexpected object on the heap\n");
         abort();
       }
@@ -4073,6 +4075,7 @@ static mps_addr_t obj_skip(mps_addr_t base)
     break;
   default:
     assert(0);
+    fflush(stdout);
     fprintf(stderr, "Unexpected object on the heap\n");
     abort();
   }
@@ -4366,6 +4369,7 @@ static int start(int argc, char *argv[])
              make_operator(optab[i].name, optab[i].entry,
                            obj_empty, obj_empty, env, op_env));
   } else {
+    fflush(stdout);
     fprintf(stderr,
             "Fatal error during initialization: %s\n",
             error_message);
@@ -4375,7 +4379,9 @@ static int start(int argc, char *argv[])
   if(argc >= 2) {
     /* Non-interactive file execution */
     if(setjmp(*error_handler) != 0) {
+      fflush(stdout);
       fprintf(stderr, "%s\n", error_message);
+      fflush(stderr);
       exit_code = EXIT_FAILURE;
     } else {
       load(env, op_env, make_string(strlen(argv[1]), argv[1]));
@@ -4394,14 +4400,15 @@ static int start(int argc, char *argv[])
          "If you recurse too much the interpreter may crash from using too much C stack.");
     for(;;) {
       if(setjmp(*error_handler) != 0) {
+        fflush(stdout);
         fprintf(stderr, "%s\n", error_message);
+        fflush(stderr);
       }
 
       mps_chat();
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
       fflush(stdout);
-      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-boehm.c b/mps/example/scheme/scheme-boehm.c
index 8bbd25f9e7a..f912adfb38a 100644
--- a/mps/example/scheme/scheme-boehm.c
+++ b/mps/example/scheme/scheme-boehm.c
@@ -281,6 +281,7 @@ static void error(char *format, ...)
   if (error_handler) {
     longjmp(*error_handler, 1);
   } else {
+    fflush(stdout);
     fprintf(stderr, "Fatal error during initialization: %s\n",
             error_message);
     abort();
@@ -3599,6 +3600,7 @@ int main(int argc, char *argv[])
              make_operator(optab[i].name, optab[i].entry,
                            obj_empty, obj_empty, env, op_env));
   } else {
+    fflush(stdout);
     fprintf(stderr,
             "Fatal error during initialization: %s\n",
             error_message);
@@ -3608,6 +3610,7 @@ int main(int argc, char *argv[])
   if(argc >= 2) {
     /* Non-interactive file execution */
     if(setjmp(*error_handler) != 0) {
+      fflush(stdout);
       fprintf(stderr, "%s\n", error_message);
       return EXIT_FAILURE;
     }
@@ -3617,11 +3620,13 @@ int main(int argc, char *argv[])
     /* Interactive read-eval-print loop */
     puts("Scheme Test Harness");
     for(;;) {
-      if(setjmp(*error_handler) != 0)
+      if(setjmp(*error_handler) != 0) {
+        fflush(stdout);
         fprintf(stderr, "%s\n", error_message);
+        fflush(stderr);
+      }
       printf("%lu> ", (unsigned long)total);
       fflush(stdout);
-      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme-malloc.c b/mps/example/scheme/scheme-malloc.c
index 98128cbf59a..3f3d55994a8 100644
--- a/mps/example/scheme/scheme-malloc.c
+++ b/mps/example/scheme/scheme-malloc.c
@@ -279,6 +279,7 @@ static void error(char *format, ...)
   if (error_handler) {
     longjmp(*error_handler, 1);
   } else {
+    fflush(stdout);
     fprintf(stderr, "Fatal error during initialization: %s\n",
             error_message);
     abort();
@@ -3596,6 +3597,7 @@ int main(int argc, char *argv[])
              make_operator(optab[i].name, optab[i].entry,
                            obj_empty, obj_empty, env, op_env));
   } else {
+    fflush(stdout);
     fprintf(stderr,
             "Fatal error during initialization: %s\n",
             error_message);
@@ -3605,6 +3607,7 @@ int main(int argc, char *argv[])
   if(argc >= 2) {
     /* Non-interactive file execution */
     if(setjmp(*error_handler) != 0) {
+      fflush(stdout);
       fprintf(stderr, "%s\n", error_message);
       return EXIT_FAILURE;
     }
@@ -3614,11 +3617,13 @@ int main(int argc, char *argv[])
     /* Interactive read-eval-print loop */
     puts("Scheme Test Harness");
     for(;;) {
-      if(setjmp(*error_handler) != 0)
+      if(setjmp(*error_handler) != 0) {
+        fflush(stdout);
         fprintf(stderr, "%s\n", error_message);
+        fflush(stderr);
+      }
       printf("%lu> ", (unsigned long)total);
       fflush(stdout);
-      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);
diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 8ff551b7034..62ec16f2f63 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -401,6 +401,7 @@ static void error(const char *format, ...)
   if (error_handler) {
     longjmp(*error_handler, 1);
   } else {
+    fflush(stdout);
     fprintf(stderr, "Fatal error during initialization: %s\n",
             error_message);
     abort();
@@ -3990,6 +3991,7 @@ static mps_res_t obj_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit)
         break;
       default:
         assert(0);
+        fflush(stdout);
         fprintf(stderr, "Unexpected object on the heap\n");
         abort();
       }
@@ -4066,6 +4068,7 @@ static mps_addr_t obj_skip(mps_addr_t base)
     break;
   default:
     assert(0);
+    fflush(stdout);
     fprintf(stderr, "Unexpected object on the heap\n");
     abort();
   }
@@ -4296,6 +4299,7 @@ static int start(int argc, char *argv[])
              make_operator(optab[i].name, optab[i].entry,
                            obj_empty, obj_empty, env, op_env));
   } else {
+    fflush(stdout);
     fprintf(stderr,
             "Fatal error during initialization: %s\n",
             error_message);
@@ -4305,7 +4309,9 @@ static int start(int argc, char *argv[])
   if(argc >= 2) {
     /* Non-interactive file execution */
     if(setjmp(*error_handler) != 0) {
+      fflush(stdout);
       fprintf(stderr, "%s\n", error_message);
+      fflush(stderr);
       exit_code = EXIT_FAILURE;
     } else {
       load(env, op_env, make_string(strlen(argv[1]), argv[1]));
@@ -4324,14 +4330,15 @@ static int start(int argc, char *argv[])
          "If you recurse too much the interpreter may crash from using too much C stack.");
     for(;;) {
       if(setjmp(*error_handler) != 0) {
+        fflush(stdout);
         fprintf(stderr, "%s\n", error_message);
+        fflush(stderr);
       }
 
       mps_chat();
       printf("%lu, %lu> ", (unsigned long)total,
              (unsigned long)mps_collections(arena));
       fflush(stdout);
-      fflush(stderr);
       obj = read(input);
       if(obj == obj_eof) break;
       obj = eval(env, op_env, obj);

From cf75884793476fd37e4c47c1c58950138bc13e0e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 12:18:30 +0100
Subject: [PATCH 58/70] Refer to rb's e-mail for potential optimization.

Copied from Perforce
 Change: 186524
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index bb2fea2c875..56abf698e39 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1286,7 +1286,13 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
    * but inlined so that we can distinguish between "not pointing to
    * chunk" and "pointing to chunk but not to tract" so that we can
    * check the rank in the latter case. See
-   * <design/trace/#fix.tractofaddr.inline> */
+   * <design/trace/#fix.tractofaddr.inline>
+   *
+   * If compilers fail to do a good job of inlining ChunkOfAddr and
+   * TreeFind then it may become necessary to inline at least the
+   * comparison against the root of the tree. See
+   * <https://info.ravenbrook.com/mail/2014/06/11/13-32-08/0/>
+   */
   if (!ChunkOfAddr(&chunk, ss->arena, ref))
     /* Reference points outside MPS-managed address space: ignore. */
     goto done;

From d482c859292a0e3844bf6fc38eaa9da29d8f2b4e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 13:49:57 +0100
Subject: [PATCH 59/70] Fix rash build.

Copied from Perforce
 Change: 186527
 ServerID: perforce.ravenbrook.com
---
 mps/code/event.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/mps/code/event.c b/mps/code/event.c
index d2b182d7377..5897031bcbe 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -494,11 +494,12 @@ Res EventDescribe(Event event, mps_lib_FILE *stream, Count depth)
 {
   UNUSED(event);
   UNUSED(stream);
+  UNUSED(depth);
   return ResUNIMPL;
 }
 
 
-Res EventWrite(Event event, mps_lib_FILE *stream, Count depth)
+Res EventWrite(Event event, mps_lib_FILE *stream)
 {
   UNUSED(event);
   UNUSED(stream);

From 15df9bb6de43549a79167908e0b98ba0216ab2e5 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 14:25:00 +0100
Subject: [PATCH 60/70] Use xyzpool macros systematically as suggested by nb in
 <https://info.ravenbrook.com/mail/2014/06/11/20-47-37/0/>

Copied from Perforce
 Change: 186529
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c    |  6 ++---
 mps/code/poolamc.c  | 54 ++++++++++++++++++++--------------------
 mps/code/poolams.c  | 60 ++++++++++++++++++++++-----------------------
 mps/code/poolams.h  |  4 +--
 mps/code/poolawl.c  | 41 ++++++++++++++++---------------
 mps/code/poollo.c   |  6 ++---
 mps/code/poolmfs.c  |  8 +++---
 mps/code/poolmrg.c  | 40 +++++++++++++++---------------
 mps/code/poolmv.c   | 22 ++++++++---------
 mps/code/poolmv.h   |  2 +-
 mps/code/poolmv2.c  | 36 +++++++++++++--------------
 mps/code/poolmvff.c | 44 ++++++++++++++++-----------------
 mps/code/pooln.c    |  4 +--
 mps/code/poolsnc.c  | 24 +++++++++---------
 mps/code/reserv.c   |  8 +++---
 mps/code/segsmss.c  | 24 +++++++++---------
 16 files changed, 192 insertions(+), 191 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index a9dec4cd267..d6388a05fd4 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -17,7 +17,7 @@
 SRCID(arena, "$Id$");
 
 
-#define ArenaControlPool(arena) MV2Pool(&(arena)->controlPoolStruct)
+#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct)
 #define ArenaCBSBlockPool(arena) MFSPool(&(arena)->freeCBSBlockPoolStruct)
 #define ArenaFreeLand(arena) CBSLand(&(arena)->freeLandStruct)
 
@@ -409,7 +409,7 @@ Res ControlInit(Arena arena)
   AVERT(Arena, arena);
   MPS_ARGS_BEGIN(args) {
     MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, CONTROL_EXTEND_BY);
-    res = PoolInit(MV2Pool(&arena->controlPoolStruct), arena,
+    res = PoolInit(MVPool(&arena->controlPoolStruct), arena,
                    PoolClassMV(), args);
   } MPS_ARGS_END(args);
   if (res != ResOK)
@@ -425,7 +425,7 @@ void ControlFinish(Arena arena)
 {
   AVERT(Arena, arena);
   arena->poolReady = FALSE;
-  PoolFinish(MV2Pool(&arena->controlPoolStruct));
+  PoolFinish(MVPool(&arena->controlPoolStruct));
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 12f7c5e99f7..14477b6975c 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -48,7 +48,7 @@ typedef struct amcGenStruct {
   Sig sig;                      /* <code/misc.h#sig> */
 } amcGenStruct;
 
-#define amcGenAMC(amcgen) Pool2AMC((amcgen)->pgen.pool)
+#define amcGenAMC(amcgen) PoolAMC((amcgen)->pgen.pool)
 #define amcGenPool(amcgen) ((amcgen)->pgen.pool)
 
 #define amcGenNr(amcgen) ((amcgen)->pgen.nr)
@@ -478,8 +478,8 @@ typedef struct AMCStruct { /* <design/poolamc/#struct> */
   Sig sig;                 /* <design/pool/#outer-structure.sig> */
 } AMCStruct;
 
-#define Pool2AMC(pool) PARENT(AMCStruct, poolStruct, (pool))
-#define AMC2Pool(amc) (&(amc)->poolStruct)
+#define PoolAMC(pool) PARENT(AMCStruct, poolStruct, (pool))
+#define AMCPool(amc) (&(amc)->poolStruct)
 
 
 /* amcGenCheck -- check consistency of a generation structure */
@@ -583,7 +583,7 @@ static Res AMCBufInit(Buffer buffer, Pool pool, ArgList args)
 
   AVERT(Buffer, buffer);
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
 
   if (ArgPick(&arg, args, amcKeyAPHashArrays))
@@ -656,7 +656,7 @@ static Res amcGenCreate(amcGen *genReturn, AMC amc, GenDesc gen)
   Res res;
   void *p;
 
-  pool = AMC2Pool(amc);
+  pool = AMCPool(amc);
   arena = pool->arena;
 
   res = ControlAlloc(&p, arena, sizeof(amcGenStruct), FALSE);
@@ -757,7 +757,7 @@ static Res amcSegCreateNailboard(Seg seg, Pool pool)
 
 static Bool amcPinnedInterior(AMC amc, Nailboard board, Addr base, Addr limit)
 {
-  Size headerSize = AMC2Pool(amc)->format->headerSize;
+  Size headerSize = AMCPool(amc)->format->headerSize;
   return !NailboardIsResRange(board, AddrSub(base, headerSize),
                               AddrSub(limit, headerSize));
 }
@@ -817,7 +817,7 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args)
 
   AVER(pool != NULL);
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   arena = PoolArena(pool);
 
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
@@ -933,7 +933,7 @@ static void AMCFinish(Pool pool)
   Ring node, nextNode;
 
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
 
   EVENT1(AMCFinish, amc);
@@ -995,7 +995,7 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn,
   amcBuf amcbuf;
 
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
@@ -1084,7 +1084,7 @@ static void AMCBufferEmpty(Pool pool, Buffer buffer,
   Seg seg;
 
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   AVERT(Buffer, buffer);
   AVER(BufferIsReady(buffer));
@@ -1123,7 +1123,7 @@ static void AMCRampBegin(Pool pool, Buffer buf, Bool collectAll)
   AMC amc;
 
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   AVERT(Buffer, buf);
   AVERT(Bool, collectAll);
@@ -1145,7 +1145,7 @@ static void AMCRampEnd(Pool pool, Buffer buf)
   AMC amc;
 
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   AVERT(Buffer, buf);
 
@@ -1277,7 +1277,7 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
   condemned += SegSize(seg);
   trace->condemned += condemned;
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
 
   STATISTIC_STAT( {
@@ -1334,7 +1334,7 @@ static Res amcScanNailedRange(Bool *totalReturn, Bool *moreReturn,
   Format format;
   Size headerSize;
   Addr p, clientLimit;
-  Pool pool = AMC2Pool(amc);
+  Pool pool = AMCPool(amc);
   format = pool->format;
   headerSize = format->headerSize;
   p = AddrAdd(base, headerSize);
@@ -1477,7 +1477,7 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   AVERT(ScanState, ss);
   AVERT(Seg, seg);
   AVERT(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
 
 
@@ -1589,7 +1589,7 @@ static Res AMCFixEmergency(Pool pool, ScanState ss, Seg seg,
 
   arena = PoolArena(pool);
   AVERT(Arena, arena);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
 
   ss->wasMarked = TRUE;
@@ -1667,7 +1667,7 @@ static Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
     return ResOK;
   }
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT_CRITICAL(AMC, amc);
   format = pool->format;
   ref = *refIO;
@@ -1816,7 +1816,7 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
     return ResOK;
   }
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT_CRITICAL(AMC, amc);
   format = pool->format;
   headerSize = format->headerSize;
@@ -1930,7 +1930,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
 
   /* All arguments AVERed by AMCReclaim */
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   format = pool->format;
 
@@ -2048,7 +2048,7 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg)
   amcGen gen;
 
   AVERT_CRITICAL(Pool, pool);
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT_CRITICAL(AMC, amc);
   AVERT_CRITICAL(Trace, trace);
   AVERT_CRITICAL(Seg, seg);
@@ -2094,7 +2094,7 @@ static void AMCTraceEnd(Pool pool, Trace trace)
   AVERT(Pool, pool);
   AVERT(Trace, trace);
 
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   AVERT(AMC, amc);
   ti = trace->ti;
   AVERT(TraceId, ti);
@@ -2138,7 +2138,7 @@ static void AMCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
   if(SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY
      && SegNailed(seg) == TraceSetEMPTY)
   {
-    amc = Pool2AMC(pool);
+    amc = PoolAMC(pool);
     AVERT(AMC, amc);
     format = pool->format;
 
@@ -2279,7 +2279,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
 
   if(!TESTT(Pool, pool))
     return ResFAIL;
-  amc = Pool2AMC(pool);
+  amc = PoolAMC(pool);
   if(!TESTT(AMC, amc))
     return ResFAIL;
   if(stream == NULL)
@@ -2288,7 +2288,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
   res = WriteF(stream,
                (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
                " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
-               (WriteFP)AMC2Pool(amc), (WriteFU)AMC2Pool(amc)->serial,
+               (WriteFP)AMCPool(amc), (WriteFU)AMCPool(amc)->serial,
                NULL);
   if(res != ResOK)
     return res;
@@ -2323,7 +2323,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream)
 
   if(0) {
     /* SegDescribes */
-    RING_FOR(node, &AMC2Pool(amc)->segRing, nextNode) {
+    RING_FOR(node, &AMCPool(amc)->segRing, nextNode) {
       Seg seg = RING_ELT(Seg, poolRing, node);
       res = AMCSegDescribe(seg, stream);
       if(res != ResOK)
@@ -2458,8 +2458,8 @@ ATTRIBUTE_UNUSED
 static Bool AMCCheck(AMC amc)
 {
   CHECKS(AMC, amc);
-  CHECKD(Pool, &amc->poolStruct);
-  CHECKL(IsSubclassPoly(amc->poolStruct.class, AMCZPoolClassGet()));
+  CHECKD(Pool, AMCPool(amc));
+  CHECKL(IsSubclassPoly(AMCPool(amc)->class, AMCZPoolClassGet()));
   CHECKL(RankSetCheck(amc->rankSet));
   CHECKD_NOSIG(Ring, &amc->genRing);
   CHECKL(BoolCheck(amc->gensBooted));
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index b5e942c7e84..7586e0fd74b 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -50,7 +50,7 @@ Bool AMSSegCheck(AMSSeg amsseg)
   CHECKS(AMSSeg, amsseg);
   CHECKD(GCSeg, &amsseg->gcSegStruct);
   CHECKU(AMS, amsseg->ams);
-  CHECKL(AMS2Pool(amsseg->ams) == SegPool(seg));
+  CHECKL(AMSPool(amsseg->ams) == SegPool(seg));
   CHECKD_NOSIG(Ring, &amsseg->segRing);
 
   CHECKL(amsseg->grains == AMSGrains(amsseg->ams, SegSize(seg)));
@@ -226,7 +226,7 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size,
   AVERT(Seg, seg);
   amsseg = Seg2AMSSeg(seg);
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   arena = PoolArena(pool);
   /* no useful checks for base and size */
@@ -287,7 +287,7 @@ static void AMSSegFinish(Seg seg)
   AVERT(AMSSeg, amsseg);
   ams = amsseg->ams;
   AVERT(AMS, ams);
-  arena = PoolArena(AMS2Pool(ams));
+  arena = PoolArena(AMSPool(ams));
   AVER(SegBuffer(seg) == NULL);
 
   /* keep the destructions in step with AMSSegInit failure cases */
@@ -346,7 +346,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
   AVERT(AMSSeg, amssegHi);
   /* other parameters are checked by next-method */
   arena = PoolArena(SegPool(seg));
-  ams = Pool2AMS(SegPool(seg));
+  ams = PoolAMS(SegPool(seg));
 
   loGrains = amsseg->grains;
   hiGrains = amssegHi->grains;
@@ -432,7 +432,7 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
   AVERT(AMSSeg, amsseg);
   /* other parameters are checked by next-method */
   arena = PoolArena(SegPool(seg));
-  ams = Pool2AMS(SegPool(seg));
+  ams = PoolAMS(SegPool(seg));
 
   loGrains = AMSGrains(ams, AddrOffset(base, mid));
   hiGrains = AMSGrains(ams, AddrOffset(mid, limit));
@@ -687,7 +687,7 @@ static Res AMSSegCreate(Seg *segReturn, Pool pool, Size size,
   AVERT(RankSet, rankSet);
   AVERT(Bool, withReservoirPermit);
 
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS,ams);
   arena = PoolArena(pool);
 
@@ -732,7 +732,7 @@ static void AMSSegsDestroy(AMS ams)
 {
   Ring ring, node, next;     /* for iterating over the segments */
 
-  ring = PoolSegRing(AMS2Pool(ams));
+  ring = PoolSegRing(AMSPool(ams));
   RING_FOR(node, ring, next) {
     Seg seg = SegOfPoolRing(node);
     AMSSeg amsseg = Seg2AMSSeg(seg);
@@ -805,7 +805,7 @@ static Res AMSInit(Pool pool, ArgList args)
 
   /* .ambiguous.noshare: If the pool is required to support ambiguous */
   /* references, the alloc and white tables cannot be shared. */
-  res = AMSInitInternal(Pool2AMS(pool), format, chain, gen, !supportAmbiguous);
+  res = AMSInitInternal(PoolAMS(pool), format, chain, gen, !supportAmbiguous);
   if (res == ResOK) {
     EVENT3(PoolInitAMS, pool, PoolArena(pool), format);
   }
@@ -826,7 +826,7 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen,
   AVERT(Chain, chain);
   AVER(gen <= ChainGens(chain));
 
-  pool = AMS2Pool(ams);
+  pool = AMSPool(ams);
   AVERT(Pool, pool);
   pool->format = format;
   pool->alignment = pool->format->alignment;
@@ -862,7 +862,7 @@ void AMSFinish(Pool pool)
   AMS ams;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
 
   (ams->segsDestroy)(ams);
@@ -896,7 +896,7 @@ static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn,
   AVERT(AMS, ams);
 
   AVER(size > 0);
-  AVER(SizeIsAligned(size, PoolAlignment(AMS2Pool(ams))));
+  AVER(SizeIsAligned(size, PoolAlignment(AMSPool(ams))));
 
   grains = AMSGrains(ams, size);
   AVER(grains > 0);
@@ -951,7 +951,7 @@ static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   AVERT(Buffer, buffer);
   AVER(size > 0);
@@ -1018,7 +1018,7 @@ static void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
   Size size;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   AVERT(Buffer,buffer);
   AVER(BufferIsReady(buffer));
@@ -1109,7 +1109,7 @@ static Res AMSWhiten(Pool pool, Trace trace, Seg seg)
   Count uncondemned;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
 
   AVERT(Trace, trace);
@@ -1214,9 +1214,9 @@ static Res amsIterate(Seg seg, AMSObjectFunction f, void *closure)
   AVERT(AMSSeg, amsseg);
   ams = amsseg->ams;
   AVERT(AMS, ams);
-  format = AMS2Pool(ams)->format;
+  format = AMSPool(ams)->format;
   AVERT(Format, format);
-  alignment = PoolAlignment(AMS2Pool(ams));
+  alignment = PoolAlignment(AMSPool(ams));
 
   /* If we're using the alloc table as a white table, we can't use it to */
   /* determine where there are objects. */
@@ -1302,7 +1302,7 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
   AVERT(ScanState, closure->ss);
   AVERT(Bool, closure->scanAllObjects);
 
-  format = AMS2Pool(amsseg->ams)->format;
+  format = AMSPool(amsseg->ams)->format;
   AVERT(Format, format);
 
   /* @@@@ This isn't quite right for multiple traces. */
@@ -1343,7 +1343,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   AVER(totalReturn != NULL);
   AVERT(ScanState, ss);
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   arena = PoolArena(pool);
   AVERT(Seg, seg);
@@ -1371,7 +1371,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
     AVER(amsseg->colourTablesInUse);
     format = pool->format;
     AVERT(Format, format);
-    alignment = PoolAlignment(AMS2Pool(ams));
+    alignment = PoolAlignment(AMSPool(ams));
     do { /* <design/poolams/#scan.iter> */
       amsseg->marksChanged = FALSE; /* <design/poolams/#marked.scan> */
       /* <design/poolams/#ambiguous.middle> */
@@ -1436,7 +1436,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   Format format;
 
   AVERT_CRITICAL(Pool, pool);
-  AVER_CRITICAL(TESTT(AMS, Pool2AMS(pool)));
+  AVER_CRITICAL(TESTT(AMS, PoolAMS(pool)));
   AVERT_CRITICAL(ScanState, ss);
   AVERT_CRITICAL(Seg, seg);
   AVER_CRITICAL(refIO != NULL);
@@ -1474,7 +1474,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
 
   switch (ss->rank) {
   case RankAMBIG:
-    if (Pool2AMS(pool)->shareAllocTable)
+    if (PoolAMS(pool)->shareAllocTable)
       /* In this state, the pool doesn't support ambiguous references (see */
       /* .ambiguous.noshare), so this is not a reference. */
       break;
@@ -1551,7 +1551,7 @@ static void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg)
   Res res;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   AVERT(TraceSet, traceSet);
   AVERT(Seg, seg);
@@ -1578,7 +1578,7 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg)
   PoolDebugMixin debug;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   AVERT(Trace, trace);
   AVERT(Seg, seg);
@@ -1650,7 +1650,7 @@ static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
   Ring node, ring, nextNode;    /* for iterating over the segments */
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
 
   ring = &ams->segRing;
@@ -1671,7 +1671,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
   Res res;
 
   if (!TESTT(Pool, pool)) return ResFAIL;
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   if (!TESTT(AMS, ams)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
@@ -1743,7 +1743,7 @@ static PoolDebugMixin AMSDebugMixin(Pool pool)
   AMS ams;
 
   AVERT(Pool, pool);
-  ams = Pool2AMS(pool);
+  ams = PoolAMS(pool);
   AVERT(AMS, ams);
   /* Can't check AMSDebug, because this is called during init */
   return &(AMS2AMSDebug(ams)->debug);
@@ -1769,10 +1769,10 @@ DEFINE_POOL_CLASS(AMSDebugPoolClass, this)
 Bool AMSCheck(AMS ams)
 {
   CHECKS(AMS, ams);
-  CHECKD(Pool, AMS2Pool(ams));
-  CHECKL(IsSubclassPoly(AMS2Pool(ams)->class, AMSPoolClassGet()));
-  CHECKL(PoolAlignment(AMS2Pool(ams)) == AMSGrainsSize(ams, (Size)1));
-  CHECKL(PoolAlignment(AMS2Pool(ams)) == AMS2Pool(ams)->format->alignment);
+  CHECKD(Pool, AMSPool(ams));
+  CHECKL(IsSubclassPoly(AMSPool(ams)->class, AMSPoolClassGet()));
+  CHECKL(PoolAlignment(AMSPool(ams)) == AMSGrainsSize(ams, (Size)1));
+  CHECKL(PoolAlignment(AMSPool(ams)) == AMSPool(ams)->format->alignment);
   CHECKD(PoolGen, &ams->pgen);
   CHECKL(FUNCHECK(ams->segSize));
   CHECKD_NOSIG(Ring, &ams->segRing);
diff --git a/mps/code/poolams.h b/mps/code/poolams.h
index 8c567910b77..a69926e2354 100644
--- a/mps/code/poolams.h
+++ b/mps/code/poolams.h
@@ -79,8 +79,8 @@ typedef struct AMSSegStruct {
 #define Seg2AMSSeg(seg) ((AMSSeg)(seg))
 #define AMSSeg2Seg(amsseg) ((Seg)(amsseg))
 
-#define Pool2AMS(pool) PARENT(AMSStruct, poolStruct, pool)
-#define AMS2Pool(ams) (&(ams)->poolStruct)
+#define PoolAMS(pool) PARENT(AMSStruct, poolStruct, pool)
+#define AMSPool(ams) (&(ams)->poolStruct)
 
 
 /* macros for abstracting index/address computations */
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index 9f751a92059..0ae1e4221e0 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -91,7 +91,8 @@ typedef struct AWLStruct {
   Sig sig;
 } AWLStruct, *AWL;
 
-#define Pool2AWL(pool) PARENT(AWLStruct, poolStruct, pool)
+#define PoolAWL(pool) PARENT(AWLStruct, poolStruct, pool)
+#define AWLPool(awl) (&(awl)->poolStruct)
 #define AWLGrainsSize(awl, grains) ((grains) << (awl)->alignShift)
 
 
@@ -198,7 +199,7 @@ static Res AWLSegInit(Seg seg, Pool pool, Addr base, Size size,
   /* AWL only accepts two ranks */
   AVER(RankSetSingle(RankEXACT) == rankSet
        || RankSetSingle(RankWEAK) == rankSet);
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
 
   /* Initialize the superclass fields first via next-method call */
@@ -262,7 +263,7 @@ static void AWLSegFinish(Seg seg)
   AVERT(AWLSeg, awlseg);
   pool = SegPool(seg);
   AVERT(Pool, pool);
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   arena = PoolArena(pool);
   AVERT(Arena, arena);
@@ -465,7 +466,7 @@ static Res AWLSegCreate(AWLSeg *awlsegReturn,
   AVER(size > 0);
   AVERT(Bool, reservoirPermit);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
 
   arena = PoolArena(pool);
@@ -549,7 +550,7 @@ static Res AWLInit(Pool pool, ArgList args)
   /* Weak check, as half-way through initialization. */
   AVER(pool != NULL);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
   format = arg.val.format;
@@ -602,7 +603,7 @@ static void AWLFinish(Pool pool)
 
   AVERT(Pool, pool);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
 
   ring = &pool->segRing;
@@ -640,7 +641,7 @@ static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(size > 0);
   AVERT(Bool, reservoirPermit);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
 
   RING_FOR(node, &pool->segRing, nextNode) {
@@ -708,7 +709,7 @@ static void AWLBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
   AVERT(Seg, seg);
   AVER(init <= limit);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -753,7 +754,7 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg)
 
   /* All parameters checked by generic PoolWhiten. */
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -819,7 +820,7 @@ static void AWLGrey(Pool pool, Trace trace, Seg seg)
     AWL awl;
     AWLSeg awlseg;
 
-    awl = Pool2AWL(pool);
+    awl = PoolAWL(pool);
     AVERT(AWL, awl);
     awlseg = Seg2AWLSeg(seg);
     AVERT(AWLSeg, awlseg);
@@ -853,7 +854,7 @@ static void AWLBlacken(Pool pool, TraceSet traceSet, Seg seg)
   AVERT(TraceSet, traceSet);
   AVERT(Seg, seg);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -920,7 +921,7 @@ static Res awlScanSinglePass(Bool *anyScannedReturn,
   AVERT(Seg, seg);
   AVERT(Bool, scanAllObjects);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   arena = PoolArena(pool);
   AVERT(Arena, arena);
@@ -996,7 +997,7 @@ static Res AWLScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
 
   /* If the scanner isn't going to scan all the objects then the */
@@ -1046,7 +1047,7 @@ static Res AWLFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   AVER(TraceSetInter(SegWhite(seg), ss->traces) != TraceSetEMPTY);
   AVER(refIO != NULL);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg  = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -1110,7 +1111,7 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg)
   AVERT(Trace, trace);
   AVERT(Seg, seg);
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -1188,7 +1189,7 @@ static Res AWLAccess(Pool pool, Seg seg, Addr addr,
   Res res;
 
   AVERT(Pool, pool);
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   AVERT(Seg, seg);
   AVER(SegBase(seg) <= addr);
@@ -1235,7 +1236,7 @@ static void AWLWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
   AVER(FUNCHECK(f));
   /* p and s are arbitrary closures and can't be checked */
 
-  awl = Pool2AWL(pool);
+  awl = PoolAWL(pool);
   AVERT(AWL, awl);
   awlseg = Seg2AWLSeg(seg);
   AVERT(AWLSeg, awlseg);
@@ -1321,9 +1322,9 @@ ATTRIBUTE_UNUSED
 static Bool AWLCheck(AWL awl)
 {
   CHECKS(AWL, awl);
-  CHECKD(Pool, &awl->poolStruct);
-  CHECKL(awl->poolStruct.class == AWLPoolClassGet());
-  CHECKL(AWLGrainsSize(awl, (Count)1) == awl->poolStruct.alignment);
+  CHECKD(Pool, AWLPool(awl));
+  CHECKL(AWLPool(awl)->class == AWLPoolClassGet());
+  CHECKL(AWLGrainsSize(awl, (Count)1) == PoolAlignment(AWLPool(awl)));
   /* Nothing to check about succAccesses. */
   CHECKL(FUNCHECK(awl->findDependent));
   /* Don't bother to check stats. */
diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index c561f351fc1..800864e1a3b 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -832,10 +832,10 @@ ATTRIBUTE_UNUSED
 static Bool LOCheck(LO lo)
 {
   CHECKS(LO, lo);
-  CHECKD(Pool, &lo->poolStruct);
-  CHECKL(lo->poolStruct.class == EnsureLOPoolClass());
+  CHECKD(Pool, LOPool(lo));
+  CHECKL(LOPool(lo)->class == EnsureLOPoolClass());
   CHECKL(ShiftCheck(lo->alignShift));
-  CHECKL(LOGrainsSize(lo, (Count)1) == PoolAlignment(&lo->poolStruct));
+  CHECKL(LOGrainsSize(lo, (Count)1) == PoolAlignment(LOPool(lo)));
   CHECKD(PoolGen, &lo->pgen);
   return TRUE;
 }
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 2342ceb8778..8b630252c1c 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -353,14 +353,14 @@ Bool MFSCheck(MFS mfs)
   Arena arena;
 
   CHECKS(MFS, mfs);
-  CHECKD(Pool, &mfs->poolStruct);
-  CHECKL(mfs->poolStruct.class == EnsureMFSPoolClass());
+  CHECKD(Pool, MFSPool(mfs));
+  CHECKL(MFSPool(mfs)->class == EnsureMFSPoolClass());
   CHECKL(mfs->unitSize >= UNIT_MIN);
   CHECKL(mfs->extendBy >= UNIT_MIN);
   CHECKL(BoolCheck(mfs->extendSelf));
-  arena = PoolArena(&mfs->poolStruct);
+  arena = PoolArena(MFSPool(mfs));
   CHECKL(SizeIsAligned(mfs->extendBy, ArenaAlign(arena)));
-  CHECKL(SizeAlignUp(mfs->unroundedUnitSize, mfs->poolStruct.alignment) ==
+  CHECKL(SizeAlignUp(mfs->unroundedUnitSize, PoolAlignment(MFSPool(mfs))) ==
          mfs->unitSize);
   if(mfs->tractList != NULL) {
     CHECKD_NOSIG(Tract, mfs->tractList);
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 3e343ee5ed4..eb6f0ba5021 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -119,8 +119,8 @@ typedef struct MRGStruct {
   Sig sig;                  /* <code/mps.h#sig> */
 } MRGStruct;
 
-#define Pool2MRG(pool) PARENT(MRGStruct, poolStruct, pool)
-#define MRG2Pool(mrg) (&(mrg)->poolStruct)
+#define PoolMRG(pool) PARENT(MRGStruct, poolStruct, pool)
+#define MRGPool(mrg) (&(mrg)->poolStruct)
 
 
 /* MRGCheck -- check an MRG pool */
@@ -129,12 +129,12 @@ ATTRIBUTE_UNUSED
 static Bool MRGCheck(MRG mrg)
 {
   CHECKS(MRG, mrg);
-  CHECKD(Pool, &mrg->poolStruct);
-  CHECKL(MRG2Pool(mrg)->class == PoolClassMRG());
+  CHECKD(Pool, MRGPool(mrg));
+  CHECKL(MRGPool(mrg)->class == PoolClassMRG());
   CHECKD_NOSIG(Ring, &mrg->entryRing);
   CHECKD_NOSIG(Ring, &mrg->freeRing);
   CHECKD_NOSIG(Ring, &mrg->refRing);
-  CHECKL(mrg->extendBy == ArenaAlign(PoolArena(MRG2Pool(mrg))));
+  CHECKL(mrg->extendBy == ArenaAlign(PoolArena(MRGPool(mrg))));
   return TRUE;
 }
 
@@ -225,7 +225,7 @@ static Res MRGLinkSegInit(Seg seg, Pool pool, Addr base, Size size,
   AVERT(Seg, seg);
   linkseg = Seg2LinkSeg(seg);
   AVERT(Pool, pool);
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
   /* no useful checks for base and size */
   AVERT(Bool, reservoirPermit);
@@ -268,7 +268,7 @@ static Res MRGRefSegInit(Seg seg, Pool pool, Addr base, Size size,
   AVERT(Seg, seg);
   refseg = Seg2RefSeg(seg);
   AVERT(Pool, pool);
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
   /* no useful checks for base and size */
   AVERT(Bool, reservoirPermit);
@@ -360,7 +360,7 @@ static RefPart MRGRefPartOfLink(Link link, Arena arena)
   linkBase = (Link)SegBase(seg);
   AVER(link >= linkBase);
   indx = (Index)(link - linkBase);
-  AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg))));
+  AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(seg))));
 
   return refPartOfIndex(linkseg->refSeg, indx);
 }
@@ -389,7 +389,7 @@ static Link MRGLinkOfRefPart(RefPart refPart, Arena arena)
   refPartBase = (RefPart)SegBase(seg);
   AVER(refPart >= refPartBase);
   indx = refPart - refPartBase;
-  AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(seg))));
+  AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(seg))));
 
   return linkOfIndex(refseg->linkSeg, indx);
 }
@@ -408,7 +408,7 @@ static void MRGGuardianInit(MRG mrg, Link link, RefPart refPart)
   link->state = MRGGuardianFREE;
   RingAppend(&mrg->freeRing, &link->the.linkRing);
   /* <design/poolmrg/#free.overwrite> */
-  MRGRefPartSetRef(PoolArena(&mrg->poolStruct), refPart, 0);
+  MRGRefPartSetRef(PoolArena(MRGPool(mrg)), refPart, 0);
 }
 
 
@@ -434,7 +434,7 @@ static void MRGMessageDelete(Message message)
   link = linkOfMessage(message);
   AVER(link->state == MRGGuardianFINAL);
   MessageFinish(message);
-  MRGGuardianInit(Pool2MRG(pool), link, MRGRefPartOfLink(link, arena));
+  MRGGuardianInit(PoolMRG(pool), link, MRGRefPartOfLink(link, arena));
 }
 
 
@@ -516,7 +516,7 @@ static Res MRGSegPairCreate(MRGRefSeg *refSegReturn, MRG mrg,
 
   AVER(refSegReturn != NULL);
 
-  pool = MRG2Pool(mrg);
+  pool = MRGPool(mrg);
   arena = PoolArena(pool);
 
   nGuardians = MRGGuardiansPerSeg(mrg);
@@ -566,7 +566,7 @@ static void MRGFinalize(Arena arena, MRGLinkSeg linkseg, Index indx)
   Link link;
   Message message;
 
-  AVER(indx < MRGGuardiansPerSeg(Pool2MRG(SegPool(LinkSeg2Seg(linkseg)))));
+  AVER(indx < MRGGuardiansPerSeg(PoolMRG(SegPool(LinkSeg2Seg(linkseg)))));
 
   link = linkOfIndex(linkseg, indx);
 
@@ -597,7 +597,7 @@ static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg)
   AVERT(MRGRefSeg, refseg);
   AVERT(MRG, mrg);
 
-  arena = PoolArena(MRG2Pool(mrg));
+  arena = PoolArena(MRGPool(mrg));
   linkseg = refseg->linkSeg;
 
   nGuardians = MRGGuardiansPerSeg(mrg);
@@ -638,7 +638,7 @@ static Res MRGInit(Pool pool, ArgList args)
   AVERT(ArgList, args);
   UNUSED(args);
  
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
 
   RingInit(&mrg->entryRing);
   RingInit(&mrg->freeRing);
@@ -660,7 +660,7 @@ static void MRGFinish(Pool pool)
   Ring node, nextNode;
 
   AVERT(Pool, pool);
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
 
   /* .finish.ring: Before destroying the segments, we isolate the */
@@ -714,7 +714,7 @@ Res MRGRegister(Pool pool, Ref ref)
   AVERT(Pool, pool);
   AVER(ref != 0);
 
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
 
   arena = PoolArena(pool);
@@ -757,7 +757,7 @@ Res MRGDeregister(Pool pool, Ref obj)
   AVERT(Pool, pool);
   /* Can't check obj */
 
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
   nGuardians = MRGGuardiansPerSeg(mrg);
   arena = PoolArena(pool);
@@ -805,7 +805,7 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream)
   Res res;
 
   if (!TESTT(Pool, pool)) return ResFAIL;
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   if (!TESTT(MRG, mrg)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
@@ -836,7 +836,7 @@ static Res MRGScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   AVERT(Pool, pool);
   AVERT(Seg, seg);
 
-  mrg = Pool2MRG(pool);
+  mrg = PoolMRG(pool);
   AVERT(MRG, mrg);
 
   AVER(SegRankSet(seg) == RankSetSingle(RankFINAL)); /* .improve.rank */
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 3d6fd02a9ea..fc5e62987ed 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -38,7 +38,7 @@ SRCID(poolmv, "$Id$");
 #define mvSpanPool(mv) MFSPool(&(mv)->spanPoolStruct)
 
 
-#define Pool2MV(pool) PARENT(MVStruct, poolStruct, pool)
+#define PoolMV(pool) PARENT(MVStruct, poolStruct, pool)
 
 
 /* MVDebug -- MV Debug pool class */
@@ -244,7 +244,7 @@ static Res MVInit(Pool pool, ArgList args)
   AVER(extendBy <= maxSize);
 
   pool->alignment = align;
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   arena = PoolArena(pool);
 
   /* At 100% fragmentation we will need one block descriptor for every other */
@@ -296,7 +296,7 @@ static void MVFinish(Pool pool)
   MVSpan span;
 
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
 
   /* Destroy all the spans attached to the pool. */
@@ -521,7 +521,7 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
 
   AVER(pReturn != NULL);
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
   AVER(size > 0);
   AVERT(Bool, withReservoirPermit);
@@ -627,7 +627,7 @@ static void MVFree(Pool pool, Addr old, Size size)
   Tract tract = NULL;           /* suppress "may be used uninitialized" */
 
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
 
   AVER(old != (Addr)0);
@@ -680,7 +680,7 @@ static PoolDebugMixin MVDebugMixin(Pool pool)
   MV mv;
 
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
   /* Can't check MVDebug, because this is called during MVDebug init */
   return &(MV2MVDebug(mv)->debug);
@@ -698,7 +698,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
   Ring spans, node = NULL, nextNode; /* gcc whinge stop */
 
   if(!TESTT(Pool, pool)) return ResFAIL;
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   if(!TESTT(MV, mv)) return ResFAIL;
   if(stream == NULL) return ResFAIL;
 
@@ -859,7 +859,7 @@ size_t mps_mv_free_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
 
   spans = &mv->spans;
@@ -884,7 +884,7 @@ size_t mps_mv_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mv = Pool2MV(pool);
+  mv = PoolMV(pool);
   AVERT(MV, mv);
 
   spans = &mv->spans;
@@ -903,8 +903,8 @@ size_t mps_mv_size(mps_pool_t mps_pool)
 Bool MVCheck(MV mv)
 {
   CHECKS(MV, mv);
-  CHECKD(Pool, &mv->poolStruct);
-  CHECKL(IsSubclassPoly(mv->poolStruct.class, EnsureMVPoolClass()));
+  CHECKD(Pool, MVPool(mv));
+  CHECKL(IsSubclassPoly(MVPool(mv)->class, EnsureMVPoolClass()));
   CHECKD(MFS, &mv->blockPoolStruct);
   CHECKD(MFS, &mv->spanPoolStruct);
   CHECKL(mv->extendBy > 0);
diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h
index 8e6885254bc..01c5b9ebd73 100644
--- a/mps/code/poolmv.h
+++ b/mps/code/poolmv.h
@@ -26,7 +26,7 @@ extern PoolClass PoolClassMV(void);
 
 extern Bool MVCheck(MV mv);
 
-#define MV2Pool(mv) (&(mv)->poolStruct)
+#define MVPool(mv) (&(mv)->poolStruct)
 
 
 #endif /* poolmv_h */
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 47fee298e53..09c15e59c53 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -151,8 +151,8 @@ DEFINE_POOL_CLASS(MVTPoolClass, this)
 
 /* Macros */
 
-#define Pool2MVT(pool) PARENT(MVTStruct, poolStruct, pool)
-#define MVT2Pool(mvt) (&(mvt)->poolStruct)
+#define PoolMVT(pool) PARENT(MVTStruct, poolStruct, pool)
+#define MVTPool(mvt) (&(mvt)->poolStruct)
 
 
 /* Accessors */
@@ -233,7 +233,7 @@ static Res MVTInit(Pool pool, ArgList args)
   ArgStruct arg;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   /* can't AVERT mvt, yet */
   arena = PoolArena(pool);
   AVERT(Arena, arena);
@@ -379,8 +379,8 @@ ATTRIBUTE_UNUSED
 static Bool MVTCheck(MVT mvt)
 {
   CHECKS(MVT, mvt);
-  CHECKD(Pool, &mvt->poolStruct);
-  CHECKL(mvt->poolStruct.class == MVTPoolClassGet());
+  CHECKD(Pool, MVTPool(mvt));
+  CHECKL(MVTPool(mvt)->class == MVTPoolClassGet());
   CHECKD(CBS, &mvt->cbsStruct);
   CHECKD(ABQ, &mvt->abqStruct);
   CHECKD(Freelist, &mvt->flStruct);
@@ -418,7 +418,7 @@ static void MVTFinish(Pool pool)
   Ring node, nextNode;
  
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
   arena = PoolArena(pool);
   AVERT(Arena, arena);
@@ -494,7 +494,7 @@ static Res MVTOversizeFill(Addr *baseReturn,
   Addr base, limit;
   Size alignedSize;
 
-  alignedSize = SizeAlignUp(minSize, ArenaAlign(PoolArena(MVT2Pool(mvt))));
+  alignedSize = SizeAlignUp(minSize, ArenaAlign(PoolArena(MVTPool(mvt))));
 
   res = MVTSegAlloc(&seg, mvt, alignedSize, withReservoirPermit);
   if (res != ResOK)
@@ -568,7 +568,7 @@ static void MVTOneSegOnly(Addr *baseIO, Addr *limitIO, MVT mvt, Size minSize)
   base = *baseIO;
   limit = *limitIO;
   
-  arena = PoolArena(MVT2Pool(mvt));
+  arena = PoolArena(MVTPool(mvt));
 
   SURELY(SegOfAddr(&seg, arena, base));
   segLimit = SegLimit(seg);
@@ -690,7 +690,7 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
   AVERT(Buffer, buffer);
   AVER(BufferIsReset(buffer));
@@ -782,7 +782,7 @@ static Bool MVTReserve(MVT mvt, Range range)
 
   /* See <design/poolmvt/#impl.c.free.merge> */
   if (!ABQPush(MVTABQ(mvt), range)) {
-    Arena arena = PoolArena(MVT2Pool(mvt));
+    Arena arena = PoolArena(MVTPool(mvt));
     RangeStruct oldRange;
     /* We just failed to push, so the ABQ must be full, and so surely
      * the peek will succeed. */
@@ -884,7 +884,7 @@ static void MVTBufferEmpty(Pool pool, Buffer buffer,
   Res res;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
   AVERT(Buffer, buffer);
   AVER(BufferIsReady(buffer));
@@ -949,7 +949,7 @@ static void MVTFree(Pool pool, Addr base, Size size)
   Addr limit;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
   AVER(base != (Addr)0);
   AVER(size > 0);
@@ -995,7 +995,7 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
   MVT mvt;
 
   if (!TESTT(Pool, pool)) return ResFAIL;
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   if (!TESTT(MVT, mvt)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
@@ -1100,7 +1100,7 @@ size_t mps_mvt_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
 
   return (size_t)mvt->size;
@@ -1118,7 +1118,7 @@ size_t mps_mvt_free_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
 
   return (size_t)mvt->available;
@@ -1137,7 +1137,7 @@ static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size,
   /* Can't use plain old SegClass here because we need to call
    * SegBuffer() in MVTFree(). */
   Res res = SegAlloc(segReturn, SegClassGet(),
-                     SegPrefDefault(), size, MVT2Pool(mvt), withReservoirPermit,
+                     SegPrefDefault(), size, MVTPool(mvt), withReservoirPermit,
                      argsNone);
 
   if (res == ResOK) {
@@ -1306,7 +1306,7 @@ static Bool MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
   MVTContigencyClosureStruct cls;
 
   cls.mvt = mvt;
-  cls.arena = PoolArena(MVT2Pool(mvt));
+  cls.arena = PoolArena(MVTPool(mvt));
   cls.min = min;
   cls.steps = 0;
   cls.hardSteps = 0;
@@ -1363,7 +1363,7 @@ Land _mps_mvt_cbs(Pool pool) {
   MVT mvt;
 
   AVERT(Pool, pool);
-  mvt = Pool2MVT(pool);
+  mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
 
   return MVTCBS(mvt);
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index ab8858c4d68..fc8ab6d345f 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -64,8 +64,8 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
 } MVFFStruct;
 
 
-#define Pool2MVFF(pool)     PARENT(MVFFStruct, poolStruct, pool)
-#define MVFF2Pool(mvff)     (&(mvff)->poolStruct)
+#define PoolMVFF(pool)     PARENT(MVFFStruct, poolStruct, pool)
+#define MVFFPool(mvff)     (&(mvff)->poolStruct)
 #define MVFFTotalCBS(mvff)  CBSLand(&(mvff)->totalCBSStruct)
 #define MVFFFreeCBS(mvff)   CBSLand(&(mvff)->freeCBSStruct)
 #define MVFFFreelist(mvff)  FreelistLand(&(mvff)->flStruct)
@@ -107,7 +107,7 @@ static void MVFFReduce(MVFF mvff)
   Align align;
 
   AVERT(MVFF, mvff);
-  arena = PoolArena(MVFF2Pool(mvff));
+  arena = PoolArena(MVFFPool(mvff));
 
   /* NOTE: Memory is returned to the arena in the smallest units
      possible (arena grains). There's a possibility that this could
@@ -191,7 +191,7 @@ static void MVFFReduce(MVFF mvff)
       break;
     }
 
-    ArenaFree(RangeBase(&pageRange), RangeSize(&pageRange), MVFF2Pool(mvff));
+    ArenaFree(RangeBase(&pageRange), RangeSize(&pageRange), MVFFPool(mvff));
   }
 }
 
@@ -218,7 +218,7 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
   AVER(size > 0);
   AVERT(Bool, withReservoirPermit);
 
-  pool = MVFF2Pool(mvff);
+  pool = MVFFPool(mvff);
   arena = PoolArena(pool);
   align = ArenaAlign(arena);
 
@@ -281,7 +281,7 @@ static Bool MVFFFindFree(Range rangeReturn, MVFF mvff, Size size)
   AVER(rangeReturn != NULL);
   AVERT(MVFF, mvff);
   AVER(size > 0);
-  AVER(SizeIsAligned(size, PoolAlignment(MVFF2Pool(mvff))));
+  AVER(SizeIsAligned(size, PoolAlignment(MVFFPool(mvff))));
 
   findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW;
 
@@ -304,7 +304,7 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
   Bool foundBlock;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
   AVER(aReturn != NULL);
@@ -344,7 +344,7 @@ static void MVFFFree(Pool pool, Addr old, Size size)
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
   AVER(old != (Addr)0);
@@ -374,7 +374,7 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
   AVERT(Buffer, buffer);
   AVER(size > 0);
@@ -412,7 +412,7 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer,
   RangeStruct range, coalescedRange;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
   AVERT(Buffer, buffer);
   AVER(BufferIsReady(buffer));
@@ -519,7 +519,7 @@ static Res MVFFInit(Pool pool, ArgList args)
   AVERT(Bool, arenaHigh);
   AVERT(Bool, firstFit);
 
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
 
   mvff->extendBy = extendBy;
   if (extendBy < ArenaAlign(arena))
@@ -616,7 +616,7 @@ static void MVFFFinish(Pool pool)
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
   mvff->sig = SigInvalid;
 
@@ -641,7 +641,7 @@ static PoolDebugMixin MVFFDebugMixin(Pool pool)
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
   /* Can't check MVFFDebug, because this is called during init */
   return &(MVFF2MVFFDebug(mvff)->debug);
@@ -656,7 +656,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   MVFF mvff;
 
   if (!TESTT(Pool, pool)) return ResFAIL;
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   if (!TESTT(MVFF, mvff)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
@@ -752,7 +752,7 @@ size_t mps_mvff_free_size(mps_pool_t mps_pool)
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
   return (size_t)LandSize(MVFFFreeLand(mvff));
@@ -767,7 +767,7 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
   return (size_t)LandSize(MVFFTotalCBS(mvff));
@@ -780,10 +780,10 @@ ATTRIBUTE_UNUSED
 static Bool MVFFCheck(MVFF mvff)
 {
   CHECKS(MVFF, mvff);
-  CHECKD(Pool, MVFF2Pool(mvff));
-  CHECKL(IsSubclassPoly(MVFF2Pool(mvff)->class, MVFFPoolClassGet()));
+  CHECKD(Pool, MVFFPool(mvff));
+  CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, MVFFPoolClassGet()));
   CHECKD(SegPref, MVFFSegPref(mvff));
-  CHECKL(mvff->extendBy >= ArenaAlign(PoolArena(MVFF2Pool(mvff))));
+  CHECKL(mvff->extendBy >= ArenaAlign(PoolArena(MVFFPool(mvff))));
   CHECKL(mvff->avgSize > 0);                    /* see .arg.check */
   CHECKL(mvff->avgSize <= mvff->extendBy);      /* see .arg.check */
   CHECKL(mvff->spare >= 0.0);                   /* see .arg.check */
@@ -793,8 +793,8 @@ static Bool MVFFCheck(MVFF mvff)
   CHECKD(Land, MVFFFreelist(mvff));
   CHECKD(Land, MVFFFreeLand(mvff));
   CHECKL(LandSize(MVFFTotalCBS(mvff)) >= LandSize(MVFFFreeLand(mvff)));
-  CHECKL(SizeIsAligned(LandSize(MVFFFreeLand(mvff)), PoolAlignment(MVFF2Pool(mvff))));
-  CHECKL(SizeIsAligned(LandSize(MVFFTotalCBS(mvff)), ArenaAlign(PoolArena(MVFF2Pool(mvff)))));
+  CHECKL(SizeIsAligned(LandSize(MVFFFreeLand(mvff)), PoolAlignment(MVFFPool(mvff))));
+  CHECKL(SizeIsAligned(LandSize(MVFFTotalCBS(mvff)), ArenaAlign(PoolArena(MVFFPool(mvff)))));
   CHECKL(BoolCheck(mvff->slotHigh));
   CHECKL(BoolCheck(mvff->firstFit));
   return TRUE;
@@ -808,7 +808,7 @@ Land _mps_mvff_cbs(Pool pool) {
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = Pool2MVFF(pool);
+  mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
   return MVFFFreeCBS(mvff);
diff --git a/mps/code/pooln.c b/mps/code/pooln.c
index a53e1dceca2..e340af74858 100644
--- a/mps/code/pooln.c
+++ b/mps/code/pooln.c
@@ -303,8 +303,8 @@ PoolClass PoolClassN(void)
 Bool PoolNCheck(PoolN poolN)
 {
   CHECKL(poolN != NULL);
-  CHECKD(Pool, &poolN->poolStruct);
-  CHECKL(poolN->poolStruct.class == EnsureNPoolClass());
+  CHECKD(Pool, PoolNPool(poolN));
+  CHECKL(PoolNPool(poolN)->class == EnsureNPoolClass());
   UNUSED(poolN); /* <code/mpm.c#check.unused> */
 
   return TRUE;
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index 139865fc5ec..5fd44c9786d 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -40,8 +40,8 @@ typedef struct SNCStruct {
   Sig sig;
 } SNCStruct, *SNC;
 
-#define Pool2SNC(pool) \
-  PARENT(SNCStruct, poolStruct, (pool))
+#define PoolSNC(pool) PARENT(SNCStruct, poolStruct, (pool))
+#define SNCPool(snc) (&(snc)->poolStruct)
 
 
 /* Forward declarations */
@@ -165,7 +165,7 @@ static void SNCBufFinish(Buffer buffer)
   AVERT(SNCBuf, sncbuf);
   pool = BufferPool(buffer);
 
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   /* Put any segments which haven't bee popped onto the free list */
   sncPopPartialSegChain(snc, buffer, NULL);
 
@@ -384,7 +384,7 @@ static Res SNCInit(Pool pool, ArgList args)
   /* weak check, as half-way through initialization */
   AVER(pool != NULL);
 
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
 
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
   format = arg.val.format;
@@ -408,7 +408,7 @@ static void SNCFinish(Pool pool)
   Ring ring, node, nextNode;
 
   AVERT(Pool, pool);
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   AVERT(SNC, snc);
 
   ring = &pool->segRing;
@@ -438,7 +438,7 @@ static Res SNCBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVERT(Bool, withReservoirPermit);
   AVER(BufferIsReset(buffer));
 
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   AVERT(SNC, snc);
 
   /* Try to find a free segment with enough space already */
@@ -485,7 +485,7 @@ static void SNCBufferEmpty(Pool pool, Buffer buffer,
   seg = BufferSeg(buffer);
   AVER(init <= limit);
   AVER(SegLimit(seg) == limit);
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   AVERT(SNC, snc);
   AVER(BufferFrameState(buffer) == BufferFrameVALID);
   /* .lw-frame-state */
@@ -514,7 +514,7 @@ static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   AVERT(ScanState, ss);
   AVERT(Seg, seg);
   AVERT(Pool, pool);
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   AVERT(SNC, snc);
 
   format = pool->format;
@@ -591,7 +591,7 @@ static void SNCFramePopPending(Pool pool, Buffer buf, AllocFrame frame)
   AVERT(Pool, pool);
   AVERT(Buffer, buf);
   /* frame is an Addr and can't be directly checked */
-  snc = Pool2SNC(pool);
+  snc = PoolSNC(pool);
   AVERT(SNC, snc);
 
   AVER(BufferFrameState(buf) == BufferFrameVALID);
@@ -644,7 +644,7 @@ static void SNCWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
     SNC snc;
     Format format;
 
-    snc = Pool2SNC(pool);
+    snc = PoolSNC(pool);
     AVERT(SNC, snc);
     format = pool->format;
 
@@ -702,8 +702,8 @@ ATTRIBUTE_UNUSED
 static Bool SNCCheck(SNC snc)
 {
   CHECKS(SNC, snc);
-  CHECKD(Pool, &snc->poolStruct);
-  CHECKL(snc->poolStruct.class == SNCPoolClassGet());
+  CHECKD(Pool, SNCPool(snc));
+  CHECKL(SNCPool(snc)->class == SNCPoolClassGet());
   if (snc->freeSegs != NULL) {
     CHECKD(Seg, snc->freeSegs);
   }
diff --git a/mps/code/reserv.c b/mps/code/reserv.c
index c7dd0507482..f6340c5b5cc 100644
--- a/mps/code/reserv.c
+++ b/mps/code/reserv.c
@@ -16,7 +16,7 @@ SRCID(reserv, "$Id$");
 
 /* The reservoir pool is defined here. See <design/reservoir/> */
 
-#define Pool2Reservoir(pool) PARENT(ReservoirStruct, poolStruct, pool)
+#define PoolReservoir(pool) PARENT(ReservoirStruct, poolStruct, pool)
 
 
 /* Management of tracts
@@ -30,7 +30,7 @@ SRCID(reserv, "$Id$");
 #define resTractSetNext(tract, next) (TractSetP((tract), (void*)(next)))
 
 
-#define reservoirArena(reservoir) ((reservoir)->poolStruct.arena)
+#define reservoirArena(reservoir) (PoolArena(ReservoirPool(reservoir)))
 
 
 /* ResPoolInit -- Reservoir pool init method */
@@ -58,7 +58,7 @@ static void ResPoolFinish(Pool pool)
   Reservoir reservoir;
 
   AVERT(Pool, pool);
-  reservoir = Pool2Reservoir(pool);
+  reservoir = PoolReservoir(pool);
   AVERT(Reservoir, reservoir);
   AVER(reservoir->reserve == NULL);  /* .reservoir.finish */
 }
@@ -88,7 +88,7 @@ Bool ReservoirCheck(Reservoir reservoir)
 
   CHECKS(Reservoir, reservoir);
   CHECKD(Pool, ReservoirPool(reservoir));
-  CHECKL(reservoir->poolStruct.class == reservoircl);
+  CHECKL(ReservoirPool(reservoir)->class == reservoircl);
   UNUSED(reservoircl); /* <code/mpm.c#check.unused> */
   arena = reservoirArena(reservoir);
   CHECKU(Arena, arena);
diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c
index 20cedf67dd2..056a794cda2 100644
--- a/mps/code/segsmss.c
+++ b/mps/code/segsmss.c
@@ -52,7 +52,7 @@ typedef struct AMSTStruct {
 
 typedef struct AMSTStruct *AMST;
 
-#define Pool2AMST(pool) PARENT(AMSTStruct, amsStruct, PARENT(AMSStruct, poolStruct, (pool)))
+#define PoolAMST(pool) PARENT(AMSTStruct, amsStruct, PARENT(AMSStruct, poolStruct, (pool)))
 #define AMST2AMS(amst)  (&(amst)->amsStruct)
 
 
@@ -122,7 +122,7 @@ static Res amstSegInit(Seg seg, Pool pool, Addr base, Size size,
   AVERT(Seg, seg);
   amstseg = Seg2AMSTSeg(seg);
   AVERT(Pool, pool);
-  amst = Pool2AMST(pool);
+  amst = PoolAMST(pool);
   AVERT(AMST, amst);
   /* no useful checks for base and size */
   AVERT(Bool, reservoirPermit);
@@ -190,7 +190,7 @@ static Res amstSegMerge(Seg seg, Seg segHi,
   amstsegHi = Seg2AMSTSeg(segHi);
   AVERT(AMSTSeg, amstseg);
   AVERT(AMSTSeg, amstsegHi);
-  amst = Pool2AMST(SegPool(seg));
+  amst = PoolAMST(SegPool(seg));
 
   /* Merge the superclass fields via direct next-method call */
   super = SEG_SUPERCLASS(AMSTSegClass);
@@ -241,7 +241,7 @@ static Res amstSegSplit(Seg seg, Seg segHi,
   amstseg = Seg2AMSTSeg(seg);
   amstsegHi = Seg2AMSTSeg(segHi);
   AVERT(AMSTSeg, amstseg);
-  amst = Pool2AMST(SegPool(seg));
+  amst = PoolAMST(SegPool(seg));
 
   /* Split the superclass fields via direct next-method call */
   super = SEG_SUPERCLASS(AMSTSegClass);
@@ -351,11 +351,11 @@ static Res AMSTInit(Pool pool, ArgList args)
   ArgRequire(&arg, args, MPS_KEY_FORMAT);
   format = arg.val.format;
   
-  res = AMSInitInternal(Pool2AMS(pool), format, chain, gen, FALSE);
+  res = AMSInitInternal(PoolAMS(pool), format, chain, gen, FALSE);
   if (res != ResOK)
     return res;
-  amst = Pool2AMST(pool);
-  ams = Pool2AMS(pool);
+  amst = PoolAMST(pool);
+  ams = PoolAMS(pool);
   ams->segSize = AMSTSegSizePolicy;
   ams->segClass = AMSTSegClassGet;
   amst->failSegs = TRUE;
@@ -378,7 +378,7 @@ static void AMSTFinish(Pool pool)
   AMST amst;
 
   AVERT(Pool, pool);
-  amst = Pool2AMST(pool);
+  amst = PoolAMST(pool);
   AVERT(AMST, amst);
 
   printf("\nDestroying pool, having performed:\n");
@@ -418,7 +418,7 @@ static Bool AMSSegRegionIsFree(Seg seg, Addr base, Addr limit)
   AVERT(Seg, seg);
   amsseg = Seg2AMSSeg(seg);
   sbase = SegBase(seg);
-  ams = Pool2AMS(SegPool(seg));
+  ams = PoolAMS(SegPool(seg));
 
   bgrain = AMSGrains(ams, AddrOffset(sbase, base));
   lgrain = AMSGrains(ams, AddrOffset(sbase, limit));
@@ -544,8 +544,8 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(limitReturn != NULL);
   /* other parameters are checked by next method */
   arena = PoolArena(pool);
-  ams = Pool2AMS(pool);
-  amst = Pool2AMST(pool);
+  ams = PoolAMS(pool);
+  amst = PoolAMST(pool);
 
   /* call next method */
   super = POOL_SUPERCLASS(AMSTPoolClass);
@@ -630,7 +630,7 @@ static void AMSTStressBufferedSeg(Seg seg, Buffer buffer)
   AVERT(AMSTSeg, amstseg);
   limit = BufferLimit(buffer);
   arena = PoolArena(SegPool(seg));
-  amst = Pool2AMST(SegPool(seg));
+  amst = PoolAMST(SegPool(seg));
   AVERT(AMST, amst);
 
   if (amstseg->next != NULL) {

From fedb4a69c869703bc875213d889ed68578c19a19 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 14:26:13 +0100
Subject: [PATCH 61/70] Remove out-of-date material and public interface
 material that's covered in the reference manual.

Copied from Perforce
 Change: 186530
 ServerID: perforce.ravenbrook.com
---
 mps/design/poolmvff.txt | 64 ++++-------------------------------------
 1 file changed, 5 insertions(+), 59 deletions(-)

diff --git a/mps/design/poolmvff.txt b/mps/design/poolmvff.txt
index b46cace73ae..d29efc6ba89 100644
--- a/mps/design/poolmvff.txt
+++ b/mps/design/poolmvff.txt
@@ -40,75 +40,18 @@ allocation can be used at the same time, but in that case, the first
 ap must be created before any allocations.
 
 _`.over.buffer.class`: The pool uses the simplest buffer class,
-BufferClass. This is appropriate since these buffers don't attach to
-segments, and hence don't constrain buffered regions to lie within
+``BufferClass``. This is appropriate since these buffers don't attach
+to segments, and hence don't constrain buffered regions to lie within
 segment boundaries.
 
 
 Methods
 -------
 
-_`.method`: The MVFF pool supports the following methods:
-
-``Res MVFFInit(Pool pool, Args arg)``
-
-_`.method.init`: This takes six `keyword arguments`_:
-
-.. _`keyword arguments`: keyword-arguments
-
-================================== ============================================
-Keyword argument                   Description
-================================== ============================================
-``MPS_KEY_EXTEND_BY``              The segment size.
-``MPS_KEY_MEAN_SIZE``              The average object size.
-``MPS_KEY_ALIGN``                  The alignment of allocations and frees.
-                                   Must be at least ``sizeof(void *)``.
-``MPS_KEY_MVFF_SLOT_HIGH``         Whether to allocate objects at the end of 
-                                   free blocks found, as opposed to at
-                                   the start (for unbuffered
-                                   allocation).
-``MPS_KEY_MVFF_ARENA_HIGH``        Whether to express ``SegPrefHIGH``
-                                   to the arena, as opposed to
-                                   ``SegPrefLOW``.
-``MPS_KEY_MVFF_FIRST_FIT``         whether to use the suitable block of lowest
-                                   address, as opposed to the highest
-                                   (for unbuffered allocation)
-================================== ============================================
-
-_`.method.init.epdl`: To simulate the EPDL pool, specify ``extendBy``,
-``avgSize``, and ``maxSize`` as normal, and use ``slotHigh=FALSE``,
-``arenaHigh=FALSE``, ``firstFit=TRUE``.
-
-_`.method.init.epdr`: To simulate the EPDR pool, specify ``extendBy``,
-``avgSize``, and ``maxSize`` as normal, and use ``slotHigh=TRUE``,
-``arenaHigh=TRUE``, ``firstFit=TRUE``.
-
-_`.method.init.other`: The performance characteristics of other
-combinations are unknown.
-
-_`.method.alloc`: ``PoolAlloc()`` and ``PoolFree()`` methods are
-supported, implementing the policy set by the pool params (see
-`.method.init`_).
-
 _`.method.buffer`: The buffer methods implement a worst-fit fill
 strategy.
 
 
-External Functions
-------------------
-
-_`.function`: MVFF supports the following external functions:
-
-_`.function.free-size`: ``mps_mvff_free_size()`` returns the total
-size of free space in segments allocated to the MVFF pool instance.
-
-_`.function.size`: ``mps_mvff_size()`` returns the total memory used
-by pool segments, whether free or allocated.
-
-_`.function.class`: ``mps_class_mvff()`` returns the class object for
-the pool class, to be used in pool creation.
-
-
 Implementation
 --------------
 
@@ -162,6 +105,9 @@ Document History
 - 2014-04-15 GDR_ The address ranges acquired from the arena are now
   stored in a CBS; segments are no longer used for this purpose.
 
+- 2014-06-12 GDR_ Remove public interface documentation (this is in
+  the reference manual).
+
 .. _RB: http://www.ravenbrook.com/consultants/rb/
 .. _GDR: http://www.ravenbrook.com/consultants/gdr/
 

From 36fe212dba4debceef8f1abe5c434e0ef22401b5 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 15:53:55 +0100
Subject: [PATCH 62/70] Fix problems noted by nb in review
 <https://info.ravenbrook.com/mail/2014/06/11/20-47-37/0/>

Copied from Perforce
 Change: 186533
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmv2.c  |  48 +++++-----
 mps/code/poolmvff.c | 211 +++++++++++++++++++++-----------------------
 2 files changed, 124 insertions(+), 135 deletions(-)

diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 09c15e59c53..d929a1a04d6 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -52,8 +52,8 @@ static Res MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
                                 MVT mvt, Size min);
 static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena);
 static ABQ MVTABQ(MVT mvt);
-static Land MVTCBS(MVT mvt);
-static Land MVTFreelist(MVT mvt);
+static Land MVTFreePrimary(MVT mvt);
+static Land MVTFreeSecondary(MVT mvt);
 static Land MVTFreeLand(MVT mvt);
 
 
@@ -164,13 +164,13 @@ static ABQ MVTABQ(MVT mvt)
 }
 
 
-static Land MVTCBS(MVT mvt)
+static Land MVTFreePrimary(MVT mvt)
 {
   return CBSLand(&mvt->cbsStruct);
 }
 
 
-static Land MVTFreelist(MVT mvt)
+static Land MVTFreeSecondary(MVT mvt)
 {
   return FreelistLand(&mvt->flStruct);
 }
@@ -276,28 +276,28 @@ static Res MVTInit(Pool pool, ArgList args)
   if (abqDepth < 3)
     abqDepth = 3;
 
-  res = LandInit(MVTCBS(mvt), CBSFastLandClassGet(), arena, align, mvt,
+  res = LandInit(MVTFreePrimary(mvt), CBSFastLandClassGet(), arena, align, mvt,
                  mps_args_none);
   if (res != ResOK)
-    goto failCBS;
+    goto failFreePrimaryInit;
  
-  res = LandInit(MVTFreelist(mvt), FreelistLandClassGet(), arena, align, mvt,
-                 mps_args_none);
+  res = LandInit(MVTFreeSecondary(mvt), FreelistLandClassGet(), arena, align,
+                 mvt, mps_args_none);
   if (res != ResOK)
-    goto failFreelist;
+    goto failFreeSecondaryInit;
   
   MPS_ARGS_BEGIN(foArgs) {
-    MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTCBS(mvt));
-    MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreelist(mvt));
+    MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTFreePrimary(mvt));
+    MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreeSecondary(mvt));
     res = LandInit(MVTFreeLand(mvt), FailoverLandClassGet(), arena, align, mvt,
                    foArgs);
   } MPS_ARGS_END(foArgs);
   if (res != ResOK)
-    goto failFailover;
+    goto failFreeLandInit;
 
   res = ABQInit(arena, MVTABQ(mvt), (void *)mvt, abqDepth, sizeof(RangeStruct));
   if (res != ResOK)
-    goto failABQ;
+    goto failABQInit;
 
   pool->alignment = align;
   mvt->reuseSize = reuseSize;
@@ -361,13 +361,13 @@ static Res MVTInit(Pool pool, ArgList args)
                reserveDepth, fragLimit);
   return ResOK;
 
-failABQ:
+failABQInit:
   LandFinish(MVTFreeLand(mvt));
-failFailover:
-  LandFinish(MVTFreelist(mvt));
-failFreelist:
-  LandFinish(MVTCBS(mvt));
-failCBS:
+failFreeLandInit:
+  LandFinish(MVTFreeSecondary(mvt));
+failFreeSecondaryInit:
+  LandFinish(MVTFreePrimary(mvt));
+failFreePrimaryInit:
   AVER(res != ResOK);
   return res;
 }
@@ -437,8 +437,8 @@ static void MVTFinish(Pool pool)
   /* Finish the ABQ, Failover, Freelist and CBS structures */
   ABQFinish(arena, MVTABQ(mvt));
   LandFinish(MVTFreeLand(mvt));
-  LandFinish(MVTFreelist(mvt));
-  LandFinish(MVTCBS(mvt));
+  LandFinish(MVTFreeSecondary(mvt));
+  LandFinish(MVTFreePrimary(mvt));
 }
 
 
@@ -1019,9 +1019,9 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
                NULL);
   if(res != ResOK) return res;
 
-  res = LandDescribe(MVTCBS(mvt), stream);
+  res = LandDescribe(MVTFreePrimary(mvt), stream);
   if(res != ResOK) return res;
-  res = LandDescribe(MVTFreelist(mvt), stream);
+  res = LandDescribe(MVTFreeSecondary(mvt), stream);
   if(res != ResOK) return res;
   res = LandDescribe(MVTFreeLand(mvt), stream);
   if(res != ResOK) return res;
@@ -1366,7 +1366,7 @@ Land _mps_mvt_cbs(Pool pool) {
   mvt = PoolMVT(pool);
   AVERT(MVT, mvt);
 
-  return MVTCBS(mvt);
+  return MVTFreePrimary(mvt);
 }
 
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index fc8ab6d345f..e63b03972e7 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -10,16 +10,12 @@
  *
  * .design: <design/poolmvff>
  *
- * TRANSGRESSIONS
- *
- * .trans.stat: mps_mvff_stat is a temporary hack for measurement purposes,
- * see .stat below.
- *
  * NOTE
  *
  * There's potential for up to 4% speed improvement by calling Land
  * methods statically instead of indirectly via the Land abstraction
- * (thus, cbsInsert instead of LandInsert, and so on).
+ * (thus, cbsInsert instead of LandInsert, and so on). See
+ * <https://info.ravenbrook.com/mail/2014/05/13/16-38-50/0/>
  */
 
 #include "cbs.h"
@@ -55,9 +51,9 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
   double spare;                 /* spare space fraction, see MVFFReduce */
   MFSStruct cbsBlockPoolStruct; /* stores blocks for CBSs */
   CBSStruct totalCBSStruct;     /* all memory allocated from the arena */
-  CBSStruct freeCBSStruct;      /* free list */
-  FreelistStruct flStruct;      /* emergency free list */
-  FailoverStruct foStruct;      /* fail-over mechanism */
+  CBSStruct freeCBSStruct;      /* free memory (primary) */
+  FreelistStruct flStruct;      /* free memory (secondary, for emergencies) */
+  FailoverStruct foStruct;      /* free memory (fail-over mechanism) */
   Bool firstFit;                /* as opposed to last fit */
   Bool slotHigh;                /* prefers high part of large block */
   Sig sig;                      /* <design/sig/> */
@@ -66,9 +62,9 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
 
 #define PoolMVFF(pool)     PARENT(MVFFStruct, poolStruct, pool)
 #define MVFFPool(mvff)     (&(mvff)->poolStruct)
-#define MVFFTotalCBS(mvff)  CBSLand(&(mvff)->totalCBSStruct)
-#define MVFFFreeCBS(mvff)   CBSLand(&(mvff)->freeCBSStruct)
-#define MVFFFreelist(mvff)  FreelistLand(&(mvff)->flStruct)
+#define MVFFTotalLand(mvff)  CBSLand(&(mvff)->totalCBSStruct)
+#define MVFFFreePrimary(mvff)   CBSLand(&(mvff)->freeCBSStruct)
+#define MVFFFreeSecondary(mvff)  FreelistLand(&(mvff)->flStruct)
 #define MVFFFreeLand(mvff)  FailoverLand(&(mvff)->foStruct)
 #define MVFFSegPref(mvff)   (&(mvff)->segPrefStruct)
 #define MVFFBlockPool(mvff) MFSPool(&(mvff)->cbsBlockPoolStruct)
@@ -90,14 +86,10 @@ typedef MVFFDebugStruct *MVFFDebug;
 #define MVFFDebug2MVFF(mvffd) (&((mvffd)->mvffStruct))
 
 
-/* MVFFReduce -- free tracts from given range
+/* MVFFReduce -- return memory to the arena
  *
- * Given a free range, attempts to find entire tracts within it, and
- * returns them to the arena.
- *
- * This is usually called immediately after MVFFInsert. It is not
- * combined with MVFFInsert because the latter is also called when new
- * segments are added under MVFFAlloc.
+ * This is usually called immediately after inserting a range into the
+ * MVFFFreeLand. (But not in all cases: see MVFFExtend.)
  */
 static void MVFFReduce(MVFF mvff)
 {
@@ -119,12 +111,8 @@ static void MVFFReduce(MVFF mvff)
 
   /* Try to return memory when the amount of free memory exceeds a
      threshold fraction of the total memory. */
-  
-  /* NOTE: If this code becomes very hot, then the test of whether there's
-     a large free block in the CBS could be inlined, since it's a property
-     stored at the root node. */
 
-  freeLimit = (Size)(LandSize(MVFFTotalCBS(mvff)) * mvff->spare);
+  freeLimit = (Size)(LandSize(MVFFTotalLand(mvff)) * mvff->spare);
   freeSize = LandSize(MVFFFreeLand(mvff));
   if (freeSize < freeLimit)
     return;
@@ -137,6 +125,10 @@ static void MVFFReduce(MVFF mvff)
      one page back to the arena, thus ensuring that eventually the
      loop will terminate */
 
+  /* NOTE: If this code becomes very hot, then the test of whether there's
+     a large free block in the CBS could be inlined, since it's a property
+     stored at the root node. */
+
   while (freeSize > targetFree
          && LandFindLargest(&freeRange, &oldFreeRange, MVFFFreeLand(mvff),
                             align, FindDeleteNONE))
@@ -151,10 +143,9 @@ static void MVFFReduce(MVFF mvff)
     base = AddrAlignUp(RangeBase(&freeRange), align);
     limit = AddrAlignDown(RangeLimit(&freeRange), align);
     
-    /* Give up if the block is too small to contain a whole page when
-       aligned, even though it might be masking smaller better aligned
-       pages that we could return, because CBSFindLargest won't be able
-       to find those. */
+    /* Give up if this block doesn't contain a whole aligned page,
+       even though smaller better-aligned blocks might, because
+       LandFindLargest won't be able to find those anyway. */
     if (base >= limit)
       break;
 
@@ -183,7 +174,7 @@ static void MVFFReduce(MVFF mvff)
     freeSize -= RangeSize(&pageRange);
     AVER(freeSize == LandSize(MVFFFreeLand(mvff)));
 
-    res = LandDelete(&oldRange, MVFFTotalCBS(mvff), &pageRange);
+    res = LandDelete(&oldRange, MVFFTotalLand(mvff), &pageRange);
     if (res != ResOK) {
       RangeStruct coalescedRange;
       res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &pageRange);
@@ -225,7 +216,7 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
   AVER(SizeIsAligned(size, PoolAlignment(pool)));
 
   /* Use extendBy unless it's too small (see */
-  /* <design/poolmvff/#design.seg-size>). */
+  /* <design/poolmvff/#design.acquire-size>). */
   if (size <= mvff->extendBy)
     allocSize = mvff->extendBy;
   else
@@ -245,7 +236,7 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
   }
 
   RangeInitSize(&range, base, allocSize);
-  res = LandInsert(&coalescedRange, MVFFTotalCBS(mvff), &range);
+  res = LandInsert(&coalescedRange, MVFFTotalLand(mvff), &range);
   if (res != ResOK) {
     /* Can't record this memory, so return it to the arena and fail. */
     ArenaFree(base, allocSize, pool);
@@ -254,6 +245,7 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
 
   DebugPoolFreeSplat(pool, RangeBase(&range), RangeLimit(&range));
   res = LandInsert(rangeReturn, MVFFFreeLand(mvff), &range);
+  /* Insertion must succeed because it fails over to a Freelist. */
   AVER(res == ResOK);
 
   /* Don't call MVFFReduce; that would be silly. */
@@ -262,34 +254,47 @@ static Res MVFFExtend(Range rangeReturn, MVFF mvff, Size size,
 }
 
 
-/* MVFFFindFree -- find the first (or last) suitable free block
+/* mvffFindFree -- find a suitable free block or add one
  *
- * Finds a free block of the given (pool aligned) size, according
- * to a first (or last) fit policy controlled by the MVFF fields
- * firstFit, slotHigh (for whether to allocate the top or bottom
- * portion of a larger block).
+ * Finds a free block of the given (pool aligned) size, using the
+ * policy (first fit, last fit, or worst fit) specified by findMethod
+ * and findDelete.
  *
- * Will return FALSE if the free lists have no large enough block. In
- * particular, will not attempt to allocate a new segment.
+ * If there is no suitable free block, try extending the pool.
  */
-static Bool MVFFFindFree(Range rangeReturn, MVFF mvff, Size size)
+static Res mvffFindFree(Range rangeReturn, MVFF mvff, Size size,
+                        LandFindMethod findMethod, FindDelete findDelete,
+                        Bool withReservoirPermit)
 {
-  Bool foundBlock;
-  FindDelete findDelete;
+  Bool found;
   RangeStruct oldRange;
+  Land land;
 
   AVER(rangeReturn != NULL);
   AVERT(MVFF, mvff);
   AVER(size > 0);
   AVER(SizeIsAligned(size, PoolAlignment(MVFFPool(mvff))));
+  AVER(FUNCHECK(findMethod));
+  AVERT(FindDelete, findDelete);
+  AVERT(Bool, withReservoirPermit);
 
-  findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW;
+  land = MVFFFreeLand(mvff);
+  found = (*findMethod)(rangeReturn, &oldRange, land, size, findDelete);
+  if (!found) {
+    RangeStruct newRange;
+    Res res;
+    res = MVFFExtend(&newRange, mvff, size, withReservoirPermit);
+    if (res != ResOK)
+      return res;
+    found = (*findMethod)(rangeReturn, &oldRange, land, size, findDelete);
 
-  foundBlock =
-    (mvff->firstFit ? LandFindFirst : LandFindLast)
-    (rangeReturn, &oldRange, MVFFFreeLand(mvff), size, findDelete);
+    /* We know that the found range must intersect the newly added
+     * range. But it doesn't necessarily lie entirely within it. */
+    AVER(found && RangesOverlap(rangeReturn, &newRange));
+  }
+  AVER(found);
 
-  return foundBlock;
+  return ResOK;
 }
 
 
@@ -301,36 +306,27 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
   Res res;
   MVFF mvff;
   RangeStruct range;
-  Bool foundBlock;
+  LandFindMethod findMethod;
+  FindDelete findDelete;
 
+  AVER(aReturn != NULL);
   AVERT(Pool, pool);
   mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
-
-  AVER(aReturn != NULL);
   AVER(size > 0);
   AVERT(Bool, withReservoirPermit);
 
   size = SizeAlignUp(size, PoolAlignment(pool));
+  findMethod = mvff->firstFit ? LandFindFirst : LandFindLast;
+  findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW;
 
-  foundBlock = MVFFFindFree(&range, mvff, size);
-  if (!foundBlock) {
-    RangeStruct addRange;
+  res = mvffFindFree(&range, mvff, size, findMethod, findDelete,
+                     withReservoirPermit);
+  if (res != ResOK)
+    return res;
 
-    res = MVFFExtend(&addRange, mvff, size, withReservoirPermit);
-    if (res != ResOK)
-      return res;
-    foundBlock = MVFFFindFree(&range, mvff, size);
-
-    /* We know that the found range must intersect the new segment. */
-    /* In particular, it doesn't necessarily lie entirely within it. */
-    AVER(foundBlock && RangesOverlap(&range, &addRange));
-  }
-  AVER(foundBlock);
   AVER(RangeSize(&range) == size);
-
   *aReturn = RangeBase(&range);
-
   return ResOK;
 }
 
@@ -353,6 +349,7 @@ static void MVFFFree(Pool pool, Addr old, Size size)
 
   RangeInitSize(&range, old, SizeAlignUp(size, PoolAlignment(pool)));
   res = LandInsert(&coalescedRange, MVFFFreeLand(mvff), &range);
+  /* Insertion must succeed because it fails over to a Freelist. */
   AVER(res == ResOK);
   MVFFReduce(mvff);
 }
@@ -369,8 +366,8 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
 {
   Res res;
   MVFF mvff;
-  RangeStruct range, oldRange, newRange;
-  Bool found;
+  RangeStruct range;
+
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
@@ -381,19 +378,10 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(SizeIsAligned(size, PoolAlignment(pool)));
   AVERT(Bool, withReservoirPermit);
 
-  found = LandFindLargest(&range, &oldRange, MVFFFreeLand(mvff), size,
-                          FindDeleteENTIRE);
-  if (!found) {
-    /* Add a new range to the free lists and try again. */
-    res = MVFFExtend(&newRange, mvff, size, withReservoirPermit);
-    if (res != ResOK)
-      return res;
-    found = LandFindLargest(&range, &oldRange, MVFFFreeLand(mvff), size,
-                            FindDeleteENTIRE);
-    AVER(found && RangesOverlap(&range, &newRange));
-  }
-  AVER(found);
-  AVER(RangesEqual(&range, &oldRange));
+  res = mvffFindFree(&range, mvff, size, LandFindLargest, FindDeleteENTIRE,
+                     withReservoirPermit);
+  if (res != ResOK)
+    return res;
   AVER(RangeSize(&range) >= size);
 
   *baseReturn = RangeBase(&range);
@@ -546,33 +534,33 @@ static Res MVFFInit(Pool pool, ArgList args)
 
   MPS_ARGS_BEGIN(liArgs) {
     MPS_ARGS_ADD(liArgs, CBSBlockPool, MVFFBlockPool(mvff));
-    res = LandInit(MVFFTotalCBS(mvff), CBSFastLandClassGet(), arena, align,
+    res = LandInit(MVFFTotalLand(mvff), CBSFastLandClassGet(), arena, align,
                    mvff, liArgs);
   } MPS_ARGS_END(liArgs);
   if (res != ResOK)
-    goto failTotalCBSInit;
+    goto failTotalLandInit;
 
   MPS_ARGS_BEGIN(liArgs) {
     MPS_ARGS_ADD(liArgs, CBSBlockPool, MVFFBlockPool(mvff));
-    res = LandInit(MVFFFreeCBS(mvff), CBSFastLandClassGet(), arena, align,
+    res = LandInit(MVFFFreePrimary(mvff), CBSFastLandClassGet(), arena, align,
                    mvff, liArgs);
   } MPS_ARGS_END(liArgs);
   if (res != ResOK)
-    goto failFreeCBSInit;
+    goto failFreePrimaryInit;
 
-  res = LandInit(MVFFFreelist(mvff), FreelistLandClassGet(), arena, align,
+  res = LandInit(MVFFFreeSecondary(mvff), FreelistLandClassGet(), arena, align,
                  mvff, mps_args_none);
   if (res != ResOK)
-    goto failFreelistInit;
+    goto failFreeSecondaryInit;
 
   MPS_ARGS_BEGIN(foArgs) {
-    MPS_ARGS_ADD(foArgs, FailoverPrimary, MVFFFreeCBS(mvff));
-    MPS_ARGS_ADD(foArgs, FailoverSecondary, MVFFFreelist(mvff));
+    MPS_ARGS_ADD(foArgs, FailoverPrimary, MVFFFreePrimary(mvff));
+    MPS_ARGS_ADD(foArgs, FailoverSecondary, MVFFFreeSecondary(mvff));
     res = LandInit(MVFFFreeLand(mvff), FailoverLandClassGet(), arena, align,
                    mvff, foArgs);
   } MPS_ARGS_END(foArgs);
   if (res != ResOK)
-    goto failFailoverInit;
+    goto failFreeLandInit;
 
   mvff->sig = MVFFSig;
   AVERT(MVFF, mvff);
@@ -580,13 +568,13 @@ static Res MVFFInit(Pool pool, ArgList args)
          BOOLOF(slotHigh), BOOLOF(arenaHigh), BOOLOF(firstFit));
   return ResOK;
 
-failFailoverInit:
-  LandFinish(MVFFFreelist(mvff));
-failFreelistInit:
-  LandFinish(MVFFFreeCBS(mvff));
-failFreeCBSInit:
-  LandFinish(MVFFTotalCBS(mvff));
-failTotalCBSInit:
+failFreeLandInit:
+  LandFinish(MVFFFreeSecondary(mvff));
+failFreeSecondaryInit:
+  LandFinish(MVFFFreePrimary(mvff));
+failFreePrimaryInit:
+  LandFinish(MVFFTotalLand(mvff));
+failTotalLandInit:
   PoolFinish(MVFFBlockPool(mvff));
 failBlockPoolInit:
   return res;
@@ -620,16 +608,16 @@ static void MVFFFinish(Pool pool)
   AVERT(MVFF, mvff);
   mvff->sig = SigInvalid;
 
-  LandIterate(MVFFTotalCBS(mvff), mvffFinishVisitor, pool, 0);
+  LandIterate(MVFFTotalLand(mvff), mvffFinishVisitor, pool, 0);
 
-  /* TODO: would like to check that LandSize(MVFFTotalCBS(mvff)) == 0
+  /* TODO: would like to check that LandSize(MVFFTotalLand(mvff)) == 0
    * now, but CBS doesn't support deletion while iterating. See
    * job003826. */
 
   LandFinish(MVFFFreeLand(mvff));
-  LandFinish(MVFFFreelist(mvff));
-  LandFinish(MVFFFreeCBS(mvff));
-  LandFinish(MVFFTotalCBS(mvff));
+  LandFinish(MVFFFreeSecondary(mvff));
+  LandFinish(MVFFFreePrimary(mvff));
+  LandFinish(MVFFTotalLand(mvff));
   PoolFinish(MVFFBlockPool(mvff));
 }
 
@@ -676,13 +664,13 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   res = PoolDescribe(MVFFBlockPool(mvff), stream);
   if (res != ResOK) return res;
 
-  res = LandDescribe(MVFFTotalCBS(mvff), stream);
+  res = LandDescribe(MVFFTotalLand(mvff), stream);
   if (res != ResOK) return res;
 
-  res = LandDescribe(MVFFFreeCBS(mvff), stream);
+  res = LandDescribe(MVFFFreePrimary(mvff), stream);
   if (res != ResOK) return res;
 
-  res = LandDescribe(MVFFFreelist(mvff), stream);
+  res = LandDescribe(MVFFFreeSecondary(mvff), stream);
   if (res != ResOK) return res;
 
   res = WriteF(stream, "}\n", NULL);
@@ -770,7 +758,7 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
   mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
-  return (size_t)LandSize(MVFFTotalCBS(mvff));
+  return (size_t)LandSize(MVFFTotalLand(mvff));
 }
 
 
@@ -788,13 +776,14 @@ static Bool MVFFCheck(MVFF mvff)
   CHECKL(mvff->avgSize <= mvff->extendBy);      /* see .arg.check */
   CHECKL(mvff->spare >= 0.0);                   /* see .arg.check */
   CHECKL(mvff->spare <= 1.0);                   /* see .arg.check */
-  CHECKD(Land, MVFFTotalCBS(mvff));
-  CHECKD(Land, MVFFFreeCBS(mvff));
-  CHECKD(Land, MVFFFreelist(mvff));
-  CHECKD(Land, MVFFFreeLand(mvff));
-  CHECKL(LandSize(MVFFTotalCBS(mvff)) >= LandSize(MVFFFreeLand(mvff)));
+  CHECKD(MFS, &mvff->cbsBlockPoolStruct);
+  CHECKD(CBS, &mvff->totalCBSStruct);
+  CHECKD(CBS, &mvff->freeCBSStruct);
+  CHECKD(Freelist, &mvff->flStruct);
+  CHECKD(Failover, &mvff->foStruct);
+  CHECKL(LandSize(MVFFTotalLand(mvff)) >= LandSize(MVFFFreeLand(mvff)));
   CHECKL(SizeIsAligned(LandSize(MVFFFreeLand(mvff)), PoolAlignment(MVFFPool(mvff))));
-  CHECKL(SizeIsAligned(LandSize(MVFFTotalCBS(mvff)), ArenaAlign(PoolArena(MVFFPool(mvff)))));
+  CHECKL(SizeIsAligned(LandSize(MVFFTotalLand(mvff)), ArenaAlign(PoolArena(MVFFPool(mvff)))));
   CHECKL(BoolCheck(mvff->slotHigh));
   CHECKL(BoolCheck(mvff->firstFit));
   return TRUE;
@@ -811,7 +800,7 @@ Land _mps_mvff_cbs(Pool pool) {
   mvff = PoolMVFF(pool);
   AVERT(MVFF, mvff);
 
-  return MVFFFreeCBS(mvff);
+  return MVFFFreePrimary(mvff);
 }
 
 

From 00a5b8e436c95fa431113d8ec36758d514fe7be7 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 16:24:39 +0100
Subject: [PATCH 63/70] Fix problems noted by rb in review
 <https://info.ravenbrook.com/mail/2014/06/11/15-16-51/0/>.

Copied from Perforce
 Change: 186537
 ServerID: perforce.ravenbrook.com
---
 mps/code/misc.h     | 11 +++++------
 mps/code/mpscmv.h   |  5 +++--
 mps/code/mpscmv2.h  | 17 +++++++----------
 mps/code/mpscmvff.h |  5 +++--
 mps/code/mpscmvt.h  | 24 ++----------------------
 mps/code/poolabs.c  |  2 +-
 6 files changed, 21 insertions(+), 43 deletions(-)

diff --git a/mps/code/misc.h b/mps/code/misc.h
index 3d0f259ff72..c07647f54db 100644
--- a/mps/code/misc.h
+++ b/mps/code/misc.h
@@ -156,13 +156,12 @@ typedef const struct SrcIdStruct {
  *
  * Use these values for unused pointer, size closure arguments and
  * check them in the callback or visitor.
- * 
- * We use PointerAdd rather than a cast to avoid "warning C4306: 'type
- * cast' : conversion from 'unsigned int' to 'Pointer' of greater
- * size" on platform w3i6mv.
+ *
+ * Ensure that they have high bits set on 64-bit platforms for maximum
+ * unusability.
  */
-#define UNUSED_POINTER PointerAdd(0, 0xB60405ED) /* PointeR UNUSED */
-#define UNUSED_SIZE ((Size)0x520405ED) /* SiZe UNUSED */
+#define UNUSED_POINTER (Pointer)((Word)~0xFFFFFFFF | (Word)0xB60405ED) /* PointeR UNUSED */
+#define UNUSED_SIZE ((Size)~0xFFFFFFFF | (Size)0x520405ED) /* SiZe UNUSED */
 
 
 /* PARENT -- parent structure
diff --git a/mps/code/mpscmv.h b/mps/code/mpscmv.h
index aeb163aec4a..5c6522ae1e9 100644
--- a/mps/code/mpscmv.h
+++ b/mps/code/mpscmv.h
@@ -9,8 +9,9 @@
 
 #include "mps.h"
 
-#define mps_mv_free_size(pool) (mps_pool_free_size(pool))
-#define mps_mv_size(pool) (mps_pool_total_size(pool))
+#define mps_mv_free_size mps_pool_free_size
+#define mps_mv_size mps_pool_total_size
+
 extern mps_class_t mps_class_mv(void);
 extern mps_class_t mps_class_mv_debug(void);
 
diff --git a/mps/code/mpscmv2.h b/mps/code/mpscmv2.h
index 8586a639901..8925d38d3b3 100644
--- a/mps/code/mpscmv2.h
+++ b/mps/code/mpscmv2.h
@@ -1,27 +1,24 @@
 /* mpscmv2.h: MEMORY POOL SYSTEM CLASS "MVT"
  *
  * $Id$
- * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ *
+ * The MVT pool class used to be known as "MV2" in some places: this
+ * header provides backwards compatibility for prograns that included
+ * it under its old name.
  */
 
 #ifndef mpscmv2_h
 #define mpscmv2_h
 
-#include "mps.h"
-
-extern mps_class_t mps_class_mvt(void);
-
-/* The mvt pool class supports two extensions to the pool protocol:
-   size and free_size. */
-extern size_t mps_mvt_free_size(mps_pool_t mps_pool);
-extern size_t mps_mvt_size(mps_pool_t mps_pool);
+#include "mpscmvt.h"
 
 #endif /* mpscmv2_h */
 
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 
diff --git a/mps/code/mpscmvff.h b/mps/code/mpscmvff.h
index ec1eb22eff9..ca1fbcae697 100644
--- a/mps/code/mpscmvff.h
+++ b/mps/code/mpscmvff.h
@@ -19,8 +19,9 @@ extern const struct mps_key_s _mps_key_mvff_first_fit;
 #define MPS_KEY_MVFF_FIRST_FIT (&_mps_key_mvff_first_fit)
 #define MPS_KEY_MVFF_FIRST_FIT_FIELD b
 
-#define mps_mvff_free_size(pool) (mps_pool_free_size(pool))
-#define mps_mvff_size(pool) (mps_pool_total_size(pool))
+#define mps_mvff_free_size mps_pool_free_size
+#define mps_mvff_size mps_pool_total_size
+
 extern mps_class_t mps_class_mvff(void);
 extern mps_class_t mps_class_mvff_debug(void);
 
diff --git a/mps/code/mpscmvt.h b/mps/code/mpscmvt.h
index 82792eb3f55..9490d5ffb77 100644
--- a/mps/code/mpscmvt.h
+++ b/mps/code/mpscmvt.h
@@ -16,30 +16,10 @@ extern const struct mps_key_s _mps_key_mvt_frag_limit;
 #define MPS_KEY_MVT_FRAG_LIMIT (&_mps_key_mvt_frag_limit)
 #define MPS_KEY_MVT_FRAG_LIMIT_FIELD d
 
-/* The mvt pool class has five extra parameters to mps_pool_create:
- *  mps_res_t mps_pool_create(mps_pool_t * pool, mps_arena_t arena,
- *                            mps_class_t mvt_class,
- *                            size_t minimum_size,
- *                            size_t mean_size,
- *                            size_t maximum_size,
- *                            mps_count_t reserve_depth
- *                            mps_count_t fragmentation_limit);
- * minimum_, mean_, and maximum_size are the mimimum, mean, and
- * maximum (typical) size of objects expected to be allocated in the
- * pool.  reserve_depth is a measure of the expected hysteresis of the
- * object population.  fragmentation_limit is a percentage (between 0
- * and 100):  if the free space managed by the pool exceeds the
- * specified percentage, the pool will resort to a "first fit"
- * allocation policy.
- */
 extern mps_class_t mps_class_mvt(void);
 
-/* The mvt pool class formerly supported two extensions to the pool
-   protocol: size and free_size. These are deprecated in favour of the
-   generic pool function. */
-
-#define mps_mvt_free_size(pool) (mps_pool_free_size(pool))
-#define mps_mvt_size(pool) (mps_pool_total_size(pool))
+#define mps_mvt_free_size mps_pool_free_size
+#define mps_mvt_size mps_pool_total_size
 
 #endif /* mpscmvt_h */
 
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 16847a5a746..a9dde8f4f74 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -681,7 +681,7 @@ Size PoolNoSize(Pool pool)
 {
   AVERT(Pool, pool);
   NOTREACHED;
-  return 0;
+  return UNUSED_SIZE;
 }
 
 

From 1d9afa915f72c070c8e9fde0799fca571ace633e Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 18:46:49 +0100
Subject: [PATCH 64/70] Fix arenadescribetracts:

* Return value from TreeVisitor is Bool, not Res, so pass Res back via a closure.
* Can't use TRACT_TRACT_FOR while iterating over the chunk tree, because that macro uses ChunkOfAddr. (A plain loop is simpler.)
* Mustn't try to describe unallocated tracts -- they might not even be mapped into memory. So consult the allocTable.
Make tract functions more robust:
* TractCheck must only check the pool if there is one (otherwise it segfaults for unallocated tracts)
* TractLimit can't look up the arena via TractPool, because the tract might not have a pool. So pass in the arena as an argument.

Copied from Perforce
 Change: 186547
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c | 74 ++++++++++++++++++++++++++++++++----------------
 mps/code/tract.c | 12 ++++----
 mps/code/tract.h |  4 ++-
 3 files changed, 58 insertions(+), 32 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 0700b594880..172ef9c671a 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -496,45 +496,66 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 }
 
 
-/* ArenaDescribeTractsInChunk -- describe the tracts in a chunk */
+/* arenaDescribeTractsInChunk -- describe the tracts in a chunk */
+
+typedef struct ArenaDescribeTractsClosureStruct {
+  mps_lib_FILE *stream;
+  Res res;
+} ArenaDescribeTractsClosureStruct, *ArenaDescribeTractsClosure;
 
 static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
 {
-  mps_lib_FILE *stream = closureP;
+  ArenaDescribeTractsClosure cl = closureP;
   Count depth = closureS;
+  mps_lib_FILE *stream;
   Chunk chunk;
-  Tract tract;
-  Addr addr;
-  Res res;
+  Index pi;
+  Res res = ResFAIL;
 
+  if (closureP == NULL) return FALSE;
   chunk = ChunkOfTree(tree);
-  if (!TESTT(Chunk, chunk)) return ResFAIL;
-  if (stream == NULL) return ResFAIL;
+  if (!TESTT(Chunk, chunk)) goto fail;
+  stream = cl->stream;
+  if (stream == NULL) goto fail;
 
   res = WriteF(stream, depth, "Chunk [$P, $P) ($U) {\n",
                (WriteFP)chunk->base, (WriteFP)chunk->limit,
                (WriteFU)chunk->serial,
                NULL);
-  if (res != ResOK) return res;
-  
-  TRACT_TRACT_FOR(tract, addr, ChunkArena(chunk),
-                  PageTract(ChunkPage(chunk, chunk->allocBase)),
-                  chunk->limit)
-  {
-    res = WriteF(stream, depth + 2,
-                 "[$P, $P) $P $U ($S)\n",
-                 (WriteFP)TractBase(tract), (WriteFP)TractLimit(tract),
-                 (WriteFP)TractPool(tract),
-                 (WriteFU)(TractPool(tract)->serial),
-                 (WriteFS)(TractPool(tract)->class->name),
-                 NULL);
-    if (res != ResOK) return res;
+  if (res != ResOK) goto fail;
+
+  for (pi = chunk->allocBase; pi < chunk->pages; ++pi) {
+    if (BTGet(chunk->allocTable, pi)) {
+      Tract tract = PageTract(ChunkPage(chunk, pi));
+      res = WriteF(stream, depth + 2, "[$P, $P)",
+                   (WriteFP)TractBase(tract),
+                   (WriteFP)TractLimit(tract, ChunkArena(chunk)),
+                   NULL);
+      if (res != ResOK) goto fail;
+      if (TractHasPool(tract)) {
+        Pool pool = TractPool(tract);
+        res = WriteF(stream, 0, " $P $U ($S)",
+                     (WriteFP)pool,
+                     (WriteFU)(pool->serial),
+                     (WriteFS)(pool->class->name),
+                     NULL);
+        if (res != ResOK) goto fail;
+      }
+      res = WriteF(stream, 0, "\n", NULL);
+      if (res != ResOK) goto fail;
+    }
   }
 
   res = WriteF(stream, depth, "} Chunk [$P, $P)\n",
                (WriteFP)chunk->base, (WriteFP)chunk->limit,
                NULL);
-  return res;
+  if (res != ResOK) goto fail;
+
+  return TRUE;
+
+fail:
+  cl->res = res;
+  return FALSE;
 }
 
 
@@ -542,13 +563,16 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
 
 Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
 {
+  ArenaDescribeTractsClosureStruct cl;
+
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
+  cl.stream = stream;
+  cl.res = ResOK;
   (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                     arenaDescribeTractsInChunk, stream, depth);
-
-  return ResOK;
+                     arenaDescribeTractsInChunk, &cl, depth);
+  return cl.res;
 }
 
 
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 834cb50a9f3..51a5d8dcdb1 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -37,8 +37,10 @@ SRCID(tract, "$Id$");
 
 Bool TractCheck(Tract tract)
 {
-  CHECKU(Pool, TractPool(tract));
-  CHECKL(AddrIsAligned(TractBase(tract), ArenaAlign(TractArena(tract))));
+  if (TractHasPool(tract)) {
+    CHECKU(Pool, TractPool(tract));
+    CHECKL(AddrIsAligned(TractBase(tract), ArenaAlign(TractArena(tract))));
+  }
   if (TractHasSeg(tract)) {
     CHECKL(TraceSetCheck(TractWhite(tract)));
     CHECKU(Seg, (Seg)TractP(tract));
@@ -99,13 +101,11 @@ Addr (TractBase)(Tract tract)
 }
 
 
-/* TractLimit -- return the limit address of a segment */
+/* TractLimit -- return the limit address of a tract */
 
-Addr TractLimit(Tract tract)
+Addr TractLimit(Tract tract, Arena arena)
 {
-  Arena arena;
   AVERT_CRITICAL(Tract, tract); /* .tract.critical */
-  arena = TractArena(tract);
   AVERT_CRITICAL(Arena, arena);
   return AddrAdd(TractBase(tract), arena->alignment);
 }
diff --git a/mps/code/tract.h b/mps/code/tract.h
index 0d6b5d87535..3def4d0a3d0 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -51,8 +51,10 @@ typedef struct TractStruct { /* Tract structure */
 
 extern Addr (TractBase)(Tract tract);
 #define TractBase(tract)         ((tract)->base)
-extern Addr TractLimit(Tract tract);
+extern Addr TractLimit(Tract tract, Arena arena);
 
+#define TractHasPool(tract) \
+  ((tract)->pool.state == PageStateALLOC && TractPool(tract))
 #define TractPool(tract)         ((tract)->pool.pool)
 #define TractP(tract)            ((tract)->p)
 #define TractSetP(tract, pp)     ((void)((tract)->p = (pp)))

From b240945cb95a2b3d3b26be75d5456e61b66d5131 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 19:06:10 +0100
Subject: [PATCH 65/70] Tract iteration interface is only used by the arena
 coverage test, so move it out of tract.c and into arenacv.c.

Copied from Perforce
 Change: 186548
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenacv.c |  71 +++++++++++++++++++++++-
 mps/code/tract.c   | 131 ---------------------------------------------
 mps/code/tract.h   |   4 --
 3 files changed, 69 insertions(+), 137 deletions(-)

diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c
index fada3b82692..110b4ff4ab3 100644
--- a/mps/code/arenacv.c
+++ b/mps/code/arenacv.c
@@ -87,6 +87,73 @@ typedef struct AllocatorClassStruct {
 } AllocatorClassStruct;
 
 
+/* tractSearchInChunk -- find a tract in a chunk
+ *
+ * .tract-search: Searches for a tract in the chunk starting at page
+ * index i, return FALSE if there is none.
+ */
+
+static Bool tractSearchInChunk(Tract *tractReturn, Chunk chunk, Index i)
+{
+  AVER_CRITICAL(chunk->allocBase <= i);
+  AVER_CRITICAL(i <= chunk->pages);
+
+  while (i < chunk->pages
+         && !(BTGet(chunk->allocTable, i)
+              && PageIsAllocated(ChunkPage(chunk, i)))) {
+    ++i;
+  }
+  if (i == chunk->pages)
+    return FALSE;
+  AVER(i < chunk->pages);
+  *tractReturn = PageTract(ChunkPage(chunk, i));
+  return TRUE;
+}
+
+
+/* tractSearch -- find next tract above address
+ *
+ * Searches for the next tract in increasing address order.
+ * The tract returned is the next one along from addr (i.e.,
+ * it has a base address bigger than addr and no other tract
+ * with a base address bigger than addr has a smaller base address).
+ *
+ * Returns FALSE if there is no tract to find (end of the arena).
+ */
+
+static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
+{
+  Bool b;
+  Chunk chunk;
+  Tree tree;
+
+  b = ChunkOfAddr(&chunk, arena, addr);
+  if (b) {
+    Index i;
+
+    i = INDEX_OF_ADDR(chunk, addr);
+    /* There are fewer pages than addresses, therefore the */
+    /* page index can never wrap around */
+    AVER_CRITICAL(i+1 != 0);
+
+    if (tractSearchInChunk(tractReturn, chunk, i+1)) {
+      return TRUE;
+    }
+  }
+  while (TreeFindNext(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
+                      ChunkCompare))
+  {
+    chunk = ChunkOfTree(tree);
+    addr = chunk->base;
+    /* Start from allocBase to skip the tables. */
+    if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) {
+      return TRUE;
+    }
+  }
+  return FALSE;
+}
+
+
 /* Implementation of the tract-based interchangability interface */
 
 static Res allocAsTract(AllocInfoStruct *aiReturn, SegPref pref,
@@ -114,7 +181,7 @@ static Bool firstAsTract(AllocInfoStruct *aiReturn, Arena arena)
 {
   Bool res;
   Tract tract;
-  res = TractFirst(&tract, arena);
+  res = tractSearch(&tract, arena, 0);
   if (res) {
     aiReturn->the.tractData.base = TractBase(tract);
     aiReturn->the.tractData.size = ArenaAlign(arena);;
@@ -128,7 +195,7 @@ static Bool nextAsTract(AllocInfoStruct *nextReturn, AllocInfo ai,
 {
   Bool res;
   Tract tract;
-  res = TractNext(&tract, arena, ai->the.tractData.base);
+  res = tractSearch(&tract, arena, ai->the.tractData.base);
   if (res) {
     nextReturn->the.tractData.base = TractBase(tract);
     nextReturn->the.tractData.size = ArenaAlign(arena);;
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 51a5d8dcdb1..0f9084d6345 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -337,34 +337,6 @@ Bool ChunkOfAddr(Chunk *chunkReturn, Arena arena, Addr addr)
 }
 
 
-/* chunkAboveAddr
- *
- * Finds the next higher chunk in memory which does _not_ contain
- * addr. If there is such a chunk, update *chunkReturn and return
- * TRUE, otherwise return FALSE.
- */
-
-static Bool chunkAboveAddr(Chunk *chunkReturn, Arena arena, Addr addr)
-{
-  Tree tree;
-  Chunk chunk;
-
-  AVER_CRITICAL(chunkReturn != NULL);
-  AVERT_CRITICAL(Arena, arena);
-  /* addr is arbitrary */
-
-  if (TreeFindNext(&tree, ArenaChunkTree(arena), TreeKeyOfAddrVar(addr),
-                   ChunkCompare))
-  {
-    chunk = ChunkOfTree(tree);
-    AVER_CRITICAL(addr < chunk->base);
-    *chunkReturn = chunk;
-    return TRUE;
-  }
-  return FALSE;
-}
-
-
 /* IndexOfAddr -- return the index of the page containing an address
  *
  * Function version of INDEX_OF_ADDR, for debugging purposes.
@@ -465,109 +437,6 @@ Tract TractOfBaseAddr(Arena arena, Addr addr)
 }
 
 
-/* tractSearchInChunk -- search for a tract
- *
- * .tract-search: Searches for a tract in the chunk starting at page
- * index i, return NULL if there is none.  .tract-search.private: This
- * function is private to this module and is used in the tract iteration
- * protocol (TractFirst and TractNext).
- */
-
-static Bool tractSearchInChunk(Tract *tractReturn, Chunk chunk, Index i)
-{
-  AVER_CRITICAL(chunk->allocBase <= i);
-  AVER_CRITICAL(i <= chunk->pages);
-
-  while (i < chunk->pages
-         && !(BTGet(chunk->allocTable, i)
-              && PageIsAllocated(ChunkPage(chunk, i)))) {
-    ++i;
-  }
-  if (i == chunk->pages)
-    return FALSE;
-  AVER(i < chunk->pages);
-  *tractReturn = PageTract(ChunkPage(chunk, i));
-  return TRUE;
-}
-
-
-/* tractSearch
- *
- * Searches for the next tract in increasing address order.
- * The tract returned is the next one along from addr (i.e.,
- * it has a base address bigger than addr and no other tract
- * with a base address bigger than addr has a smaller base address).
- *
- * Returns FALSE if there is no tract to find (end of the arena).
- */
-
-static Bool tractSearch(Tract *tractReturn, Arena arena, Addr addr)
-{
-  Bool b;
-  Chunk chunk;
-
-  b = ChunkOfAddr(&chunk, arena, addr);
-  if (b) {
-    Index i;
-
-    i = INDEX_OF_ADDR(chunk, addr);
-    /* There are fewer pages than addresses, therefore the */
-    /* page index can never wrap around */
-    AVER_CRITICAL(i+1 != 0);
-
-    if (tractSearchInChunk(tractReturn, chunk, i+1)) {
-      return TRUE;
-    }
-  }
-  while (chunkAboveAddr(&chunk, arena, addr)) {
-    addr = chunk->base;
-    /* Start from allocBase to skip the tables. */
-    if (tractSearchInChunk(tractReturn, chunk, chunk->allocBase)) {
-      return TRUE;
-    }
-  }
-  return FALSE;
-}
-
-
-/* TractFirst -- return the first tract in the arena
- *
- * This is used to start an iteration over all tracts in the arena, not
- * including the ones used for page tables and other arena structures.
- */
-
-Bool TractFirst(Tract *tractReturn, Arena arena)
-{
-  AVER(tractReturn != NULL);
-  AVERT(Arena, arena);
-
-  /* .tractfirst.assume.nozero: We assume that there is no tract */
-  /* with base address (Addr)0.  Happily this assumption is sound */
-  /* for a number of reasons. */
-  return tractSearch(tractReturn, arena, (Addr)0);
-}
-
-
-/* TractNext -- return the "next" tract in the arena
- *
- * TractNext finds the tract with the lowest base address which is
- * greater than a specified address.  The address must be (or once
- * have been) the base address of a tract.
- *
- * This is used as the iteration step when iterating over all
- * tracts in the arena.
- */
-
-Bool TractNext(Tract *tractReturn, Arena arena, Addr addr)
-{
-  AVER_CRITICAL(tractReturn != NULL); /* .tract.critical */
-  AVERT_CRITICAL(Arena, arena);
-  AVER_CRITICAL(AddrIsAligned(addr, arena->alignment));
-
-  return tractSearch(tractReturn, arena, addr);
-}
-
-
 /* PageAlloc
  *
  * Sets up the page descriptor for an allocated page to turn it into a Tract.
diff --git a/mps/code/tract.h b/mps/code/tract.h
index 3def4d0a3d0..88608f7fe2e 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -217,10 +217,6 @@ extern Index IndexOfAddr(Chunk chunk, Addr addr);
   END
 
 
-extern Bool TractFirst(Tract *tractReturn, Arena arena);
-extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
-
-
 /* TRACT_TRACT_FOR -- iterate over a range of tracts in a chunk
  *
  * See <design/arena-tract-iter/#if.macro>.

From 4538221eb16f247e12f01c6e14e32dfa5b13b71a Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 19:52:43 +0100
Subject: [PATCH 66/70] Remove obsolete macro arenachunkring.

Copied from Perforce
 Change: 186549
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenavm.c | 2 --
 1 file changed, 2 deletions(-)

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index e8c3cdd15e5..33d1579e82b 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -968,8 +968,6 @@ static Size chunkUnmapAroundPage(Chunk chunk, Size size, Page page)
  * unmapped.
  */
 
-#define ArenaChunkRing(arena) (&(arena)->chunkRing)
-
 static Size arenaUnmapSpare(Arena arena, Size size, Chunk filter)
 {
   Ring node;

From 8c9de5f775b1f556ce05f47c308908216313e292 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 20:28:50 +0100
Subject: [PATCH 67/70] New function arenachunktreetraverse ensures that calls
 to chunkofaddr are reliably detected.

Copied from Perforce
 Change: 186550
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   | 41 ++++++++++++++++++++++++++++++++++-------
 mps/code/arenacl.c |  5 +++--
 mps/code/arenavm.c |  5 +++--
 mps/code/mpm.h     |  1 +
 mps/code/tree.c    |  1 +
 mps/code/tree.h    | 10 ++++++++++
 6 files changed, 52 insertions(+), 11 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 172ef9c671a..668cdab9e5c 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -147,8 +147,7 @@ Bool ArenaCheck(Arena arena)
   if (arena->primary != NULL) {
     CHECKD(Chunk, arena->primary);
   }
-  /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
-  CHECKL(TreeCheck(ArenaChunkTree(arena)));
+  /* Can't check chunkTree, it might be bad during ArenaChunkTreeTraverse. */
   /* nothing to check for chunkSerial */
   
   CHECKL(LocusCheck(arena));
@@ -570,8 +569,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
 
   cl.stream = stream;
   cl.res = ResOK;
-  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                     arenaDescribeTractsInChunk, &cl, depth);
+  (void)ArenaChunkTreeTraverse(arena, arenaDescribeTractsInChunk, &cl, depth);
   return cl.res;
 }
 
@@ -635,6 +633,34 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 }
 
 
+/* ArenaChunkTreeTraverse -- call visitor for each chunk */
+
+Bool ArenaChunkTreeTraverse(Arena arena, TreeVisitor visitor,
+                            void *closureP, Size closureS)
+{
+  Bool b;
+  Tree tree;
+
+  AVERT(Arena, arena);
+  AVER(FUNCHECK(visitor));
+  /* closureP and closureS are arbitrary. */
+
+  /* During TreeTraverse, the tree is invalid, so temporarily set
+   * arena->chunkTree to an invalid value, to ensure that if someone
+   * calls ChunkOfAddr while we are iterating this results in an
+   * assertion failure (in checking varieties) or a segfault, rather
+   * than a silent failure to find the chunk.
+   */
+  
+  tree = ArenaChunkTree(arena);
+  arena->chunkTree = TreeBAD;
+  b = TreeTraverse(tree, ChunkCompare, ChunkKey, visitor, closureP, closureS);
+  arena->chunkTree = tree;
+
+  return b;
+}
+
+
 /* ArenaChunkInsert -- insert chunk into arena's chunk tree */
 
 void ArenaChunkInsert(Arena arena, Tree tree) {
@@ -681,6 +707,7 @@ static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
   AVER(closureP != NULL);
   cl = closureP;
   AVER(cl->arena == ChunkArena(chunk));
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
 
   /* Already searched in arenaAllocPage. */
@@ -725,12 +752,12 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
   /* TODO: Consider how the ArenaCBSBlockPool might free pages. */
-  if (!arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, 0))
+  if (!arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, UNUSED_SIZE))
     goto found;
 
   closure.avoid = arena->primary;
-  if (!TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                    arenaAllocPageInChunk, &closure, 0))
+  if (!ArenaChunkTreeTraverse(arena, arenaAllocPageInChunk,
+                              &closure, UNUSED_SIZE))
     goto found;
 
   AVER(closure.res != ResOK);
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index cb4d9865ae3..a6d7f79c65c 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -349,6 +349,7 @@ static Bool clientArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
   AVERT(Chunk, chunk);
   AVER(closureP != 0);
   size = closureP;
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
 
   *size += ChunkSize(chunk);
@@ -361,8 +362,8 @@ static Size ClientArenaReserved(Arena arena)
 
   AVERT(Arena, arena);
 
-  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                     clientArenaReservedVisitor, &size, 0);
+  (void)ArenaChunkTreeTraverse(arena, clientArenaReservedVisitor,
+                               &size, UNUSED_SIZE);
 
   return size;
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 33d1579e82b..07a1d492aa2 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -642,6 +642,7 @@ static Bool vmArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
   AVERT(Chunk, chunk);
   AVER(closureP != 0);
   size = closureP;
+  AVER(closureS == UNUSED_SIZE);
   UNUSED(closureS);
 
   *size += VMReserved(Chunk2VMChunk(chunk)->vm);
@@ -655,8 +656,8 @@ static Size VMArenaReserved(Arena arena)
 
   AVERT(Arena, arena);
 
-  (void)TreeTraverse(ArenaChunkTree(arena), ChunkCompare, ChunkKey,
-                     vmArenaReservedVisitor, &size, 0);
+  (void)ArenaChunkTreeTraverse(arena, vmArenaReservedVisitor,
+                               &size, UNUSED_SIZE);
 
   return size;
 }
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index ccec0aff383..a0d5f858a10 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -557,6 +557,7 @@ extern Res ArenaStartCollect(Globals globals, int why);
 extern Res ArenaCollect(Globals globals, int why);
 extern Bool ArenaHasAddr(Arena arena, Addr addr);
 extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
+extern Bool ArenaChunkTreeTraverse(Arena arena, TreeVisitor visitor, void *closureP, Size closureS);
 extern void ArenaChunkInsert(Arena arena, Tree tree);
 
 extern void ArenaSetEmergency(Arena arena, Bool emergency);
diff --git a/mps/code/tree.c b/mps/code/tree.c
index e6dd902f3fd..ff77fde15c4 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -24,6 +24,7 @@ SRCID(tree, "$Id$");
 Bool TreeCheck(Tree tree)
 {
   if (tree != TreeEMPTY) {
+    CHECKL(tree != TreeBAD);
     CHECKL(tree != NULL);
     CHECKL(tree->left == TreeEMPTY || tree->left != NULL);
     CHECKL(tree->right == TreeEMPTY || tree->right != NULL);
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 4ac1a82eaaf..5c0ea05ac51 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -64,6 +64,16 @@ typedef TreeKey (*TreeKeyMethod)(Tree tree);
 
 #define TreeEMPTY ((Tree)0)
 
+
+/* TreeBAD -- an invalid tree
+ *
+ * TreeBAD is a value that's not equal to any tree (not even to
+ * the empty tree).
+ */
+
+#define TreeBAD ((Tree)7)
+
+
 extern Bool TreeCheck(Tree tree);
 extern Bool TreeCheckLeaf(Tree tree);
 extern Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key);

From 816c61ecfe75c21d4db6f5fd8c7d2c86620cf614 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 12 Jun 2014 23:52:27 +0100
Subject: [PATCH 68/70] "copy method" is obsolete.

Copied from Perforce
 Change: 186552
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/glossary/c.rst     | 10 ----------
 mps/manual/source/glossary/index.rst |  1 -
 mps/manual/source/topic/format.rst   |  2 +-
 3 files changed, 1 insertion(+), 12 deletions(-)

diff --git a/mps/manual/source/glossary/c.rst b/mps/manual/source/glossary/c.rst
index 2449ce9f82a..ffdf1899243 100644
--- a/mps/manual/source/glossary/c.rst
+++ b/mps/manual/source/glossary/c.rst
@@ -581,16 +581,6 @@ Memory Management Glossary: C
             valid, even functions on the :term:`critical path`. See
             :ref:`guide-build`. Compare :term:`hot` and :term:`rash`.
 
-    copy method
-
-        .. mps:specific::
-
-            A copy method is one of the methods in an :term:`object
-            format`. Formerly, the MPS called this method to copy a
-            :term:`formatted object` during :term:`moving garbage
-            collection <moving garbage collector>`. Now it just copies
-            the bytes and the copy method is ignored.
-
     copying garbage collection
 
         .. aka:: *scavenging garbage collection*.
diff --git a/mps/manual/source/glossary/index.rst b/mps/manual/source/glossary/index.rst
index 40656261350..a0484b3c5ee 100644
--- a/mps/manual/source/glossary/index.rst
+++ b/mps/manual/source/glossary/index.rst
@@ -152,7 +152,6 @@ All
 :term:`continuation`
 :term:`control stack`
 :term:`cool`
-:term:`copy method`
 :term:`copying garbage collection`
 :term:`core`
 :term:`creation space`
diff --git a/mps/manual/source/topic/format.rst b/mps/manual/source/topic/format.rst
index b9bbdae61bb..5efb10d5d89 100644
--- a/mps/manual/source/topic/format.rst
+++ b/mps/manual/source/topic/format.rst
@@ -568,7 +568,7 @@ of.
 
     The fields of this structure correspond to the keyword arguments
     to :c:func:`mps_fmt_create_k`, except for ``copy``, which is not
-    used. In older versions of the MPS this was a :term:`copy method`
+    used. In older versions of the MPS this was a *copy method*
     that copied objects belonging to this format.
 
 

From 4dcd8cacaa15374972cd8bd99e895ffe44397149 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 13 Jun 2014 11:17:28 +0100
Subject: [PATCH 69/70] Avoid local variable "free" shadowing standard c
 function free().

Copied from Perforce
 Change: 186554
 ServerID: perforce.ravenbrook.com
---
 mps/code/apss.c  | 6 +++---
 mps/code/mpmss.c | 6 +++---
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/mps/code/apss.c b/mps/code/apss.c
index 7ee07d356bd..ab35d48cc96 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -45,10 +45,10 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 
 static void check_allocated_size(mps_pool_t pool, mps_ap_t ap, size_t allocated)
 {
-  size_t total = mps_pool_total_size(pool);
-  size_t free = mps_pool_free_size(pool);
+  size_t total_size = mps_pool_total_size(pool);
+  size_t free_size = mps_pool_free_size(pool);
   size_t ap_free = (size_t)((char *)ap->limit - (char *)ap->init);
-  Insist(total - free == allocated + ap_free);
+  Insist(total_size - free_size == allocated + ap_free);
 }
 
 
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 078c0d6ff68..ca1e6a2980e 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -28,9 +28,9 @@
 
 static void check_allocated_size(mps_pool_t pool, size_t allocated)
 {
-  size_t total = mps_pool_total_size(pool);
-  size_t free = mps_pool_free_size(pool);
-  Insist(total - free == allocated);
+  size_t total_size = mps_pool_total_size(pool);
+  size_t free_size = mps_pool_free_size(pool);
+  Insist(total_size - free_size == allocated);
 }
 
 

From 100405cac2d7a6556491279759b8714f98b2feea Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 13 Jun 2014 12:31:47 +0100
Subject: [PATCH 70/70] Restore the chunk ring.

Copied from Perforce
 Change: 186558
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   | 183 +++++++++++++++------------------------------
 mps/code/arenacl.c |  29 +++----
 mps/code/arenavm.c |  33 ++------
 mps/code/mpm.h     |   3 +-
 mps/code/mpmst.h   |   3 +-
 mps/code/tract.c   |   4 +-
 mps/code/tract.h   |   1 +
 mps/code/tree.c    |   1 -
 mps/code/tree.h    |   9 ---
 9 files changed, 83 insertions(+), 183 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 668cdab9e5c..1d91deca1f2 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -147,7 +147,10 @@ Bool ArenaCheck(Arena arena)
   if (arena->primary != NULL) {
     CHECKD(Chunk, arena->primary);
   }
-  /* Can't check chunkTree, it might be bad during ArenaChunkTreeTraverse. */
+  CHECKD_NOSIG(Ring, &arena->chunkRing);
+  /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
+  CHECKL(TreeCheck(ArenaChunkTree(arena)));
+  /* TODO: check that the chunkRing and chunkTree have identical members */
   /* nothing to check for chunkSerial */
   
   CHECKL(LocusCheck(arena));
@@ -204,6 +207,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
   arena->zoned = zoned;
 
   arena->primary = NULL;
+  RingInit(&arena->chunkRing);
   arena->chunkTree = TreeEMPTY;
   arena->chunkSerial = (Serial)0;
   
@@ -349,6 +353,7 @@ void ArenaFinish(Arena arena)
   arena->sig = SigInvalid;
   GlobalsFinish(ArenaGlobals(arena));
   LocusFinish(arena);
+  RingFinish(&arena->chunkRing);
   AVER(ArenaChunkTree(arena) == TreeEMPTY);
 }
 
@@ -497,31 +502,20 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 
 /* arenaDescribeTractsInChunk -- describe the tracts in a chunk */
 
-typedef struct ArenaDescribeTractsClosureStruct {
-  mps_lib_FILE *stream;
-  Res res;
-} ArenaDescribeTractsClosureStruct, *ArenaDescribeTractsClosure;
-
-static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
+static Res arenaDescribeTractsInChunk(Chunk chunk, mps_lib_FILE *stream, Count depth)
 {
-  ArenaDescribeTractsClosure cl = closureP;
-  Count depth = closureS;
-  mps_lib_FILE *stream;
-  Chunk chunk;
+  Res res;
   Index pi;
-  Res res = ResFAIL;
 
-  if (closureP == NULL) return FALSE;
-  chunk = ChunkOfTree(tree);
-  if (!TESTT(Chunk, chunk)) goto fail;
-  stream = cl->stream;
-  if (stream == NULL) goto fail;
+  if (stream == NULL) return ResFAIL;
+  if (!TESTT(Chunk, chunk)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
 
   res = WriteF(stream, depth, "Chunk [$P, $P) ($U) {\n",
                (WriteFP)chunk->base, (WriteFP)chunk->limit,
                (WriteFU)chunk->serial,
                NULL);
-  if (res != ResOK) goto fail;
+  if (res != ResOK) return res;
 
   for (pi = chunk->allocBase; pi < chunk->pages; ++pi) {
     if (BTGet(chunk->allocTable, pi)) {
@@ -530,7 +524,7 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
                    (WriteFP)TractBase(tract),
                    (WriteFP)TractLimit(tract, ChunkArena(chunk)),
                    NULL);
-      if (res != ResOK) goto fail;
+      if (res != ResOK) return res;
       if (TractHasPool(tract)) {
         Pool pool = TractPool(tract);
         res = WriteF(stream, 0, " $P $U ($S)",
@@ -538,23 +532,17 @@ static Bool arenaDescribeTractsInChunk(Tree tree, void *closureP, Size closureS)
                      (WriteFU)(pool->serial),
                      (WriteFS)(pool->class->name),
                      NULL);
-        if (res != ResOK) goto fail;
+        if (res != ResOK) return res;
       }
       res = WriteF(stream, 0, "\n", NULL);
-      if (res != ResOK) goto fail;
+      if (res != ResOK) return res;
     }
   }
 
   res = WriteF(stream, depth, "} Chunk [$P, $P)\n",
                (WriteFP)chunk->base, (WriteFP)chunk->limit,
                NULL);
-  if (res != ResOK) goto fail;
-
-  return TRUE;
-
-fail:
-  cl->res = res;
-  return FALSE;
+  return res;
 }
 
 
@@ -562,15 +550,19 @@ fail:
 
 Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
 {
-  ArenaDescribeTractsClosureStruct cl;
+  Ring node, next;
+  Res res;
 
   if (!TESTT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
-  cl.stream = stream;
-  cl.res = ResOK;
-  (void)ArenaChunkTreeTraverse(arena, arenaDescribeTractsInChunk, &cl, depth);
-  return cl.res;
+  RING_FOR(node, &arena->chunkRing, next) {
+    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
+    res = arenaDescribeTractsInChunk(chunk, stream, depth);
+    if (res != ResOK) return res;
+  }
+
+  return ResOK;
 }
 
 
@@ -633,48 +625,22 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
 }
 
 
-/* ArenaChunkTreeTraverse -- call visitor for each chunk */
-
-Bool ArenaChunkTreeTraverse(Arena arena, TreeVisitor visitor,
-                            void *closureP, Size closureS)
-{
-  Bool b;
-  Tree tree;
-
-  AVERT(Arena, arena);
-  AVER(FUNCHECK(visitor));
-  /* closureP and closureS are arbitrary. */
-
-  /* During TreeTraverse, the tree is invalid, so temporarily set
-   * arena->chunkTree to an invalid value, to ensure that if someone
-   * calls ChunkOfAddr while we are iterating this results in an
-   * assertion failure (in checking varieties) or a segfault, rather
-   * than a silent failure to find the chunk.
-   */
-  
-  tree = ArenaChunkTree(arena);
-  arena->chunkTree = TreeBAD;
-  b = TreeTraverse(tree, ChunkCompare, ChunkKey, visitor, closureP, closureS);
-  arena->chunkTree = tree;
-
-  return b;
-}
-
-
 /* ArenaChunkInsert -- insert chunk into arena's chunk tree */
 
-void ArenaChunkInsert(Arena arena, Tree tree) {
+void ArenaChunkInsert(Arena arena, Chunk chunk) {
   Bool inserted;
-  Tree updatedTree = NULL;
+  Tree tree, updatedTree = NULL;
 
   AVERT(Arena, arena);
-  AVERT(Tree, tree);
+  AVERT(Chunk, chunk);
+  tree = &chunk->chunkTree;
 
   inserted = TreeInsert(&updatedTree, ArenaChunkTree(arena),
                         tree, ChunkKey(tree), ChunkCompare);
   AVER(inserted && updatedTree);
   TreeBalance(&updatedTree);
   arena->chunkTree = updatedTree;
+  RingAppend(&arena->chunkRing, &chunk->chunkRing);
 }
 
 
@@ -686,87 +652,56 @@ void ArenaChunkInsert(Arena arena, Tree tree) {
  * bootstrap.
  */
 
-typedef struct ArenaAllocPageClosureStruct {
-  Arena arena;
-  Pool pool;
-  Addr base;
-  Chunk avoid;
-  Res res;
-} ArenaAllocPageClosureStruct, *ArenaAllocPageClosure;
-
-static Bool arenaAllocPageInChunk(Tree tree, void *closureP, Size closureS)
+static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
 {
-  ArenaAllocPageClosure cl;
-  Chunk chunk;
-  Index basePageIndex, limitPageIndex;
   Res res;
+  Index basePageIndex, limitPageIndex;
+  Arena arena;
 
-  AVERT(Tree, tree);
-  chunk = ChunkOfTree(tree);
+  AVER(baseReturn != NULL);
   AVERT(Chunk, chunk);
-  AVER(closureP != NULL);
-  cl = closureP;
-  AVER(cl->arena == ChunkArena(chunk));
-  AVER(closureS == UNUSED_SIZE);
-  UNUSED(closureS);
+  AVERT(Pool, pool);
+  arena = ChunkArena(chunk);
 
-  /* Already searched in arenaAllocPage. */
-  if (chunk == cl->avoid) {
-    cl->res = ResRESOURCE;
-    return TRUE;
-  }
-  
   if (!BTFindShortResRange(&basePageIndex, &limitPageIndex,
                            chunk->allocTable,
                            chunk->allocBase, chunk->pages, 1))
-  {
-    cl->res = ResRESOURCE;
-    return TRUE;
-  }
+    return ResRESOURCE;
   
-  res = (*cl->arena->class->pagesMarkAllocated)(cl->arena, chunk,
-                                                basePageIndex, 1, cl->pool);
-  if (res != ResOK) {
-    cl->res = res;
-    return TRUE;
-  }
-  
-  cl->base = PageIndexBase(chunk, basePageIndex);
-  return FALSE;
+  res = (*arena->class->pagesMarkAllocated)(arena, chunk,
+                                            basePageIndex, 1,
+                                            pool);
+  if (res != ResOK)
+    return res;
+
+  *baseReturn = PageIndexBase(chunk, basePageIndex);
+  return ResOK;
 }
 
 static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
 {
-  ArenaAllocPageClosureStruct closure;
+  Res res;
   
   AVER(baseReturn != NULL);
   AVERT(Arena, arena);
   AVERT(Pool, pool);
 
-  closure.arena = arena;
-  closure.pool = pool;
-  closure.base = NULL;
-  closure.avoid = NULL;
-  closure.res = ResOK;
-
   /* Favour the primary chunk, because pages allocated this way aren't
      currently freed, and we don't want to prevent chunks being destroyed. */
   /* TODO: Consider how the ArenaCBSBlockPool might free pages. */
-  if (!arenaAllocPageInChunk(&arena->primary->chunkTree, &closure, UNUSED_SIZE))
-    goto found;
-
-  closure.avoid = arena->primary;
-  if (!ArenaChunkTreeTraverse(arena, arenaAllocPageInChunk,
-                              &closure, UNUSED_SIZE))
-    goto found;
-
-  AVER(closure.res != ResOK);
-  return closure.res;
-
-found:
-  AVER(closure.base != NULL);
-  *baseReturn = closure.base;
-  return ResOK;
+  res = arenaAllocPageInChunk(baseReturn, arena->primary, pool);
+  if (res != ResOK) {
+    Ring node, next;
+    RING_FOR(node, &arena->chunkRing, next) {
+      Chunk chunk = RING_ELT(Chunk, chunkRing, node);
+      if (chunk != arena->primary) {
+        res = arenaAllocPageInChunk(baseReturn, chunk, pool);
+        if (res == ResOK)
+          break;
+      }
+    }
+  }
+  return res;
 }
 
 
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index a6d7f79c65c..04594610112 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -339,31 +339,20 @@ static Res ClientArenaExtend(Arena arena, Addr base, Size size)
 
 /* ClientArenaReserved -- return the amount of reserved address space */
 
-static Bool clientArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
-{
-  Size *size;
-  Chunk chunk;
-
-  AVERT(Tree, tree);
-  chunk = ChunkOfTree(tree);
-  AVERT(Chunk, chunk);
-  AVER(closureP != 0);
-  size = closureP;
-  AVER(closureS == UNUSED_SIZE);
-  UNUSED(closureS);
-
-  *size += ChunkSize(chunk);
-  return TRUE;
-}
-
 static Size ClientArenaReserved(Arena arena)
 {
-  Size size = 0;
+  Size size;
+  Ring node, nextNode;
 
   AVERT(Arena, arena);
 
-  (void)ArenaChunkTreeTraverse(arena, clientArenaReservedVisitor,
-                               &size, UNUSED_SIZE);
+  size = 0;
+  /* .req.extend.slow */
+  RING_FOR(node, &arena->chunkRing, nextNode) {
+    Chunk chunk = RING_ELT(Chunk, chunkRing, node);
+    AVERT(Chunk, chunk);
+    size += ChunkSize(chunk);
+  }
 
   return size;
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 07a1d492aa2..700a1f229ae 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -632,34 +632,17 @@ static void VMArenaFinish(Arena arena)
  * Add up the reserved space from all the chunks.
  */
 
-static Bool vmArenaReservedVisitor(Tree tree, void *closureP, Size closureS)
-{
-  Size *size;
-  Chunk chunk;
-
-  AVERT(Tree, tree);
-  chunk = ChunkOfTree(tree);
-  AVERT(Chunk, chunk);
-  AVER(closureP != 0);
-  size = closureP;
-  AVER(closureS == UNUSED_SIZE);
-  UNUSED(closureS);
-
-  *size += VMReserved(Chunk2VMChunk(chunk)->vm);
-  return TRUE;
-}
-
-
 static Size VMArenaReserved(Arena arena)
 {
-  Size size = 0;
+  Size reserved;
+  Ring node, next;
 
-  AVERT(Arena, arena);
-
-  (void)ArenaChunkTreeTraverse(arena, vmArenaReservedVisitor,
-                               &size, UNUSED_SIZE);
-
-  return size;
+  reserved = 0;
+  RING_FOR(node, &arena->chunkRing, next) {
+    VMChunk vmChunk = Chunk2VMChunk(RING_ELT(Chunk, chunkRing, node));
+    reserved += VMReserved(vmChunk->vm);
+  }
+  return reserved;
 }
 
 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index a0d5f858a10..e3a7582ba4b 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -557,8 +557,7 @@ extern Res ArenaStartCollect(Globals globals, int why);
 extern Res ArenaCollect(Globals globals, int why);
 extern Bool ArenaHasAddr(Arena arena, Addr addr);
 extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
-extern Bool ArenaChunkTreeTraverse(Arena arena, TreeVisitor visitor, void *closureP, Size closureS);
-extern void ArenaChunkInsert(Arena arena, Tree tree);
+extern void ArenaChunkInsert(Arena arena, Chunk chunk);
 
 extern void ArenaSetEmergency(Arena arena, Bool emergency);
 extern Bool ArenaEmergency(Arena arean);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 02a9b91bc24..2edde40e297 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -732,7 +732,8 @@ typedef struct mps_arena_s {
   Addr lastTractBase;           /* base address of lastTract */
 
   Chunk primary;                /* the primary chunk */
-  Tree chunkTree;               /* all the chunks */
+  RingStruct chunkRing;         /* all the chunks, in a ring for iteration */
+  Tree chunkTree;               /* all the chunks, in a tree for fast lookup */
   Serial chunkSerial;           /* next chunk number */
 
   Bool hasFreeLand;              /* Is freeLand available? */
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 0f9084d6345..f010a7231dd 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -184,6 +184,7 @@ Res ChunkInit(Chunk chunk, Arena arena,
 
   chunk->serial = (arena->chunkSerial)++;
   chunk->arena = arena;
+  RingInit(&chunk->chunkRing);
 
   chunk->pageSize = pageSize;
   chunk->pageShift = pageShift = SizeLog2(pageSize);
@@ -229,7 +230,7 @@ Res ChunkInit(Chunk chunk, Arena arena,
   chunk->sig = ChunkSig;
   AVERT(Chunk, chunk);
 
-  ArenaChunkInsert(arena, &chunk->chunkTree);
+  ArenaChunkInsert(arena, chunk);
 
   /* As part of the bootstrap, the first created chunk becomes the primary
      chunk.  This step allows AreaFreeLandInsert to allocate pages. */
@@ -267,6 +268,7 @@ void ChunkFinish(Chunk chunk)
   chunk->sig = SigInvalid;
 
   TreeFinish(&chunk->chunkTree);
+  RingRemove(&chunk->chunkRing);
 
   if (chunk->arena->primary == chunk)
     chunk->arena->primary = NULL;
diff --git a/mps/code/tract.h b/mps/code/tract.h
index 88608f7fe2e..5be02f0c88e 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -137,6 +137,7 @@ typedef struct ChunkStruct {
   Sig sig;              /* <design/sig/> */
   Serial serial;        /* serial within the arena */
   Arena arena;          /* parent arena */
+  RingStruct chunkRing; /* node in ring of all chunks in arena */
   TreeStruct chunkTree; /* node in tree of all chunks in arena */
   Size pageSize;        /* size of pages */
   Shift pageShift;      /* log2 of page size, for shifts */
diff --git a/mps/code/tree.c b/mps/code/tree.c
index ff77fde15c4..e6dd902f3fd 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -24,7 +24,6 @@ SRCID(tree, "$Id$");
 Bool TreeCheck(Tree tree)
 {
   if (tree != TreeEMPTY) {
-    CHECKL(tree != TreeBAD);
     CHECKL(tree != NULL);
     CHECKL(tree->left == TreeEMPTY || tree->left != NULL);
     CHECKL(tree->right == TreeEMPTY || tree->right != NULL);
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 5c0ea05ac51..296c9528a1a 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -65,15 +65,6 @@ typedef TreeKey (*TreeKeyMethod)(Tree tree);
 #define TreeEMPTY ((Tree)0)
 
 
-/* TreeBAD -- an invalid tree
- *
- * TreeBAD is a value that's not equal to any tree (not even to
- * the empty tree).
- */
-
-#define TreeBAD ((Tree)7)
-
-
 extern Bool TreeCheck(Tree tree);
 extern Bool TreeCheckLeaf(Tree tree);
 extern Count TreeDebugCount(Tree tree, TreeCompare compare, TreeKeyMethod key);