New land functions landinsertsteal and landdeletesteal and unit test.

Use LandInsertSteal instead of arenaFreeLandInsertSteal.
Add regression test for job004102.

Copied from Perforce
 Change: 194861

mps/code/arena.c

@@ -926,57 +926,6 @@ static Res arenaFreeLandInsertExtend(Range rangeReturn, Arena arena,
 }
 
 
-/* arenaFreeLandInsertSteal -- add range to arena's free land, maybe
- * stealing memory
- *
- * See arenaFreeLandInsertExtend. This function may only be applied to
- * mapped pages and may steal them to store Land nodes if it's unable
- * to allocate space for CBS blocks.
- *
- * IMPORTANT: May update rangeIO.
- */
-
-static void arenaFreeLandInsertSteal(Range rangeReturn, Arena arena,
-                                     Range rangeIO)
-{
-  Res res;
-  
-  AVER(rangeReturn != NULL);
-  AVERT(Arena, arena);
-  AVERT(Range, rangeIO);
-
-  res = arenaFreeLandInsertExtend(rangeReturn, arena, rangeIO);
-  
-  if (res != ResOK) {
-    Land land;
-    Addr pageBase, pageLimit;
-    Tract tract;
-    AVER(ResIsAllocFailure(res));
-
-    /* Steal a page from the memory we're about to free. */
-    AVER(RangeSize(rangeIO) >= ArenaGrainSize(arena));
-    pageBase = RangeBase(rangeIO);
-    pageLimit = AddrAdd(pageBase, ArenaGrainSize(arena));
-    AVER(pageLimit <= RangeLimit(rangeIO));
-    RangeInit(rangeIO, pageLimit, RangeLimit(rangeIO));
-
-    /* Steal the tract from its owning pool. */
-    tract = TractOfBaseAddr(arena, pageBase);
-    TractFinish(tract);
-    TractInit(tract, ArenaCBSBlockPool(arena), pageBase);
-  
-    MFSExtend(ArenaCBSBlockPool(arena), pageBase, pageLimit);
-
-    /* Try again. */
-    land = ArenaFreeLand(arena);
-    res = LandInsert(rangeReturn, land, rangeIO);
-    AVER(res == ResOK); /* we just gave memory to the CBS block pool */
-  }
-
-  AVER(res == ResOK); /* not expecting other kinds of error from the Land */
-}
-
-
 /* ArenaFreeLandInsert -- add range to arena's free land, maybe extending
  * block pool
  *
@@ -1166,10 +1115,12 @@ allocFail:
 void ArenaFree(Addr base, Size size, Pool pool)
 {
   Arena arena;
+  Land land;
   Addr limit;
   Addr wholeBase;
   Size wholeSize;
   RangeStruct range, oldRange;
+  Res res;
 
   AVERT(Pool, pool);
   AVER(base != NULL);
@@ -1191,9 +1142,12 @@ void ArenaFree(Addr base, Size size, Pool pool)
 
   RangeInit(&range, base, limit);
 
-  arenaFreeLandInsertSteal(&oldRange, arena, &range); /* may update range */
+  land = ArenaFreeLand(arena);
+  res = LandInsertSteal(&oldRange, land, &range); /* may update range */
+  AVER(res == ResOK);
 
-  Method(Arena, arena, free)(RangeBase(&range), RangeSize(&range), pool);
+  if (!RangeIsEmpty(&range))
+    Method(Arena, arena, free)(RangeBase(&range), RangeSize(&range), pool);
 
   /* Freeing memory might create spare pages, but not more than this. */
   CHECKL(arena->spareCommitted <= arena->spareCommitLimit);

mps/code/cbs.c

@@ -399,6 +399,7 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range)
 
   AVER_CRITICAL(rangeReturn != NULL);
   AVERT_CRITICAL(Range, range);
+  AVER_CRITICAL(!RangeIsEmpty(range));
   AVER_CRITICAL(RangeIsAligned(range, LandAlignment(land)));
 
   base = RangeBase(range);
