From 0fcb0ecf90b76832bf10c2a986d73c0336fd5456 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 31 Jul 2018 13:35:22 +0100
Subject: [PATCH] Introduce a count of the "system" pools (that is, those
 remaining when arenadestroy is called), so that arena classes can add new
 ones.

Copied from Perforce
 Change: 194812
---
 mps/code/global.c                 | 13 ++++++-------
 mps/code/mpmst.h                  |  1 +
 mps/manual/source/topic/error.rst |  2 +-
 mps/test/conerr/4.c               |  2 +-
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index 3417d0c75ef..a69dad836cb 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -308,6 +308,11 @@ Res GlobalsInit(Globals arenaGlobals)
   arenaGlobals->bufferLogging = FALSE;
   RingInit(&arenaGlobals->poolRing);
   arenaGlobals->poolSerial = (Serial)0;
+  /* The system pools are:
+     1. arena->freeCBSBlockPoolStruct
+     2. arena->controlPoolStruct
+     3. arena->controlPoolStruct.cbsBlockPoolStruct */
+  arenaGlobals->systemPools = (Count)3;
   RingInit(&arenaGlobals->rootRing);
   arenaGlobals->rootSerial = (Serial)0;
   RingInit(&arenaGlobals->rememberedSummaryRing);
@@ -533,13 +538,7 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
   AVER(RingIsSingle(&arenaGlobals->rootRing)); /* <design/check/#.common> */
   for(rank = RankMIN; rank < RankLIMIT; ++rank)
     AVER(RingIsSingle(&arena->greyRing[rank]));
-
-  /* At this point the following pools still exist:
-   * 0. arena->freeCBSBlockPoolStruct
-   * 1. arena->controlPoolStruct
-   * 2. arena->controlPoolStruct.cbsBlockPoolStruct
-   */
-  AVER(RingLength(&arenaGlobals->poolRing) == 3); /* <design/check/#.common> */
+  AVER(RingLength(&arenaGlobals->poolRing) == arenaGlobals->systemPools); /* <design/check/#.common> */
 }
 
 
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 3dbc13caf6b..a83069966ab 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -528,6 +528,7 @@ typedef struct GlobalsStruct {
   /* pool fields (<code/pool.c>) */
   RingStruct poolRing;          /* ring of pools in arena */
   Serial poolSerial;            /* serial of next created pool */
+  Count systemPools;            /* count of pools remaining at ArenaDestroy */
 
   /* root fields (<code/root.c>) */
   RingStruct rootRing;          /* ring of roots attached to arena */
diff --git a/mps/manual/source/topic/error.rst b/mps/manual/source/topic/error.rst
index e3df2352d7e..e79b0d87a76 100644
--- a/mps/manual/source/topic/error.rst
+++ b/mps/manual/source/topic/error.rst
@@ -300,7 +300,7 @@ this documentation.
     It is necessary to call :c:func:`mps_thread_dereg` first.
 
 
-``global.c: RingLength(&arenaGlobals->poolRing) == 4``
+``global.c: RingLength(&arenaGlobals->poolRing) == arenaGlobals->systemPools``
 
     The client program called :c:func:`mps_arena_destroy` without
     destroying all the :term:`pools` belonging to the arena.
diff --git a/mps/test/conerr/4.c b/mps/test/conerr/4.c
index 396b7655b1a..74fb62a5eef 100644
--- a/mps/test/conerr/4.c
+++ b/mps/test/conerr/4.c
@@ -7,7 +7,7 @@ TEST_HEADER
 OUTPUT_SPEC
  assert = true
  assertfile P= global.c
- assertcond =~ RingLength\(&arenaGlobals->poolRing\) == \d+
+ assertcond = RingLength(&arenaGlobals->poolRing) == arenaGlobals->systemPools
 END_HEADER
 */