Park the arena before destroying the default chain, to ensure that there are no traces using that chain.

Fix test cases that used automatic collection, but destroyed data structures without parking the arena.
Document the requirement on mps_chain_destroy and add the assertion to "common assertions and their causes".

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

mps/code/amcssth.c

@@ -149,17 +149,6 @@ static void init(void)
 }
 
 
-/* finish -- finish roots and chain */
-
-static void finish(void)
-{
-  mps_root_destroy(exactRoot);
-  mps_root_destroy(ambigRoot);
-  mps_chain_destroy(chain);
-  mps_fmt_destroy(format);
-}
-
-
 /* churn -- create an object and install into roots */
 
 static void churn(mps_ap_t ap, size_t roots_count)
@@ -218,7 +207,7 @@ static void *kid_thread(void *arg)
 
 /* test -- the body of the test */
 
-static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
+static void test_pool(mps_pool_t pool, size_t roots_count, int mode)
 {
   size_t i;
   mps_word_t collections, rampSwitch;
@@ -226,14 +215,10 @@ static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
   int ramping;
   mps_ap_t ap, busy_ap;
   mps_addr_t busy_init;
-  mps_pool_t pool;
   testthr_t kids[10];
   closure_s cl;
   int walked = FALSE, ramped = FALSE;
 
-  die(mps_pool_create(&pool, arena, pool_class, format, chain),
-      "pool_create(amc)");
-
   cl.pool = pool;
   cl.roots_count = roots_count;
 
@@ -323,16 +308,13 @@ static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
 
   for (i = 0; i < sizeof(kids)/sizeof(kids[0]); ++i)
     testthr_join(&kids[i], NULL);
-
-  mps_pool_destroy(pool);
-
-  return NULL;
 }
 
 static void test_arena(int mode)
 {
   mps_thr_t thread;
   mps_root_t reg_root;
+  mps_pool_t amc_pool, amcz_pool;
   void *marker = &marker;
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
@@ -345,12 +327,23 @@ static void test_arena(int mode)
   die(mps_root_create_reg(&reg_root, arena, mps_rank_ambig(), 0, thread,
                           mps_stack_scan_ambig, marker, 0), "root_create");
 
-  test_pool(mps_class_amc(), exactRootsCOUNT, mode);
-  test_pool(mps_class_amcz(), 0, mode);
+  die(mps_pool_create(&amc_pool, arena, mps_class_amc(), format, chain),
+      "pool_create(amc)");
+  die(mps_pool_create(&amcz_pool, arena, mps_class_amcz(), format, chain),
+      "pool_create(amcz)");
 
+  test_pool(amc_pool, exactRootsCOUNT, mode);
+  test_pool(amcz_pool, 0, mode);
+
+  mps_arena_park(arena);
+  mps_pool_destroy(amc_pool);
+  mps_pool_destroy(amcz_pool);
   mps_root_destroy(reg_root);
   mps_thread_dereg(thread);
-  finish();
+  mps_root_destroy(exactRoot);
+  mps_root_destroy(ambigRoot);
+  mps_chain_destroy(chain);
+  mps_fmt_destroy(format);
   report(arena);
   mps_arena_destroy(arena);
 }

mps/code/exposet0.c

@@ -222,6 +222,7 @@ static void *test(void *arg, size_t s)
   }
 
   (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);

mps/code/global.c

@@ -431,6 +431,10 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
 
   AVERT(Globals, arenaGlobals);
 
+  /* Park the arena before destroying the default chain, to ensure
+   * that there are no traces using that chain. */
+  ArenaPark(arenaGlobals);
+
   arena = GlobalsArena(arenaGlobals);
   arenaDenounce(arena);
 

mps/code/qs.c

@@ -367,6 +367,7 @@ static void *go(void *p, size_t s)
   qsort(list, listl, sizeof(mps_word_t), &compare);
   validate();
 
+  mps_arena_park(arena);
   mps_root_destroy(regroot);
   mps_root_destroy(actroot);
   mps_ap_destroy(ap);
@@ -374,6 +375,7 @@ static void *go(void *p, size_t s)
   mps_pool_destroy(mpool);
   mps_chain_destroy(chain);
   mps_fmt_destroy(format);
+  mps_arena_release(arena);
 
   return NULL;
 }

mps/manual/source/topic/collection.rst

@@ -134,8 +134,12 @@ For example::
 
     ``chain`` is the generation chain.
 
-    It is an error to destroy a generation chain if there exists a
-    :term:`pool` using the chain. The pool must be destroyed first.
+    It is an error to destroy a generation chain if there is a garbage
+    collection in progress on the chain, or if there are any
+    :term:`pools` using the chain. Before calling this function, the
+    arena should be parked (by calling :c:func:`mps_arena_park`) to
+    ensure that there are no collections in progress, and pools using
+    the chain must be destroyed.
 
 
 .. index::

mps/manual/source/topic/error.rst

@@ -262,6 +262,15 @@ this documentation.
     :term:`format methods` and :term:`stepper functions`.
 
 
+``locus.c: chain->activeTraces == TraceSetEMPTY)``
+
+    The client program called :c:func:`mps_chain_destroy`, but there
+    was a garbage collection in progress on that chain.
+
+    Park the arena before destroying the chain by calling
+    :c:func:`mps_arena_park`.
+
+
 ``mpsi.c: SizeIsAligned(size, BufferPool(buf)->alignment)``
 
     The client program reserved a block by calling
@@ -269,7 +278,7 @@ this documentation.
     alignment required by the pool's :term:`object format`.
 
 
-``pool.c: (pool->class->attr & AttrALLOC) != 0``
+``pool.c: PoolHasAttr(pool, AttrALLOC)``
 
     The client program called :c:func:`mps_alloc` on a pool that does
     not support this form of allocation. Use an :term:`allocation