@@ -484,6 +485,67 @@ fail:
 }
 
 
+/* cbsExtendBlockPool -- extend block pool with memory */
+
+static void cbsExtendBlockPool(CBS cbs, Addr base, Addr limit)
+{
+  Tract tract;
+  Addr addr;
+
+  AVERC(CBS, cbs);
+  AVER(base < limit);
+
+  /* Steal tracts from their owning pool */
+  TRACT_FOR(tract, addr, CBSLand(cbs)->arena, base, limit) {
+    TractFinish(tract);
+    TractInit(tract, cbs->blockPool, addr);
+  }
+
+  /* Extend the block pool with the stolen memory. */
+  MFSExtend(cbs->blockPool, base, limit);
+}
+
+
+/* cbsInsertSteal -- Insert a range into the CBS, possibly stealing
+ * memory for the block pool
+ */
+
+static Res cbsInsertSteal(Range rangeReturn, Land land, Range rangeIO)
+{
+  CBS cbs = MustBeA(CBS, land);
+  Arena arena = land->arena;
+  Size grainSize = ArenaGrainSize(arena);
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVER(rangeReturn != rangeIO);
+  AVERT(Range, rangeIO);
+  AVER(!RangeIsEmpty(rangeIO));
+  AVER(RangeIsAligned(rangeIO, LandAlignment(land)));
+  AVER(AlignIsAligned(LandAlignment(land), grainSize));
+
+  res = cbsInsert(rangeReturn, land, rangeIO);
+  if (res != ResOK && res != ResFAIL) {
+    /* Steal an arena grain and use it to extend the block pool. */
+    Addr stolenBase = RangeBase(rangeIO);
+    Addr stolenLimit = AddrAdd(stolenBase, grainSize);
+    cbsExtendBlockPool(cbs, stolenBase, stolenLimit);
+
+    /* Update the inserted range and try again. */
+    RangeSetBase(rangeIO, stolenLimit);
+    AVERT(Range, rangeIO);
+    if (RangeIsEmpty(rangeIO)) {
+      RangeCopy(rangeReturn, rangeIO);
+      res = ResOK;
+    } else {
+      res = cbsInsert(rangeReturn, land, rangeIO);
+      AVER(res == ResOK);  /* since we just extended the block pool */
+    }
+  }
+  return res;
+}
+
+
 /* cbsDelete -- Remove a range from a CBS
  *
  * See <design/land/#function.delete>.
@@ -503,6 +565,7 @@ static Res cbsDelete(Range rangeReturn, Land land, Range range)
 
   AVER(rangeReturn != NULL);
   AVERT(Range, range);
+  AVER(!RangeIsEmpty(range));
   AVER(RangeIsAligned(range, LandAlignment(land)));
 
   base = RangeBase(range);
@@ -568,6 +631,43 @@ failSplayTreeSearch:
 }
 
 
+static Res cbsDeleteSteal(Range rangeReturn, Land land, Range range)
+{
+  CBS cbs = MustBeA(CBS, land);
+  Arena arena = land->arena;
+  Size grainSize = ArenaGrainSize(arena);
+  RangeStruct containingRange;
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVERT(Range, range);
+  AVER(!RangeIsEmpty(range));
+  AVER(RangeIsAligned(range, LandAlignment(land)));
+  AVER(AlignIsAligned(LandAlignment(land), grainSize));
+
+  res = cbsDelete(&containingRange, land, range);
+  if (res == ResOK) {
+    RangeCopy(rangeReturn, &containingRange);
+  } else if (res != ResFAIL) {
+    /* Steal an arena grain from the base of the containing range and
+       use it to extend the block pool. */
+    Addr stolenBase = RangeBase(&containingRange);
+    Addr stolenLimit = AddrAdd(stolenBase, grainSize);
+    RangeStruct stolenRange;
+    AVER(stolenLimit <= RangeBase(range));
+    RangeInit(&stolenRange, stolenBase, stolenLimit);
+    res = cbsDelete(&containingRange, land, &stolenRange);
+    AVER(res == ResOK);  /* since this does not split any range */
+    cbsExtendBlockPool(cbs, stolenBase, stolenLimit);
+
+    /* Try again with original range. */
+    res = cbsDelete(rangeReturn, land, range);
+    AVER(res == ResOK);  /* since we just extended the block pool */
+  }
+  return res;
+}
+
+
 static Res cbsBlockDescribe(RangeTree block, mps_lib_FILE *stream)
 {
   Res res;
@@ -1091,7 +1191,9 @@ DEFINE_CLASS(Land, CBS, klass)
   klass->init = cbsInit;
   klass->sizeMethod = cbsSize;
   klass->insert = cbsInsert;
+  klass->insertSteal = cbsInsertSteal;
   klass->delete = cbsDelete;
+  klass->deleteSteal = cbsDeleteSteal;
   klass->iterate = cbsIterate;
   klass->iterateAndDelete = cbsIterateAndDelete;
   klass->findFirst = cbsFindFirst;

mps/code/failover.c

@@ -94,6 +94,26 @@ static Res failoverInsert(Range rangeReturn, Land land, Range range)
 }
 
 
