diff --git a/mps/code/arena.c b/mps/code/arena.c
index 33654b03082..e2dff615401 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -197,11 +197,22 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment)
 
   arena->sig = ArenaSig;
 
+  MPS_ARGS_BEGIN(piArgs) {
+    MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSBlockStruct));
+    MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, arena->alignment);
+    MPS_ARGS_ADD(piArgs, MFSExtendSelf, FALSE); /* FIXME: Explain why */
+    MPS_ARGS_DONE(piArgs);
+    res = PoolInit(&arena->cbsBlockPoolStruct.poolStruct, arena,
+                   PoolClassMFS(), piArgs);
+  } MPS_ARGS_END(piArgs);
+  AVER(res == ResOK);
+  if (res != ResOK)
+    goto failMFSInit;
+
   /* Initialise the freeCBS after the rest is initialised so that the CBS
      code can check the arena and pick up the alignment. */
   MPS_ARGS_BEGIN(cbsiArgs) {
-    MPS_ARGS_ADD(cbsiArgs, MPS_KEY_CBS_EXTEND_BY, arena->alignment);
-    MPS_ARGS_ADD(cbsiArgs, MFSExtendSelf, FALSE); /* FIXME: Explain why */
+    MPS_ARGS_ADD(cbsiArgs, CBSBlockPool, &arena->cbsBlockPoolStruct.poolStruct);
     MPS_ARGS_DONE(cbsiArgs);
     res = CBSInit(arena, &arena->freeCBS, arena, arena->alignment, TRUE, cbsiArgs);
   } MPS_ARGS_END(cbsiArgs);
@@ -221,6 +232,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment)
 failReservoirInit:
   CBSFinish(&arena->freeCBS);
 failCBSInit:
+  PoolFinish(&arena->cbsBlockPoolStruct.poolStruct);
+failMFSInit:
   GlobalsFinish(ArenaGlobals(arena));
 failGlobalsInit:
   return res;
@@ -338,17 +351,18 @@ void ArenaDestroy(Arena arena)
      so manually get rid of all its tracts first.  Ought to reset the
      CBS tree first, so that there are no dangling pointers. */
   {
-    Pool pool = &arena->freeCBS.blockPoolStruct.poolStruct;
-    Tract tract = arena->freeCBS.blockPoolStruct.tractList;
+    Pool pool = &arena->cbsBlockPoolStruct.poolStruct;
+    Tract tract = arena->cbsBlockPoolStruct.tractList;
     Size size = ArenaAlign(arena);
     while(tract != NULL) {
       Tract nextTract = (Tract)TractP(tract);   /* .tract.chain */
       (*arena->class->free)(TractBase(tract), size, pool);
       tract = nextTract;
     }
-    arena->freeCBS.blockPoolStruct.tractList = NULL;
+    arena->cbsBlockPoolStruct.tractList = NULL;
   }
   CBSFinish(&arena->freeCBS);
+  PoolFinish(&arena->cbsBlockPoolStruct.poolStruct);
 
   /* Call class-specific finishing.  This will call ArenaFinish. */
   (*arena->class->finish)(arena);
@@ -565,6 +579,8 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
  * This is a primitive allocator used to allocate pages for the arena CBS.
  * It is called rarely and can use a simple search.  It may not use the
  * CBS or any pool, because it is used as part of the bootstrap.
+ *
+ * FIXME: Might this allocate a page that is in a free CBS?
  */
 
 static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
