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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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/41] 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 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 30/41] 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 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 31/41] 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 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 32/41] 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 33/41] 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 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 34/41] 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 35/41] 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 36/41] 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 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 37/41] 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 38/41] 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 39/41] 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 40/41] 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 41/41] 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;
 }