+static Res failoverInsertSteal(Range rangeReturn, Land land, Range rangeIO)
+{
+  Failover fo = MustBeA(Failover, land);
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVER(rangeReturn != rangeIO);
+  AVERT(Range, rangeIO);
+
+  /* Provide more opportunities for coalescence. See
+   * <design/failover/#impl.assume.flush>.
+   */
+  (void)LandFlush(fo->primary, fo->secondary);
+
+  res = LandInsertSteal(rangeReturn, fo->primary, rangeIO);
+  AVER(res == ResOK || res == ResFAIL);
+  return res;
+}
+
+
 static Res failoverDelete(Range rangeReturn, Land land, Range range)
 {
   Failover fo = MustBeA(Failover, land);
@@ -162,6 +182,28 @@ static Res failoverDelete(Range rangeReturn, Land land, Range range)
 }
 
 
+static Res failoverDeleteSteal(Range rangeReturn, Land land, Range range)
+{
+  Failover fo = MustBeA(Failover, land);
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVERT(Range, range);
+
+  /* Prefer efficient search in the primary. See
+   * <design/failover/#impl.assume.flush>.
+   */
+  (void)LandFlush(fo->primary, fo->secondary);
+
+  res = LandDeleteSteal(rangeReturn, fo->primary, range);
+  if (res == ResFAIL)
+    /* Not found in primary: try secondary. */
+    res = LandDeleteSteal(rangeReturn, fo->secondary, range);
+  AVER(res == ResOK || res == ResFAIL);
+  return res;
+}
+
+
 static Bool failoverIterate(Land land, LandVisitor visitor, void *closure)
 {
   Failover fo = MustBeA(Failover, land);
@@ -285,7 +327,9 @@ DEFINE_CLASS(Land, Failover, klass)
   klass->init = failoverInit;
   klass->sizeMethod = failoverSize;
   klass->insert = failoverInsert;
+  klass->insertSteal = failoverInsertSteal;
   klass->delete = failoverDelete;
+  klass->deleteSteal = failoverDeleteSteal;
   klass->iterate = failoverIterate;
   klass->findFirst = failoverFindFirst;
   klass->findLast = failoverFindLast;

mps/code/freelist.c

@@ -787,7 +787,9 @@ DEFINE_CLASS(Land, Freelist, klass)
   klass->init = freelistInit;
   klass->sizeMethod = freelistSize;
   klass->insert = freelistInsert;
+  klass->insertSteal = freelistInsert; /* doesn't need to allocate */
   klass->delete = freelistDelete;
+  klass->deleteSteal = freelistDelete; /* doesn't need to allocate */
   klass->iterate = freelistIterate;
   klass->iterateAndDelete = freelistIterateAndDelete;
   klass->findFirst = freelistFindFirst;

mps/code/land.c

@@ -184,6 +184,33 @@ Res (LandInsert)(Range rangeReturn, Land land, Range range)
 }
 
 