@@ -622,7 +638,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
 
 Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit)
 {
-  Pool pool = &arena->freeCBS.blockPoolStruct.poolStruct;
+  Pool pool = &arena->cbsBlockPoolStruct.poolStruct;
   RangeStruct range;
   Res res;
 
@@ -946,7 +962,7 @@ void ArenaFree(Addr base, Size size, Pool pool)
       /* The CBS's MFS doesn't have enough space to describe the free memory.
          Give it some of the memory we're about to free and try again. */
       Tract tract = TractOfBaseAddr(arena, base);
-      Pool mfs = &arena->freeCBS.blockPoolStruct.poolStruct;
+      Pool mfs = &arena->cbsBlockPoolStruct.poolStruct;
       AVER(size >= ArenaAlign(arena));
       TractFinish(tract);
       TractInit(tract, mfs, base);
diff --git a/mps/code/arg.c b/mps/code/arg.c
index caced7e6f1d..442066824ad 100644
--- a/mps/code/arg.c
+++ b/mps/code/arg.c
@@ -99,6 +99,11 @@ Bool ArgCheckdouble(Arg arg) {
   return TRUE;
 }
 
+Bool ArgCheckPool(Arg arg) {
+  CHECKD(Pool, arg->val.pool);
+  return TRUE;
+}
+
 
 ARG_DEFINE_KEY(args_end, Shouldnt);
 
diff --git a/mps/code/arg.h b/mps/code/arg.h
index 1598707355f..dd458efe7b7 100644
--- a/mps/code/arg.h
+++ b/mps/code/arg.h
@@ -54,6 +54,7 @@ extern Bool ArgCheckPointer(Arg arg);
 extern Bool ArgCheckRankSet(Arg arg);
 extern Bool ArgCheckRank(Arg arg);
 extern Bool ArgCheckdouble(Arg arg);
+extern Bool ArgCheckPool(Arg arg);
 
 
 #endif /* arg_h */
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index fcd43dd8aa5..91760b87702 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -21,15 +21,6 @@
 SRCID(cbs, "$Id$");
 
 
-typedef struct CBSBlockStruct *CBSBlock;
-typedef struct CBSBlockStruct {
-  SplayNodeStruct splayNode;
-  Addr base;
-  Addr limit;
-  Size maxSize; /* accurate maximum block size of sub-tree */
-  ZoneSet zones; /* union zone set of all ranges in sub-tree */
-} CBSBlockStruct;
-
 #define CBSBlockBase(block) ((block)->base)
 #define CBSBlockLimit(block) ((block)->limit)
 #define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit)
@@ -41,7 +32,7 @@ typedef struct CBSBlockStruct {
 #define splayNodeOfCBSBlock(block) (&((block)->splayNode))
 #define keyOfCBSBlock(block) ((void *)&((block)->base))
 
-#define cbsBlockPool(cbs) MFSPool(&(cbs)->blockPoolStruct)
+#define cbsBlockPool(cbs) RVALUE((cbs)->blockPool)
 
 
 /* cbsEnter, cbsLeave -- Avoid re-entrance
@@ -78,10 +69,11 @@ Bool CBSCheck(CBS cbs)
   CHECKL(cbs != NULL);
   CHECKL(SplayTreeCheck(splayTreeOfCBS(cbs)));
   /* nothing to check about splayTreeSize */
-  CHECKD(MFS, &cbs->blockPoolStruct);
+  CHECKD(Pool, cbs->blockPool);
   CHECKU(Arena, cbs->arena);
   CHECKL(BoolCheck(cbs->fastFind));
   CHECKL(BoolCheck(cbs->inCBS));
+  CHECKL(BoolCheck(cbs->ownPool));
   /* No MeterCheck */
 
   return TRUE;
@@ -220,6 +212,7 @@ static void cbsUpdateNode(SplayTree tree, SplayNode node,
  */
 
 ARG_DEFINE_KEY(cbs_extend_by, Size);
+ARG_DEFINE_KEY(cbs_block_pool, Pool);
 
 Res CBSInit(Arena arena, CBS cbs, void *owner, Align alignment,
             Bool fastFind, ArgList args)
@@ -228,9 +221,12 @@ Res CBSInit(Arena arena, CBS cbs, void *owner, Align alignment,
   Bool extendSelf = TRUE;
   ArgStruct arg;
   Res res;
+  Pool blockPool = NULL;
 
   AVERT(Arena, arena);
 
+  if (ArgPick(&arg, args, CBSBlockPool))
+    blockPool = arg.val.pool;
   if (ArgPick(&arg, args, MPS_KEY_CBS_EXTEND_BY))
     extendBy = arg.val.size;
   if (ArgPick(&arg, args, MFSExtendSelf))
@@ -239,15 +235,24 @@ Res CBSInit(Arena arena, CBS cbs, void *owner, Align alignment,
   cbs->arena = arena;
   SplayTreeInit(splayTreeOfCBS(cbs), &cbsSplayCompare,
                 fastFind ? &cbsUpdateNode : NULL);
-  MPS_ARGS_BEGIN(piArgs) {
-    MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSBlockStruct));
-    MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, extendBy);
-    MPS_ARGS_ADD(piArgs, MFSExtendSelf, extendSelf);
-    MPS_ARGS_DONE(piArgs);
-    res = PoolInit(&cbs->blockPoolStruct.poolStruct, arena, PoolClassMFS(), piArgs);
-  } MPS_ARGS_END(piArgs);
-  if (res != ResOK)
-    return res;
+
+  if (blockPool != NULL) {
+    cbs->blockPool = blockPool;
+    cbs->ownPool = FALSE;
+  } else {
+    MPS_ARGS_BEGIN(pcArgs) {
+      MPS_ARGS_ADD(pcArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSBlockStruct));
+      MPS_ARGS_ADD(pcArgs, MPS_KEY_EXTEND_BY, extendBy);
+      MPS_ARGS_ADD(pcArgs, MFSExtendSelf, extendSelf);
+      MPS_ARGS_DONE(pcArgs);
+      res = PoolCreate(&cbs->blockPool, arena, PoolClassMFS(), pcArgs);
+    } MPS_ARGS_END(pcArgs);
+    if (res != ResOK)
+      return res;
+    cbs->ownPool = TRUE;
+  }
+
+  cbs->blockPool = blockPool;
   cbs->splayTreeSize = 0;
 
   cbs->fastFind = fastFind;
@@ -280,7 +285,8 @@ void CBSFinish(CBS cbs)
   cbs->sig = SigInvalid;
 
   SplayTreeFinish(splayTreeOfCBS(cbs));
-  PoolFinish(cbsBlockPool(cbs));
+  if (cbs->ownPool)
+    PoolDestroy(cbsBlockPool(cbs));
 }
 
 