+/* LandInsertSteal -- insert range of addresses into land, possibly
+ * stealing some of the inserted memory to allocate internal data
+ * structures.
+ *
+ * See <design/land/#function.insert-steal>
+ */
+
+Res LandInsertSteal(Range rangeReturn, Land land, Range rangeIO)
+{
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVERC(Land, land);
+  AVER(rangeReturn != rangeIO);
+  AVERT(Range, rangeIO);
+  AVER(RangeIsAligned(rangeIO, land->alignment));
+  AVER(!RangeIsEmpty(rangeIO));
+
+  landEnter(land);
+
+  res = Method(Land, land, insertSteal)(rangeReturn, land, rangeIO);
+
+  landLeave(land);
+  return res;
+}
+
+
 /* LandDelete -- delete range of addresses from land
  *
  * See <design/land/#function.delete>
@@ -196,6 +223,7 @@ Res (LandDelete)(Range rangeReturn, Land land, Range range)
   AVER(rangeReturn != NULL);
   AVERC(Land, land);
   AVERT(Range, range);
+  AVER(!RangeIsEmpty(range));
   AVER(RangeIsAligned(range, land->alignment));
   landEnter(land);
 
@@ -206,6 +234,31 @@ Res (LandDelete)(Range rangeReturn, Land land, Range range)
 }
 
 
+/* LandDeleteSteal -- delete range of addresses from land, possibly
+ * stealing some memory from the land to allocate internal data
+ * structures.
+ *
+ * See <design/land/#function.delete-steal>
+ */
+
+Res LandDeleteSteal(Range rangeReturn, Land land, Range range)
+{
+  Res res;
+
+  AVER(rangeReturn != NULL);
+  AVERC(Land, land);
+  AVERT(Range, range);
+  AVER(!RangeIsEmpty(range));
+  AVER(RangeIsAligned(range, land->alignment));
+  landEnter(land);
+
+  res = Method(Land, land, deleteSteal)(rangeReturn, land, range);
+
+  landLeave(land);
+  return res;
+}
+
+
 /* LandIterate -- iterate over isolated ranges of addresses in land
  *
  * See <design/land/#function.iterate>
@@ -549,7 +602,9 @@ DEFINE_CLASS(Land, Land, klass)
   klass->init = LandAbsInit;
   klass->sizeMethod = landNoSize;
   klass->insert = landNoInsert;
+  klass->insertSteal = landNoInsert;
   klass->delete = landNoDelete;
+  klass->deleteSteal = landNoDelete;
   klass->iterate = landNoIterate;
   klass->iterateAndDelete = landNoIterateAndDelete;
   klass->findFirst = landNoFind;

mps/code/landtest.c

@@ -5,6 +5,8 @@
  *
  * Test all three Land implementations against duplicate operations on
  * a bit-table.
+ *
+ * Test the "steal" operations on a CBS.
  */
 
 #include "cbs.h"
@@ -429,7 +431,7 @@ static void test(TestState state, unsigned n, unsigned operations)
 
 #define testArenaSIZE   (((size_t)4)<<20)
 
-int main(int argc, char *argv[])
+static void test_land(void)
 {
   static const struct {
     LandClass (*klass)(void);
@@ -453,7 +455,6 @@ int main(int argc, char *argv[])
   Pool mfs = MFSPool(&blockPool);
   size_t i;
 
-  testlib_init(argc, argv);
   state.size = ArraySize;
   state.align = (1 << rnd() % 4) * MPS_PF_ALIGN;
 
@@ -540,7 +541,7 @@ int main(int argc, char *argv[])
   ControlFree(arena, p, (state.size + 1) * state.align);
   mps_arena_destroy(arena);
 
-  printf("\nNumber of allocations attempted: %"PRIuLONGEST"\n",
+  printf("Number of allocations attempted: %"PRIuLONGEST"\n",
          (ulongest_t)NAllocateTried);
   printf("Number of allocations succeeded: %"PRIuLONGEST"\n",
          (ulongest_t)NAllocateSucceeded);
@@ -548,6 +549,102 @@ int main(int argc, char *argv[])
          (ulongest_t)NDeallocateTried);
   printf("Number of deallocations succeeded: %"PRIuLONGEST"\n",
          (ulongest_t)NDeallocateSucceeded);
+}
+
+static void shuffle(Addr *addr, size_t n)
+{
+  size_t i;
+  for (i = 0; i < n; ++i) {
+    size_t j = rnd() % (n - i);
+    Addr tmp = addr[j];
+    addr[j] = addr[i];
+    addr[i] = tmp;
+  }
+}
+
+static void test_steal(void)
+{
+  mps_arena_t mpsArena;
+  Arena arena;
+  MFSStruct mfs;                /* stores blocks for the CBS */
+  Pool pool = MFSPool(&mfs);
+  CBSStruct cbs;                /* allocated memory land */
+  Land land = CBSLand(&cbs);
+  Addr base;
+  Addr addr[4096];
+  Size grainSize;
+  size_t i, n = NELEMS(addr), stolenInsert = 0, missingDelete = 0;
+
+  MPS_ARGS_BEGIN(args) {
+    die(mps_arena_create_k(&mpsArena, mps_arena_class_vm(), args), "arena");
+  } MPS_ARGS_END(args);
+  arena = (Arena)mpsArena; /* avoid pun */
+  grainSize = ArenaGrainSize(arena);
+
+  MPS_ARGS_BEGIN(args) {
+    MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, sizeof(RangeTreeStruct));
+    MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, grainSize);
+    MPS_ARGS_ADD(args, MFSExtendSelf, FALSE);
+    die(PoolInit(pool, arena, CLASS(MFSPool), args), "pool");
+  } MPS_ARGS_END(args);
+  
+  MPS_ARGS_BEGIN(args) {
+    MPS_ARGS_ADD(args, CBSBlockPool, pool);
+    die(LandInit(land, CLASS(CBS), arena, grainSize, NULL, args),
+        "land");
+  } MPS_ARGS_END(args);
+
+  /* Allocate a range of grains. */
+  die(ArenaAlloc(&base, LocusPrefDefault(), grainSize * n, pool), "alloc");
+  for (i = 0; i < n; ++i)
+    addr[i] = AddrAdd(base, i * grainSize);
+
+  /* Shuffle the grains. */
+  shuffle(addr, n);
+
+  /* Insert grains into the land in shuffled order. */
+  for (i = 0; i < n; ++i) {
+    RangeStruct range, origRange, containingRange;
+    RangeInitSize(&range, addr[i], grainSize);
+    RangeCopy(&origRange, &range);
+    die(LandInsertSteal(&containingRange, land, &range), "steal");
+    if (!RangesEqual(&origRange, &range))
+      ++ stolenInsert;
+  }
+
+  /* Shuffle grains again. */
+  shuffle(addr, n);
+
+  /* Delete unstolen grains from the land in shuffled order. */
+  for (i = 0; i < n; ++i) {
+    RangeStruct range, containingRange;
+    Res res;
+    RangeInitSize(&range, addr[i], grainSize);
+    res = LandDeleteSteal(&containingRange, land, &range);
+    if (res == ResOK) {
+      ArenaFree(addr[i], grainSize, pool);
+    } else {
+      Insist(res == ResFAIL);     /* grain was stolen */
+      ++ missingDelete;
+    }
+  }
+
+  Insist(LandSize(land) == 0);
+  LandFinish(land);
+  Insist(PoolFreeSize(pool) == PoolTotalSize(pool));
+  PoolFinish(pool);
+  mps_arena_destroy(arena);
+  Insist(stolenInsert <= missingDelete);
+  Insist(missingDelete < n);
+  printf("Stolen on insert: %"PRIuLONGEST"\n", (ulongest_t)stolenInsert);
+  printf("Missing on delete: %"PRIuLONGEST"\n", (ulongest_t)missingDelete);
+}
+
+int main(int argc, char *argv[])
+{
+  testlib_init(argc, argv);
+  test_land();
+  test_steal();
   printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
   return 0;
 }