diff --git a/mps/code/cbs.h b/mps/code/cbs.h
index 9b419ae32f0..5ad85e2b30b 100644
--- a/mps/code/cbs.h
+++ b/mps/code/cbs.h
@@ -16,12 +16,26 @@
 #include "splay.h"
 
 
+typedef struct CBSBlockStruct *CBSBlock;
+typedef struct CBSBlockStruct {
+  SplayNodeStruct splayNode;
+  Addr base;
+  Addr limit;
+  Size maxSize; /* accurate maximum block size of sub-tree */
+  ZoneSet zones; /* union zone set of all ranges in sub-tree */
+} CBSBlockStruct;
+
+
 typedef struct CBSStruct *CBS;
 typedef Bool (*CBSIterateMethod)(CBS cbs, Range range,
                                  void *closureP, Size closureS);
 
 extern Bool CBSCheck(CBS cbs);
 
+extern const struct mps_key_s _mps_key_cbs_block_pool;
+#define CBSBlockPool (&_mps_key_cbs_block_pool)
+#define CBSBlockPool_FIELD pool
+
 extern Res CBSInit(Arena arena, CBS cbs, void *owner,
                    Align alignment, Bool fastFind, ArgList args);
 extern void CBSFinish(CBS cbs);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index dfa4c7554ea..26ca573e0d3 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -614,11 +614,12 @@ typedef struct GlobalsStruct {
 typedef struct CBSStruct {
   SplayTreeStruct splayTree;
   STATISTIC_DECL(Count splayTreeSize);
-  MFSStruct blockPoolStruct;    /* FIXME: ref to why this is inlined */
+  Pool blockPool;
   Arena arena;                  /* needed by update method */
   Align alignment;
   Bool fastFind;
   Bool inCBS;                   /* prevent reentrance */
+  Bool ownPool;                 /* did we create blockPool? */
   /* meters for sizes of search structures at each op */
   METER_DECL(splaySearch);
   Sig sig; /* sig at end because embeded */
@@ -660,6 +661,7 @@ typedef struct mps_arena_s {
   ChunkCacheEntryStruct chunkCache; /* just one entry */
   
   Bool hasFreeCBS;              /* Is freeCBS available? */
+  MFSStruct cbsBlockPoolStruct; /* Shared pool for CBS blocks */
   CBSStruct freeCBS;            /* CBS of free address space */
   ZoneSet freeZones;            /* zones not yet allocated */
 
diff --git a/mps/code/mps.h b/mps/code/mps.h
index e155651c189..6cbf1e180b4 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -142,6 +142,7 @@ typedef struct mps_arg_s {
     mps_fmt_isfwd_t fmt_isfwd;
     mps_fmt_pad_t fmt_pad;
     mps_fmt_class_t fmt_class;
+    mps_pool_t pool;
   } val;
 } mps_arg_s;