mps/code/mpm.h

@@ -970,7 +970,9 @@ extern Size (LandSize)(Land land);
 extern Res LandInit(Land land, LandClass klass, Arena arena, Align alignment, void *owner, ArgList args);
 extern void LandFinish(Land land);
 extern Res (LandInsert)(Range rangeReturn, Land land, Range range);
+extern Res LandInsertSteal(Range rangeReturn, Land land, Range rangeIO);
 extern Res (LandDelete)(Range rangeReturn, Land land, Range range);
+extern Res LandDeleteSteal(Range rangeReturn, Land land, Range range);
 extern Bool (LandIterate)(Land land, LandVisitor visitor, void *closure);
 extern Bool (LandIterateAndDelete)(Land land, LandDeleteVisitor visitor, void *closure);
 extern Bool (LandFindFirst)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete);

mps/code/mpmst.h

@@ -558,7 +558,9 @@ typedef struct LandClassStruct {
   LandSizeMethod sizeMethod;    /* total size of ranges in land */
   LandInitMethod init;          /* initialize the land */
   LandInsertMethod insert;      /* insert a range into the land */
+  LandInsertMethod insertSteal; /* insert a range, possibly stealing memory */
   LandDeleteMethod delete;      /* delete a range from the land */
+  LandDeleteMethod deleteSteal; /* delete a range, possibly stealing memory */
   LandIterateMethod iterate;    /* iterate over ranges in the land */
   LandIterateAndDeleteMethod iterateAndDelete; /* iterate and maybe delete */
   LandFindMethod findFirst;     /* find first range of given size */

mps/design/land.txt

@@ -127,8 +127,8 @@ stored in the land.
 
 ``Res LandInsert(Range rangeReturn, Land land, Range range)``
 
-_`.function.insert`: If any part of ``range`` is already in the
-land, then leave it unchanged and return ``ResFAIL``. Otherwise,
+_`.function.insert`: If any part of ``range`` is already in the land,
+then leave the land unchanged and return ``ResFAIL``. Otherwise,
 attempt to insert ``range`` into the land. If the insertion succeeds,
 then update ``rangeReturn`` to describe the contiguous isolated range
 containing the inserted range (this may differ from ``range`` if there
@@ -143,6 +143,32 @@ structure to represent it failed.
 _`.function.insert.alias`: It is acceptable for ``rangeReturn`` and
 ``range`` to share storage.
 
+``Res LandInsertSteal(Range rangeReturn, Land land, Range rangeIO)``
+
+_`.function.insert-steal`: If any part of ``rangeIO`` is already in
+the land, then leave the land unchanged and return ``ResFAIL``.
+Otherwise, insert ``rangeIO`` into the land, update ``rangeReturn`` to
+describe the contiguous isolated range containing the inserted range
+(this may differ from ``range`` if there was coalescence on either
+side), and return ``ResOK``.
+
+_`.function.insert-steal.steal`: If insertion requires allocation for
+the land's internal data structures, steal some of the memory in
+``rangeIO``, use it to satisfy the allocation, update ``rangeIO`` so
+that it describes the remaining part of of the range, and insert the
+remainder into the land as described above.
+
+_`.function.insert-steal.allocated`: In order for stealing to work,
+the inserted range must be allocated from the arena to some pool or
+pools.
+
+_`.function.insert-steal.empty`: After stealing memory, ``rangeIO``
+might be empty, in which case ``rangeReturn`` will be a copy of
+``rangeIO``.
+
+_`.function.insert-steal.alias.not`: It is not acceptable for
+``rangeReturn`` and ``rangeIO`` to share storage.
+
 ``Res LandDelete(Range rangeReturn, Land land, Range range)``
 
 _`.function.delete`: If any part of the range is not in the land,
@@ -167,6 +193,27 @@ strategy.
 _`.function.delete.alias`: It is acceptable for ``rangeReturn`` and
 ``range`` to share storage.
 
+``Res LandDeleteSteal(Range rangeReturn, Land land, Range range)``
+
+_`.function.delete-steal`: If any part of the range is not in the
+land, then leave the land unchanged and return ``ResFAIL``. Otherwise,
+update ``rangeReturn`` to describe the contiguous isolated range that
+contains ``range`` (this may differ from ``range`` if there are
+fragments on either side), delete the range from the land, and return
+``ResOK``.
+
+_`.function.delete-steal.steal`: If deletion requires allocation for
+the land's internal data structures, steal some of the memory in the
+contiguous isolated range that contains ``range``, and use it to
+satisfy the allocation.
+
+_`.function.delete-steal.allocated`: In order for stealing to work,
+the addresses stored in the land must be allocated from the arena to
+some pool or pools.
+
+_`.function.delete-steal.alias`: It is acceptable for ``rangeReturn``
+and ``range`` to share storage.
+
 ``Bool LandIterate(Land land, LandVisitor visitor, void *closure)``
 
 _`.function.iterate`: ``LandIterate()`` is the function used to

mps/test/function/235.c

@@ -0,0 +1,76 @@
+/* 
+TEST_HEADER
+ id = $Id: //info.ravenbrook.com/project/mps/master/test/function/234.c#1 $
+ summary = regression test for job004102
+ language = c
+ link = testlib.o
+ parameters = GRAINSIZE=4096
+END_HEADER
+*/
+
+#include "mpsavm.h"
+#include "mpscmvff.h"
+#include "testlib.h"
+
+static void test(void)
+{
+  mps_arena_t arena;
+  mps_pool_t pool;
+  void *addr[GRAINSIZE];
+  size_t i;
+
+  MPS_ARGS_BEGIN(args) {
+    MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, GRAINSIZE);
+    MPS_ARGS_ADD(args, MPS_KEY_SPARE_COMMIT_LIMIT, 0);
+    cdie(mps_arena_create_k(&arena, mps_arena_class_vm(), args),
+         "create arena");
+  } MPS_ARGS_END(args);
+
+  MPS_ARGS_BEGIN(args) {
+    MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, GRAINSIZE);
+    MPS_ARGS_ADD(args, MPS_KEY_SPARE, 0);
+    cdie(mps_pool_create_k(&pool, arena, mps_class_mvff(), args),
+         "create pool");
+  } MPS_ARGS_END(args);
+
+  /* Allocate objects, each consisting of one arena grain. */
+  for (i = 0; i < GRAINSIZE; ++i) {
+    die(mps_alloc(&addr[i], pool, GRAINSIZE), "alloc");
+  }
+
+  /* 1. The MVFF pool was configured to keep no spare memory, so the
+     freed memory will be returned to the arena immediately and added
+     to the free land.
+
+     2. We are freeing every other object, and so each object is an
+     isolated continguous free range and so requires an additional CBS
+     block.
+
+     3. Eventually the free land's block pool runs out of memory and
+     requires extending.
+
+     4. The arena was configured to have no spare committed memory,
+     and no additional memory can be mapped, because the commit limit
+     is set to the committed memory. This means that the arena will
+     have to "steal" a grain from the freed memory to extend the block
+     pool.
+
+     5. The freed memory consists of a single grain, so after stealing
+     a grain there is nothing left to add to the free land. This is
+     the case we are testing. */
+
+  for (i = 0; i < GRAINSIZE; i += 2) {
+    mps_arena_commit_limit_set(arena, mps_arena_committed(arena));
+    mps_free(pool, addr[i], GRAINSIZE);
+  }
+
+  mps_pool_destroy(pool);
+  mps_arena_destroy(arena);
+}
+
+int main(void)
+{
+ easy_tramp(test);
+ pass();
+ return 0;
+}

mps/test/testsets/passing

@@ -174,3 +174,4 @@ function/231.c
 function/232.c
 function/233.c
 function/234.c
+function/235.c