From a3b9e83fee9a7109068421e041764241058c8341 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 22 Apr 2016 15:00:27 +0100
Subject: [PATCH 01/31] Get the mmqa test system working on windows. in detail:

1. Document how to run it on Windows from a Cygwin shell.
2. Ignore trailing spaces when analyzing test output.
3. Use the directory separator "/" since we're running under Cygwin.
4. No need for cat.exe, strings.exe, or tee.exe (these are supplied by Cygwin).
5. Microsoft Visual C/C++ needs /D_CRT_SECURE_NO_WARNINGS to avoid a warning about scanf.
6. The Microsoft Visual C/C++ linker no longer takes the options /debugtype:both or /debug:full. Replace with /debug.
7. Remove /pdb:none option (we want the PDB so that we can debug the result).
8. windows.h defines an UNALIGNED macro, so need to #undef it.
9. The long int type is 32 bits on 64-bit Windows, so we need size_t instead.
10. The values in the LPEXCEPTION_RECORD structure have type ULONG_PTR.
11. Test cases are expecting access violations to report abort=true, but on Windows they are caught by the exception handler, so report abort=true in this case.
12. mpsw3.h has gone, but we do need mpswin.h.

Fix some of the test cases:
1. Avoid compiler warning about overflowed multiplication in argerr/153.c.
2. In conerr/2.c, conerr/8.c and conerr/13.c, malloc enough space so that the signature check doesn't cause an access violation.
3. In conerr/25.c, allocate an object whose size is aligned to the platform alignment, which is 16 bytes on w3i6mv.
4. In connerr/18.c, conerr/53.c and conerr/54.c, update the location and text of the expected assertions.

Copied from Perforce
 Change: 191564
 ServerID: perforce.ravenbrook.com
---
 mps/test/README                  | 38 ++++++++++++++++++++++++++++++++
 mps/test/argerr/153.c            |  2 +-
 mps/test/conerr/13.c             |  2 +-
 mps/test/conerr/18.c             |  4 ++--
 mps/test/conerr/2.c              |  2 +-
 mps/test/conerr/25.c             |  8 +++----
 mps/test/conerr/53.c             |  2 +-
 mps/test/conerr/54.c             |  2 +-
 mps/test/conerr/8.c              |  2 +-
 mps/test/test/script/headread    |  2 +-
 mps/test/test/script/platform    | 16 +++++++-------
 mps/test/test/testlib/arg.h      |  1 +
 mps/test/test/testlib/lofmt.c    |  2 +-
 mps/test/test/testlib/lofmt.h    |  2 +-
 mps/test/test/testlib/platform.c |  4 ++--
 mps/test/test/testlib/platform.h |  6 +----
 16 files changed, 65 insertions(+), 30 deletions(-)

diff --git a/mps/test/README b/mps/test/README
index 51bdc59a581..a0be0814742 100644
--- a/mps/test/README
+++ b/mps/test/README
@@ -43,3 +43,41 @@ From the test directory, build mpslib.a using the Xcode project::
     perl test/qa -i ../code -l ../code/xc/Debug/libmps.a run function/232.c
 
 etc.  See "Testing on Unix" above.
+
+
+Testing on Windows
+------------------
+
+In a Cygwin shell, from the test directory::
+
+    PLATFORM=w3i6mv # substitute your platform
+    VARIETY=cool # or hot
+    CODE=../code # code directory of the branch you are testing
+    pushd $CODE
+    nmake /f $PLATFORM.nmk VARIETY=$VARIETY $PLATFORM/$VARIETY/mps.obj
+    popd
+    export LANG=C # avoid locale warnings from Perl.
+    alias qa="perl test/qa -i $CODE -l $CODE/$PLATFORM/$VARIETY/mps.obj"
+    qa clib
+    qa run function/5.c
+    qa runset testsets/passing
+
+The runset command can result in this error::
+
+    LINK : fatal error LNK1168: cannot open test/obj/nt_AMD64__pc/tmp_test.exe for writing
+
+You may be able to avoid this by running "View Local Services" from
+the Windows Control Panel, double-clicking the "Application
+Experience" service, and switching "Startup type" to "Automatic". See
+the documentation for LNK1168_.
+
+.. _LNK1168: https://msdn.microsoft.com/en-us/library/hhbdtt6d.aspx
+
+At present, the easiest way to debug a test case is to edit
+test/test/script/platform and set::
+
+    $comwrap = "vsjitdebugger \"";
+
+But see job004020_.
+
+.. _job004020: https://www.ravenbrook.com/project/mps/issue/job004020/
diff --git a/mps/test/argerr/153.c b/mps/test/argerr/153.c
index b6d1d6791fa..095a855d1cc 100644
--- a/mps/test/argerr/153.c
+++ b/mps/test/argerr/153.c
@@ -23,7 +23,7 @@ static void test(void) {
  cdie(mps_pool_create(&pool, arena, mps_class_mv(),
   1024*32, 1024*16, 1024*256), "pool");
 
- cdie(mps_alloc(&q, pool, (size_t) -100 * mmqaArenaSIZE), "alloc");
+ cdie(mps_alloc(&q, pool, ((size_t)-1) - 100 * mmqaArenaSIZE), "alloc");
 
  mps_pool_destroy(pool);
  mps_arena_destroy(arena);
diff --git a/mps/test/conerr/13.c b/mps/test/conerr/13.c
index b3712a99e44..b05fe424aa1 100644
--- a/mps/test/conerr/13.c
+++ b/mps/test/conerr/13.c
@@ -28,7 +28,7 @@ static void test(void)
 
 /* cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
 */
- arena=malloc(64);
+ arena=malloc(4096);
 
  cdie(
   mps_pool_create(&pool, arena, mps_class_mv(),
diff --git a/mps/test/conerr/18.c b/mps/test/conerr/18.c
index 4d13dede9b9..d6ea9e923b5 100644
--- a/mps/test/conerr/18.c
+++ b/mps/test/conerr/18.c
@@ -6,8 +6,8 @@ TEST_HEADER
  link = testlib.o
 OUTPUT_SPEC
  assert = true
- assertfile P= poollo.c
- assertcond = FormatArena(pool->format) == arena
+ assertfile P= poolabs.c
+ assertcond = FormatArena(format) == arena
 END_HEADER
 */
 
diff --git a/mps/test/conerr/2.c b/mps/test/conerr/2.c
index 78738d5bc85..ba18c963be0 100644
--- a/mps/test/conerr/2.c
+++ b/mps/test/conerr/2.c
@@ -17,7 +17,7 @@ static void test(void)
 {
  mps_arena_t arena;
 
- arena = malloc(64);
+ arena = malloc(4096);
  mps_arena_destroy(arena);
  comment("Destroy arena.");
 }
diff --git a/mps/test/conerr/25.c b/mps/test/conerr/25.c
index 35e4c5c03c7..c4cfc508eea 100644
--- a/mps/test/conerr/25.c
+++ b/mps/test/conerr/25.c
@@ -30,13 +30,13 @@ static void test(void)
 
  cdie(mps_ap_create(&ap, pool), "create ap");
 
- cdie(mps_reserve(&obj, ap, 152), "reserve");
- (void)mps_commit(ap, &obj, 152);
+ cdie(mps_reserve(&obj, ap, 256), "reserve");
+ (void)mps_commit(ap, &obj, 256);
 
- mps_free(pool, obj, 152);
+ mps_free(pool, obj, 256);
  comment("Freed.");
 
- mps_free(pool, obj, 152);
+ mps_free(pool, obj, 256);
  comment("Freed again.");
 
  mps_pool_destroy(pool);
diff --git a/mps/test/conerr/53.c b/mps/test/conerr/53.c
index d156e3d7f05..ac072dfda0d 100644
--- a/mps/test/conerr/53.c
+++ b/mps/test/conerr/53.c
@@ -7,7 +7,7 @@ TEST_HEADER
 OUTPUT_SPEC
  assert = true
  assertfile P= ld.c
- assertcond = ld->_epoch <= arena->epoch
+ assertcond = ld->_epoch <= ArenaHistory(arena)->epoch
 END_HEADER
 */
 
diff --git a/mps/test/conerr/54.c b/mps/test/conerr/54.c
index f5474c6e318..3439f22cb71 100644
--- a/mps/test/conerr/54.c
+++ b/mps/test/conerr/54.c
@@ -7,7 +7,7 @@ TEST_HEADER
 OUTPUT_SPEC
  assert = true
  assertfile P= ld.c
- assertcond = ld->_epoch <= arena->epoch
+ assertcond = ld->_epoch <= history->epoch
 END_HEADER
 */
 
diff --git a/mps/test/conerr/8.c b/mps/test/conerr/8.c
index ba37375ea93..63bfc1577e7 100644
--- a/mps/test/conerr/8.c
+++ b/mps/test/conerr/8.c
@@ -19,7 +19,7 @@ static void test(void)
  mps_arena_t arena;
  mps_fmt_t format;
 
- arena=malloc(64);
+ arena=malloc(4096);
 
  cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format");
 
diff --git a/mps/test/test/script/headread b/mps/test/test/script/headread
index 794027763b2..99c1d0f1359 100644
--- a/mps/test/test/script/headread
+++ b/mps/test/test/script/headread
@@ -149,7 +149,7 @@ sub read_results {
   &debug($_);
   if (/^!/) {
 # result variable
-   if  (/^!(\w+)\s*=\s*(.+)\s*/) {
+   if  (/^!(\w+)\s*=\s*(.+?)\s*$/) {
     $real_output{$1} = $2
    } else {
     die "Badly formatted result line in output:\n$_\n";
diff --git a/mps/test/test/script/platform b/mps/test/test/script/platform
index 88b3320db76..9dba51fdef7 100644
--- a/mps/test/test/script/platform
+++ b/mps/test/test/script/platform
@@ -46,12 +46,12 @@ sub platform_settings {
 
 
 sub settings_nt {
- $dirsep = "\\";
+ $dirsep = "/";
  $cc_command = "cl";
 # following line used to include /DMMQA_VERS_$MPS_INTERFACE_VERSION
- $cc_opts = "/nologo /DWIN32 /D_WINDOWS /W3 /Zi /Oy- /MD /DMMQA_PROD_$MPS_PRODUCT";
+ $cc_opts = "/nologo /DWIN32 /D_WINDOWS /D_CRT_SECURE_NO_WARNINGS /W3 /Zi /Oy- /MD /DMMQA_PROD_$MPS_PRODUCT";
  $cc_link = "$obj_dir/platform.obj";
- $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debugtype:both /pdb:none /debug:full";
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug";
  $cc_include = "/I$testlib_dir /I$MPS_INCLUDE_DIR /I$obj_dir";
  $cc_def = "/D";
  $cc_defeq = "=";
@@ -62,16 +62,16 @@ sub settings_nt {
  $cc_objandexe = 1;
  $obj_suffix = ".obj";
  $try_command = "";
- $catcommand = "$script_dir/ntx86bin/cat.exe";
+ $catcommand = "cat";
  $comwrap = "\"";
  $comwrapend = "\"";
  $stdout_red = ">";
- $stdout_dup = "| $script_dir/ntx86bin/tee.exe";
+ $stdout_dup = "| tee";
  $stdin_red = "<";
  $stdboth_red = ">%s 2>&1";
  $quotestring = \&nt_quotestring;
  $platmailfile = \&nt_mailfile;
- $stringscommand = "$script_dir/ntx86bin/strings.exe -20 -c";
+ $stringscommand = "strings";
  $preprocommand = "$cc_command /nologo $cc_preonly";
  $exesuff = ".exe";
  %ignored_headers = ();
@@ -80,11 +80,11 @@ sub settings_nt {
 sub settings_nt_cap {
  $cc_opts = "$cc_opts /Gh";
  $cc_link = "$cc_link CAP.lib";
- $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug:full /debugtype:both /pdb:none";
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug";
 }
 
 sub settings_nt_coff {
- $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debugtype:coff /debug:full";
+ $cc_link_opts = "/link /NODEFAULTLIB:LIBCMT /NODEFAULTLIB:LIBCMTD /NODEFAULTLIB:LIBC /NODEFAULTLIB:LIBCD /NODEFAULTLIB:MSVCRTD /DEFAULTLIB:MSVCRT /debug";
 }
 
 
diff --git a/mps/test/test/testlib/arg.h b/mps/test/test/testlib/arg.h
index 95fa4996f3f..f2f07b81501 100644
--- a/mps/test/test/testlib/arg.h
+++ b/mps/test/test/testlib/arg.h
@@ -8,6 +8,7 @@ arg.h
 
 #include "testlib.h"
 
+#undef UNALIGNED
 #define UNALIGNED ((mps_addr_t) (((char *) NULL) + 1))
 
 #define MPS_RANK_MIN 0
diff --git a/mps/test/test/testlib/lofmt.c b/mps/test/test/testlib/lofmt.c
index 51697c00bdf..35567c8f314 100644
--- a/mps/test/test/testlib/lofmt.c
+++ b/mps/test/test/testlib/lofmt.c
@@ -186,7 +186,7 @@ long int getlocopycount(locell *obj)
  return obj->data.copycount;
 }
 
-long int getlosize(locell *obj)
+size_t getlosize(locell *obj)
 {
  asserts(obj->tag == LOdata, "getlosize: non-data object.");
  return obj->data.size - offsetof(struct lodata, data);
diff --git a/mps/test/test/testlib/lofmt.h b/mps/test/test/testlib/lofmt.h
index 14b9ce2a2c5..e8e2c17d02d 100644
--- a/mps/test/test/testlib/lofmt.h
+++ b/mps/test/test/testlib/lofmt.h
@@ -56,7 +56,7 @@ locell *alloclo(mps_ap_t ap, size_t bytes);
 
 long int getloid(locell *obj);
 long int getlocopycount(locell *obj);
-long int getlosize(locell *obj);
+size_t getlosize(locell *obj);
 
 #endif
 
diff --git a/mps/test/test/testlib/platform.c b/mps/test/test/testlib/platform.c
index 23ffd36f234..83badbf2759 100644
--- a/mps/test/test/testlib/platform.c
+++ b/mps/test/test/testlib/platform.c
@@ -8,8 +8,7 @@
 
 LONG mySEHFilter(LPEXCEPTION_POINTERS info) {
  LPEXCEPTION_RECORD er;
- int write;
- unsigned long address;
+ ULONG_PTR write, address;
 
  er = info->ExceptionRecord;
 
@@ -23,6 +22,7 @@ LONG mySEHFilter(LPEXCEPTION_POINTERS info) {
    report("memoryop", "read");
   }
   report("memoryaddr", "%ld", address);
+  report("abort", "true");
   myabort();
  }
 
diff --git a/mps/test/test/testlib/platform.h b/mps/test/test/testlib/platform.h
index c10eb1b103d..86224174957 100644
--- a/mps/test/test/testlib/platform.h
+++ b/mps/test/test/testlib/platform.h
@@ -4,12 +4,8 @@
 */
 
 #ifdef MPS_OS_W3
-#ifdef MMQA_HEADER_mpsw3
-/* we may be required to include mpsw3.h on windows platforms */
-#include "mpsw3.h"
-#endif
+#include "mpswin.h"
 /* to trap access violations in the test harness */
 LONG mySEHFilter(LPEXCEPTION_POINTERS);
 #endif
 
-

From 7e0675d595de2a96bb39a343803367c979880acb Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 22 Apr 2016 15:44:58 +0100
Subject: [PATCH 02/31] Fix mmqa function test cases so that they run on
 windows. in detail:

1. On w3i6mv, int and long are 32 bits, so these types can't be used to hold a size_t or an mps_word_t. See 26.c, 38.c, 47.c, 66.c, 123.c, 136.c, 164.c, 165.c, 200.c, 203.c, 204.c, 205.c, 206.c, 207.c, 215.c, 223.c.
2. The Windows command line doesn't cope with parentheses. See 170.c.
3. The natural platform alignment is 16 bytes on w3i6mv, so allocations into pools using the default alignment need to be rounded up. See 21.c, 22.c, 203.c, 204.c, 205.c.
4. Microsoft Visual C/C++ is fussy about signed/unsigned comparison. See 226.c.
5. windows.h defines a SIZE macro so you can't use it as a parameter. See 232.c.

Copied from Perforce
 Change: 191569
 ServerID: perforce.ravenbrook.com
---
 mps/test/function/123.c |  2 +-
 mps/test/function/136.c |  2 +-
 mps/test/function/140.c | 12 ++++++------
 mps/test/function/164.c | 12 ++++++------
 mps/test/function/165.c |  2 +-
 mps/test/function/167.c |  2 +-
 mps/test/function/170.c |  2 +-
 mps/test/function/200.c | 12 ++++++------
 mps/test/function/203.c | 14 +++++++-------
 mps/test/function/204.c | 14 +++++++-------
 mps/test/function/205.c | 14 +++++++-------
 mps/test/function/206.c | 14 +++++++-------
 mps/test/function/207.c | 12 ++++++------
 mps/test/function/21.c  |  4 ++--
 mps/test/function/215.c |  2 +-
 mps/test/function/22.c  |  4 ++--
 mps/test/function/223.c |  2 +-
 mps/test/function/226.c |  2 +-
 mps/test/function/232.c | 10 +++++-----
 mps/test/function/26.c  |  3 ++-
 mps/test/function/38.c  |  3 ++-
 mps/test/function/47.c  |  3 ++-
 mps/test/function/66.c  |  3 ++-
 23 files changed, 77 insertions(+), 73 deletions(-)

diff --git a/mps/test/function/123.c b/mps/test/function/123.c
index 4166f30f685..0e354e29bed 100644
--- a/mps/test/function/123.c
+++ b/mps/test/function/123.c
@@ -35,7 +35,7 @@ static void test(void)
  mps_fmt_t format;
  mps_ap_t apamc, apawl;
 
- unsigned int i, c;
+ mps_word_t i, c;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (60ul*1024*1024)), "create arena");
 
diff --git a/mps/test/function/136.c b/mps/test/function/136.c
index b76a2fcf59a..f333a206f4d 100644
--- a/mps/test/function/136.c
+++ b/mps/test/function/136.c
@@ -55,7 +55,7 @@ static void do_test(size_t extendBy, size_t avgSize, size_t align,
   mps_addr_t p;
   unsigned int i;
   unsigned long nLargeObjects = 0, nSmallObjects = 0;
-  unsigned long largeObjectSize, smallObjectSize;
+  size_t largeObjectSize, smallObjectSize;
 
   largeObjectSize = extendBy;
   smallObjectSize = align;
diff --git a/mps/test/function/140.c b/mps/test/function/140.c
index 7502386c7f1..ae442893a12 100644
--- a/mps/test/function/140.c
+++ b/mps/test/function/140.c
@@ -61,7 +61,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 
 static void dt(int kind,
    size_t extendBy, size_t avgSize, size_t align,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  int i, hd;
@@ -114,11 +114,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %p (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)",
+      "corrupt at %p (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
       slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     commentif(comments, "Free %i at %x, size %x", hd,
      queue[hd].addr, queue[hd].size);
     mps_free(pool, queue[hd].addr, queue[hd].size);
@@ -147,16 +147,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
   slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  int symm;
  size_t comlimit;
 
diff --git a/mps/test/function/164.c b/mps/test/function/164.c
index aece86397f2..368bbffd86e 100644
--- a/mps/test/function/164.c
+++ b/mps/test/function/164.c
@@ -58,7 +58,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 
 static void dt(int kind,
    size_t extendBy, size_t avgSize, size_t align,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  int i, hd;
@@ -107,11 +107,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
       slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     commentif(comments, "Free %i at %x, size %x", hd,
      queue[hd].addr, queue[hd].size);
     mps_free(pool, queue[hd].addr, queue[hd].size);
@@ -140,16 +140,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
   slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  int symm;
  size_t comlimit;
 
diff --git a/mps/test/function/165.c b/mps/test/function/165.c
index 5bd3bda7a44..167854851a0 100644
--- a/mps/test/function/165.c
+++ b/mps/test/function/165.c
@@ -30,7 +30,7 @@ static void test(void)
  mps_pool_t pool;
  mps_thr_t thread;
 
- unsigned long com0, com1, com2;
+ size_t com0, com1, com2;
 
 /* create a VM arena of 40MB with commit limit of 100MB, i.e. let the
    arena do the limiting. */
diff --git a/mps/test/function/167.c b/mps/test/function/167.c
index c8858668099..fa17c120fb7 100644
--- a/mps/test/function/167.c
+++ b/mps/test/function/167.c
@@ -30,7 +30,7 @@ static void test(void)
  mps_pool_t poolhi, poollo;
  mps_thr_t thread;
 
- unsigned long com0, com1;
+ size_t com0, com1;
 
 /* create a VM arena of 40MB */
 
diff --git a/mps/test/function/170.c b/mps/test/function/170.c
index 28eb7028be7..85a6a89852c 100644
--- a/mps/test/function/170.c
+++ b/mps/test/function/170.c
@@ -5,7 +5,7 @@ TEST_HEADER
  language = c
  link = testlib.o rankfmt.o
  harness = 2.1
- parameters = EXTEND=65536 AVGSIZE=32 BIGSIZE=(5*1024*1024);
+ parameters = EXTEND=65536 AVGSIZE=32 BIGSIZE=5*1024*1024
 OUTPUT_SPEC
  completed = yes
  failed = no
diff --git a/mps/test/function/200.c b/mps/test/function/200.c
index 90e5494da92..4000d9e4185 100644
--- a/mps/test/function/200.c
+++ b/mps/test/function/200.c
@@ -57,7 +57,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 
 static void dt(int kind,
    size_t extendBy, size_t avgSize, size_t maxSize,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  int i, hd;
@@ -101,10 +101,10 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) extendBy, (int) avgSize, (int) maxSize,
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     mps_free(pool, queue[hd].addr, queue[hd].size);
    }
    size = ranrange(mins, maxs);
@@ -126,15 +126,15 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) extendBy, (int) avgSize, (int) maxSize,
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*50)), "create arena");
  cdie(mps_thread_reg(&thread, arena), "register thread");
diff --git a/mps/test/function/203.c b/mps/test/function/203.c
index 479ab25cbda..360f6ffd8be 100644
--- a/mps/test/function/203.c
+++ b/mps/test/function/203.c
@@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val)
 static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) {
  mps_res_t res;
 
- size = ((size+7)/8)*8;
+ size = (size + MPS_PF_ALIGN - 1) & ~(MPS_PF_ALIGN - 1);
 
  do {
   MPS_RESERVE_BLOCK(res, *ref, ap, size);
@@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 static void dt(int kind,
    size_t minSize, size_t avgSize, size_t maxSize,
    mps_word_t depth, mps_word_t fragLimit,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  mps_ap_t ap;
@@ -118,11 +118,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
       (int) depth, (int) fragLimit,
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     mps_free(pool, queue[hd].addr, queue[hd].size);
    }
    size = ranrange(mins, maxs);
@@ -145,16 +145,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
   (int) depth, (int) fragLimit,
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  mps_word_t dep, frag;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena");
diff --git a/mps/test/function/204.c b/mps/test/function/204.c
index 52af542c913..73d087c0adf 100644
--- a/mps/test/function/204.c
+++ b/mps/test/function/204.c
@@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val)
 static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) {
  mps_res_t res;
 
- size = ((size+7)/8)*8;
+ size = (size + MPS_PF_ALIGN - 1) & ~ (MPS_PF_ALIGN - 1);
 
  do {
   MPS_RESERVE_BLOCK(res, *ref, ap, size);
@@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 static void dt(int kind,
    size_t minSize, size_t avgSize, size_t maxSize,
    mps_word_t depth, mps_word_t fragLimit,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  mps_ap_t ap;
@@ -118,11 +118,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
       (int) depth, (int) fragLimit,
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     mps_free(pool, queue[hd].addr, queue[hd].size);
    }
    size = ranrange(mins, maxs);
@@ -145,16 +145,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
   (int) depth, (int) fragLimit,
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  mps_word_t dep, frag;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena");
diff --git a/mps/test/function/205.c b/mps/test/function/205.c
index 16ff013c766..ff94d098ca2 100644
--- a/mps/test/function/205.c
+++ b/mps/test/function/205.c
@@ -42,7 +42,7 @@ static void setobj(mps_addr_t a, size_t size, unsigned char val)
 static mps_res_t mvt_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) {
  mps_res_t res;
 
- size = ((size+7)/8)*8;
+ size = (size + MPS_PF_ALIGN - 1) & ~ (MPS_PF_ALIGN - 1);
 
  do {
   MPS_RESERVE_BLOCK(res, *ref, ap, size);
@@ -71,7 +71,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 static void dt(int kind,
    size_t minSize, size_t avgSize, size_t maxSize,
    mps_word_t depth, mps_word_t fragLimit,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  mps_ap_t ap;
@@ -118,11 +118,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %i, %i, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %i, %i, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
       (int) depth, (int) fragLimit,
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     mps_free(pool, queue[hd].addr, queue[hd].size);
    }
    size = ranrange(mins, maxs);
@@ -145,16 +145,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %i, %i, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %i, %i, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) minSize, (int) avgSize, (int) maxSize,
   (int) depth, (int) fragLimit,
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  mps_word_t dep, frag;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*100)), "create arena");
diff --git a/mps/test/function/206.c b/mps/test/function/206.c
index 64d5517944d..f9a40cf7f1d 100644
--- a/mps/test/function/206.c
+++ b/mps/test/function/206.c
@@ -59,7 +59,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 
 static void dt(int kind,
    size_t extendBy, size_t avgSize, size_t align,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  int i, hd;
@@ -103,11 +103,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %p (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)",
+      "corrupt at %p (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
       slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     mps_free(pool, queue[hd].addr, queue[hd].size);
    }
    size = ranrange(mins, maxs);
@@ -129,18 +129,18 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
   slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t extendBy, avgSize, maxSize;
+ size_t avgSize;
  size_t align = sizeof(void*);
- size_t minSize = sizeof(int);
+ unsigned long extendBy, minSize = sizeof(int), maxSize;
  int i, j, kind;
 
  cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*50)), "create arena");
diff --git a/mps/test/function/207.c b/mps/test/function/207.c
index 6d73d87d4bd..c68ac5757af 100644
--- a/mps/test/function/207.c
+++ b/mps/test/function/207.c
@@ -58,7 +58,7 @@ static int chkobj(mps_addr_t a, size_t size, unsigned char val)
 
 static void dt(int kind,
    size_t extendBy, size_t avgSize, size_t align,
-   size_t mins, size_t maxs, int number, int iter)
+   unsigned long mins, unsigned long maxs, int number, int iter)
 {
  mps_pool_t pool;
  int i, hd;
@@ -107,11 +107,11 @@ static void dt(int kind,
    if (queue[hd].addr != NULL)
    {
     asserts(chkobj(queue[hd].addr, queue[hd].size, (unsigned char) (hd%256)),
-      "corrupt at %x (%s: %x, %x, %x, %c%c%c, %x, %x, %i, %i)",
+      "corrupt at %x (%s: %x, %x, %x, %c%c%c, %lx, %lx, %i, %i)",
       queue[hd].addr,
       tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
       slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-      (int) mins, (int) maxs, number, iter);
+      mins, maxs, number, iter);
     commentif(comments, "Free %i at %x, size %x", hd,
      queue[hd].addr, queue[hd].size);
     mps_free(pool, queue[hd].addr, queue[hd].size);
@@ -140,16 +140,16 @@ static void dt(int kind,
  time1=clock();
  secs=(time1-time0)/(double)CLOCKS_PER_SEC;
 
- comment("%s test (%x, %x, %x, %c%c%c, %x, %x, %i, %i) in %.2f s",
+ comment("%s test (%x, %x, %x, %c%c%c, %lx, %lx, %i, %i) in %.2f s",
   tdesc[kind], (int) extendBy, (int) avgSize, (int) align,
   slotHigh ? 'S' : 's', arenaHigh ? 'A' : 'a', firstFit ? 'F' : 'f',
-  (int) mins, (int) maxs, number, iter, secs);
+  mins, maxs, number, iter, secs);
 }
 
 static void test(void)
 {
  mps_thr_t thread;
- size_t mins;
+ unsigned long mins;
  int symm;
  size_t comlimit;
 
diff --git a/mps/test/function/21.c b/mps/test/function/21.c
index 7b493f6602f..7992000899a 100644
--- a/mps/test/function/21.c
+++ b/mps/test/function/21.c
@@ -24,8 +24,8 @@ static void test(void) {
 
  for (p=0; p<2000; p++) {
   die(mps_alloc(&q, pool, 1024*1024), "alloc");
-  q = (mps_addr_t) ((char *) q + 8);
-  mps_free(pool, q, 256*1024-8);
+  q = (mps_addr_t) ((char *) q + MPS_PF_ALIGN);
+  mps_free(pool, q, 256*1024-MPS_PF_ALIGN);
   report("promise", "%i", p);
  }
 }
diff --git a/mps/test/function/215.c b/mps/test/function/215.c
index ab3862f9a5f..48e7148e029 100644
--- a/mps/test/function/215.c
+++ b/mps/test/function/215.c
@@ -138,7 +138,7 @@ static void test(void) {
    }
   }
   if(mps_message_get(&message, arena, mps_message_type_gc())) {
-    unsigned long live, condemned, notCondemned;
+    size_t live, condemned, notCondemned;
     live = mps_message_gc_live_size(arena, message);
     condemned = mps_message_gc_condemned_size(arena, message);
     notCondemned = 
diff --git a/mps/test/function/22.c b/mps/test/function/22.c
index 8927643e49f..4959b7a88f1 100644
--- a/mps/test/function/22.c
+++ b/mps/test/function/22.c
@@ -27,8 +27,8 @@ static void test(void) {
  for (p=0; p<2000; p++) {
   report("promise", "%i", p);
   die(mps_alloc(&r, pool, 1024*1024), "alloc");
-  mps_free(pool, q, 256*1024-8);
-  q = (mps_addr_t) ((char *) r + 8);
+  mps_free(pool, q, 256*1024-MPS_PF_ALIGN);
+  q = (mps_addr_t) ((char *) r + MPS_PF_ALIGN);
  }
 }
 
diff --git a/mps/test/function/223.c b/mps/test/function/223.c
index 6fb7a4357fa..75e14915728 100644
--- a/mps/test/function/223.c
+++ b/mps/test/function/223.c
@@ -138,7 +138,7 @@ static void test(void) {
    }
   }
   if(mps_message_get(&message, arena, mps_message_type_gc())) {
-    unsigned long live, condemned, notCondemned;
+    size_t live, condemned, notCondemned;
     live = mps_message_gc_live_size(arena, message);
     condemned = mps_message_gc_condemned_size(arena, message);
     notCondemned = mps_message_gc_not_condemned_size(arena, message);
diff --git a/mps/test/function/226.c b/mps/test/function/226.c
index ea6607498a2..2295ab34f1c 100644
--- a/mps/test/function/226.c
+++ b/mps/test/function/226.c
@@ -58,7 +58,7 @@ static void mergelds(int merge) {
  }
 }
 
-static void blat(mps_ap_t apamc, int percent) {
+static void blat(mps_ap_t apamc, unsigned percent) {
  int i;
  for (i=0; i < MAXLDS; i++) {
   if (ranint(100) < percent) {
diff --git a/mps/test/function/232.c b/mps/test/function/232.c
index 09c7359b6e2..ff16289fc1b 100644
--- a/mps/test/function/232.c
+++ b/mps/test/function/232.c
@@ -1,10 +1,10 @@
 /* 
 TEST_HEADER
- id = $Id: //info.ravenbrook.com/project/mps/branch/2015-08-11/compact/test/function/229.c#1 $
+ id = $Id$
  summary = test arena extension and compaction
  language = c
  link = testlib.o
- parameters = SIZE=1024*1024 ITERATIONS=100
+ parameters = CHUNKSIZE=1024*1024 ITERATIONS=100
 END_HEADER
 */
 
@@ -26,7 +26,7 @@ static void test(void)
   unsigned i;
 
   MPS_ARGS_BEGIN(args) {
-    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, SIZE);
+    MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, CHUNKSIZE);
     die(mps_arena_create_k(&arena, mps_arena_class_vm(), args), "arena_create");
   } MPS_ARGS_END(args);
 
@@ -37,12 +37,12 @@ static void test(void)
   check_chunks(arena, 1);
 
   for (i = 0; i < ITERATIONS; ++i) {
-    die(mps_alloc(&block[i], pool, SIZE), "mps_alloc");
+    die(mps_alloc(&block[i], pool, CHUNKSIZE), "mps_alloc");
     check_chunks(arena, i + 2);
   }
 
   for (i = ITERATIONS; i > 0; --i) {
-    mps_free(pool, block[i - 1], SIZE);
+    mps_free(pool, block[i - 1], CHUNKSIZE);
     mps_arena_collect(arena); /* ensure ArenaCompact is called */
     check_chunks(arena, i);
   }
diff --git a/mps/test/function/26.c b/mps/test/function/26.c
index fc738f90733..1c0f840e18f 100644
--- a/mps/test/function/26.c
+++ b/mps/test/function/26.c
@@ -20,7 +20,8 @@ static mps_res_t trysize(size_t try) {
  mps_res_t res;
 
  die(mps_pool_create(&pool, arena, mps_class_mv(),
-  1024*32, 1024*16, 1024*256), "pool");
+                     (size_t)(1024*32), (size_t)(1024*16), (size_t)(1024*256)),
+     "pool_create");
 
  comment("Trying %x", try);
 
diff --git a/mps/test/function/38.c b/mps/test/function/38.c
index e3512864442..9effe17ddf2 100644
--- a/mps/test/function/38.c
+++ b/mps/test/function/38.c
@@ -91,7 +91,8 @@ static void test(void)
  cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
       "create awl pool");
 
- cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000),
+ cdie(mps_pool_create(&poolmv, arena, mps_class_mv(),
+                      (size_t)0x4000, (size_t)128, (size_t)0x4000),
       "create mv pool");
 
  cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()),
diff --git a/mps/test/function/47.c b/mps/test/function/47.c
index ee7c5605c2e..964de168c02 100644
--- a/mps/test/function/47.c
+++ b/mps/test/function/47.c
@@ -54,7 +54,8 @@ static void test(void) {
  cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
       "create awl pool");
 
- cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000),
+ cdie(mps_pool_create(&poolmv, arena, mps_class_mv(),
+                      (size_t)0x4000, (size_t)128, (size_t)0x4000),
       "create mv pool");
 
  cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()),
diff --git a/mps/test/function/66.c b/mps/test/function/66.c
index d395dbb3637..678fefe7e02 100644
--- a/mps/test/function/66.c
+++ b/mps/test/function/66.c
@@ -90,7 +90,8 @@ static void test(void) {
   "create awl pool");
 
  cdie(
-  mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000),
+  mps_pool_create(&poolmv, arena, mps_class_mv(),
+                  (size_t)0x4000, (size_t)128, (size_t)0x4000),
   "create mv pool");
 
  cdie(

From 10f07e4e0bc8d2722819aa471f03ae9f08afb738 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 22 Apr 2016 17:04:50 +0100
Subject: [PATCH 03/31] The computed chunk size is the smallest size with a
 given number of usable bytes -- the actual chunk may be one grain larger.

Copied from Perforce
 Change: 191574
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenavm.c | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index e6b53931b49..9467e104bc2 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -502,6 +502,7 @@ static Res vmArenaChunkSize(Size *chunkSizeReturn, VMArena vmArena, Size size)
   overhead = 0;
   do {
     chunkSize = size + overhead;
+    AVER(SizeIsAligned(chunkSize, grainSize));
 
     /* See .overhead.chunk-struct. */
     overhead = SizeAlignUp(sizeof(VMChunkStruct), MPS_PF_ALIGN);
@@ -632,15 +633,18 @@ static Res VMArenaCreate(Arena *arenaReturn, ArgList args)
     goto failChunkCreate;
 
 #if defined(AVER_AND_CHECK_ALL)
-  /* Check that the computation of the chunk size in vmArenaChunkSize
-   * was correct, now that we have the actual chunk for comparison. */
+  /* Check the computation of the chunk size in vmArenaChunkSize, now
+   * that we have the actual chunk for comparison. Note that
+   * vmArenaChunkSize computes the smallest size with a given number
+   * of usable bytes -- the actual chunk may be one grain larger. */
   {
     Size usableSize, computedChunkSize;
     usableSize = AddrOffset(PageIndexBase(chunk, chunk->allocBase),
                             chunk->limit);
     res = vmArenaChunkSize(&computedChunkSize, vmArena, usableSize);
     AVER(res == ResOK);
-    AVER(computedChunkSize == ChunkSize(chunk));
+    AVER(computedChunkSize == ChunkSize(chunk)
+         || computedChunkSize + grainSize == ChunkSize(chunk));
   }
 #endif
 

From 77882461aff5948a8bdccd6dbec91571ae5a64ce Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 22 Apr 2016 17:17:53 +0100
Subject: [PATCH 04/31] Memoryerror is only implemented on windows, so test for
 abort instead.

Copied from Perforce
 Change: 191575
 ServerID: perforce.ravenbrook.com
---
 mps/test/misc/1.c | 2 +-
 mps/test/misc/2.c | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/mps/test/misc/1.c b/mps/test/misc/1.c
index cf955c68cec..a8477ca1f62 100644
--- a/mps/test/misc/1.c
+++ b/mps/test/misc/1.c
@@ -5,7 +5,7 @@ TEST_HEADER
  language = c
  link = testlib.o
 OUTPUT_SPEC
- memoryerror = true
+ abort = true
 END_HEADER
 */
 
diff --git a/mps/test/misc/2.c b/mps/test/misc/2.c
index a6ff666788b..7686fa9fb24 100644
--- a/mps/test/misc/2.c
+++ b/mps/test/misc/2.c
@@ -6,7 +6,7 @@ TEST_HEADER
  link = testlib.o
  parameters = NUM=1
 OUTPUT_SPEC
- memoryerror = true
+ abort = true
 END_HEADER
 */
 

From a8e91f0ac81813f0ca5037ed1f7abde2d99f92d8 Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Sat, 23 Apr 2016 00:22:46 +0100
Subject: [PATCH 05/31] Turning pool describe methods the right way in, so that
 they call next-method.

Copied from Perforce
 Change: 191587
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h      |  2 +-
 mps/code/pool.c     | 46 +-----------------------------------------
 mps/code/poolabs.c  | 44 +++++++++++++++++++++++++++++++++-------
 mps/code/poolamc.c  | 19 ++++++------------
 mps/code/poolams.c  | 27 ++++++++++---------------
 mps/code/poolmfs.c  | 22 ++++++++++----------
 mps/code/poolmrg.c  | 20 +++++++++++-------
 mps/code/poolmv.c   | 28 ++++++++++++++------------
 mps/code/poolmv2.c  | 49 ++++++++++++++++++++++-----------------------
 mps/code/poolmvff.c | 33 ++++++++++++++----------------
 10 files changed, 134 insertions(+), 156 deletions(-)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 1dc05e95177..9bc8b4b59cb 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -251,7 +251,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, Count depth);
+extern Res PoolAbsDescribe(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,
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 43cb1fbe342..bb1a6f34f74 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -490,51 +490,7 @@ Size PoolFreeSize(Pool pool)
 
 Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
-  Res res;
-  Ring node, nextNode;
-  PoolClass klass;
-
-  if (!TESTC(AbstractPool, pool))
-    return ResPARAM;
-  if (stream == NULL)
-    return ResPARAM;
-
-  klass = ClassOfPoly(Pool, pool);
- 
-  res = WriteF(stream, depth,
-               "Pool $P ($U) {\n", (WriteFP)pool, (WriteFU)pool->serial,
-               "  class $P (\"$S\")\n",
-               (WriteFP)klass, (WriteFS)ClassName(klass),
-               "  arena $P ($U)\n",
-               (WriteFP)pool->arena, (WriteFU)pool->arena->serial,
-               "  alignment $W\n", (WriteFW)pool->alignment,
-               NULL);
-  if (res != ResOK)
-    return res;
-  if (NULL != pool->format) {
-    res = FormatDescribe(pool->format, stream, depth + 2);
-    if (res != ResOK)
-      return res;
-  }
-
-  res = Method(Pool, pool, 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, depth + 2);
-    if (res != ResOK)
-      return res;
-  }
-
-  res = WriteF(stream, depth,
-               "} Pool $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial,
-               NULL);
-  if (res != ResOK)
-    return res;
-
-  return ResOK;
+  return Method(Pool, pool, describe)(pool, stream, depth);
 }
 
 
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 8f1f1831d62..e7fc6d3c01b 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -211,7 +211,7 @@ DEFINE_CLASS(Pool, AbstractPool, klass)
   klass->walk = PoolNoWalk;
   klass->freewalk = PoolTrivFreeWalk;
   klass->bufferClass = PoolNoBufferClass;
-  klass->describe = PoolTrivDescribe;
+  klass->describe = PoolAbsDescribe;
   klass->debugMixin = PoolNoDebugMixin;
   klass->totalSize = PoolNoSize;
   klass->freeSize = PoolNoSize;
@@ -353,13 +353,43 @@ void PoolTrivBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
 }
 
 
-Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
+Res PoolAbsDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
-  AVERT(Pool, pool);
-  AVER(stream != NULL);
-  return WriteF(stream, depth,
-                "No class-specific description available.\n",
-                NULL);
+  Res res;
+  Ring node, nextNode;
+
+  if (!TESTC(AbstractPool, pool))
+    return ResPARAM;
+  if (stream == NULL)
+    return ResPARAM;
+
+  res = InstDescribe(CouldBeA(Inst, pool), stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
+               "serial $U\n", (WriteFU)pool->serial,
+               "arena $P ($U)\n",
+               (WriteFP)pool->arena, (WriteFU)pool->arena->serial,
+               "alignment $W\n", (WriteFW)pool->alignment,
+               NULL);
+  if (res != ResOK)
+    return res;
+
+  if (pool->format != NULL) {
+    res = FormatDescribe(pool->format, 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, depth + 2);
+    if (res != ResOK)
+      return res;
+  }
+
+  return ResOK;
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index bf83d5458e8..192c688881a 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -1969,6 +1969,7 @@ static Size AMCFreeSize(Pool pool)
  *
  * See <design/poolamc/#describe>.
  */
+
 static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
   Res res;
@@ -1976,17 +1977,13 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   Ring node, nextNode;
   const char *rampmode;
 
-  if(!TESTC(AMCZPool, amc))
+  if (!TESTC(AMCZPool, amc))
     return ResPARAM;
-  if(stream == NULL)
+  if (stream == NULL)
     return ResPARAM;
 
-  res = WriteF(stream, depth,
-               (amc->rankSet == RankSetEMPTY) ? "AMCZ" : "AMC",
-               " $P {\n", (WriteFP)amc, "  pool $P ($U)\n",
-               (WriteFP)pool, (WriteFU)pool->serial,
-               NULL);
-  if(res != ResOK)
+  res = NextMethod(Pool, AMCZPool, describe)(pool, stream, depth);
+  if (res != ResOK)
     return res;
 
   switch(amc->rampMode) {
@@ -2013,7 +2010,7 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
       return res;
   }
 
-  if(0) {
+  if (0) {
     /* SegDescribes */
     RING_FOR(node, &pool->segRing, nextNode) {
       Seg seg = RING_ELT(Seg, poolRing, node);
@@ -2023,10 +2020,6 @@ static Res AMCDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     }
   }
 
-  res = WriteF(stream, depth, "} AMC $P\n", (WriteFP)amc, NULL);
-  if(res != ResOK)
-    return res;
-
   return ResOK;
 }
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 2cb2a79bfe1..aa0e8bd4567 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -1699,25 +1699,24 @@ static Size AMSFreeSize(Pool pool)
  *
  * Iterates over the segments, describing all of them.
  */
+
 static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
-  AMS ams;
+  AMS ams = CouldBeA(AMSPool, pool);
   Ring node, nextNode;
   Res res;
 
-  if (!TESTT(Pool, pool))
-    return ResFAIL;
-  ams = PoolAMS(pool);
-  if (!TESTT(AMS, ams))
-    return ResFAIL;
+  if (!TESTC(AMSPool, ams))
+    return ResPARAM;
   if (stream == NULL)
-    return ResFAIL;
+    return ResPARAM;
 
-  res = WriteF(stream, depth,
-               "AMS $P {\n", (WriteFP)ams,
-               "  pool $P ($U)\n",
-               (WriteFP)pool, (WriteFU)pool->serial,
-               "  grain shift $U\n", (WriteFU)ams->grainShift,
+  res = NextMethod(Pool, AMSPool, describe)(pool, stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
+               "grain shift $U\n", (WriteFU)ams->grainShift,
                NULL);
   if (res != ResOK)
     return res;
@@ -1736,10 +1735,6 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
       return res;
   }
 
-  res = WriteF(stream, depth, "} AMS $P\n",(WriteFP)ams, NULL);
-  if (res != ResOK)
-    return res;
-
   return ResOK;
 }
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index 62b5d45e0b6..92627aaf4f8 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -316,20 +316,20 @@ static Res MFSDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResPARAM;
 
-  res = WriteF(stream, depth,
-               "unroundedUnitSize $W\n", (WriteFW)mfs->unroundedUnitSize,
-               "extendBy $W\n", (WriteFW)mfs->extendBy,
-               "extendSelf $S\n", WriteFYesNo(mfs->extendSelf),
-               "unitSize $W\n", (WriteFW)mfs->unitSize,
-               "freeList $P\n", (WriteFP)mfs->freeList,
-               "total $W\n", (WriteFW)mfs->total,
-               "free $W\n", (WriteFW)mfs->free,
-               "tractList $P\n", (WriteFP)mfs->tractList,
-               NULL);
+  res = NextMethod(Pool, MFSPool, describe)(pool, stream, depth);
   if (res != ResOK)
     return res;
 
-  return ResOK;
+  return WriteF(stream, depth + 2,
+                "unroundedUnitSize $W\n", (WriteFW)mfs->unroundedUnitSize,
+                "extendBy $W\n", (WriteFW)mfs->extendBy,
+                "extendSelf $S\n", WriteFYesNo(mfs->extendSelf),
+                "unitSize $W\n", (WriteFW)mfs->unitSize,
+                "freeList $P\n", (WriteFP)mfs->freeList,
+                "total $W\n", (WriteFW)mfs->total,
+                "free $W\n", (WriteFW)mfs->free,
+                "tractList $P\n", (WriteFP)mfs->tractList,
+                NULL);
 }
 
 
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index d2b66a1c20f..5eaa017bf97 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -770,6 +770,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, Count depth)
 {
   MRG mrg = CouldBeA(MRGPool, pool);
@@ -783,20 +784,25 @@ static Res MRGDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (stream == NULL)
     return ResPARAM;
 
+  res = NextMethod(Pool, MRGPool, describe)(pool, stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2, "extendBy $W\n", (WriteFW)mrg->extendBy, NULL);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2, "Entry queue:\n", NULL);
+  if (res != ResOK)
+    return res;
   arena = PoolArena(pool);
-  res = WriteF(stream, depth, "extendBy $W\n", (WriteFW)mrg->extendBy, NULL);
-  if (res != ResOK)
-    return res;
-  res = WriteF(stream, depth, "Entry queue:\n", NULL);
-  if (res != ResOK)
-    return res;
   RING_FOR(node, &mrg->entryRing, nextNode) {
     Bool outsideShield = !ArenaShield(arena)->inside;
     refPart = MRGRefPartOfLink(linkOfRing(node), arena);
     if (outsideShield) {
       ShieldEnter(arena);
     }
-    res = WriteF(stream, depth, "at $A Ref $A\n",
+    res = WriteF(stream, depth + 2, "at $A Ref $A\n",
                  (WriteFA)refPart, (WriteFA)MRGRefPartRef(arena, refPart),
                  NULL);
     if (outsideShield) {
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index e1d4a19fe27..821c8eea21f 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -754,23 +754,24 @@ static Size MVFreeSize(Pool pool)
 
 static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
+  MV mv = CouldBeA(MVPool, pool);
   Res res;
-  MV mv;
   MVSpan span;
   Align step;
   Size length;
   char c;
   Ring spans, node = NULL, nextNode; /* gcc whinge stop */
 
-  if (!TESTT(Pool, pool))
-    return ResFAIL;
-  mv = PoolMV(pool);
-  if (!TESTT(MV, mv))
-    return ResFAIL;
+  if (!TESTC(MVPool, mv))
+    return ResPARAM;
   if (stream == NULL)
-    return ResFAIL;
+    return ResPARAM;
 
-  res = WriteF(stream, depth,
+  res = NextMethod(Pool, MVPool, describe)(pool, stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
                "blockPool $P ($U)\n",
                (WriteFP)mvBlockPool(mv), (WriteFU)mvBlockPool(mv)->serial,
                "spanPool  $P ($U)\n",
@@ -781,7 +782,8 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
                "free      $W\n",  (WriteFP)mv->free,
                "lost      $W\n",  (WriteFP)mv->lost,
                NULL);
-  if(res != ResOK) return res;              
+  if(res != ResOK)
+    return res;
 
   step = pool->alignment;
   length = 0x40 * step;
@@ -791,11 +793,11 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     Addr i, j;
     MVBlock block;
     span = RING_ELT(MVSpan, spans, node);
-    res = WriteF(stream, depth, "MVSpan $P {\n", (WriteFP)span, NULL);
+    res = WriteF(stream, depth + 2, "MVSpan $P {\n", (WriteFP)span, NULL);
     if (res != ResOK)
       return res;
 
-    res = WriteF(stream, depth + 2,
+    res = WriteF(stream, depth + 4,
                  "span    $P\n", (WriteFP)span,
                  "tract   $P\n", (WriteFP)span->tract,
                  "free    $W\n", (WriteFW)span->free,
@@ -815,7 +817,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
     block = span->blocks;
 
     for(i = span->base.base; i < span->limit.limit; i = AddrAdd(i, length)) {
-      res = WriteF(stream, depth + 2, "$A ", (WriteFA)i, NULL);
+      res = WriteF(stream, depth + 4, "$A ", (WriteFA)i, NULL);
       if (res != ResOK)
         return res;
 
@@ -847,7 +849,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
       if (res != ResOK)
         return res;
     }
-    res = WriteF(stream, depth, "} MVSpan $P\n", (WriteFP)span, NULL);
+    res = WriteF(stream, depth + 2, "} MVSpan $P\n", (WriteFP)span, NULL);
     if (res != ResOK)
       return res;
   }
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index b11f6b65762..f563922588a 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -1025,34 +1025,34 @@ static Size MVTFreeSize(Pool pool)
 
 static Res MVTDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
+  MVT mvt = CouldBeA(MVTPool, pool);
   Res res;
-  MVT mvt;
 
-  if (!TESTT(Pool, pool))
-    return ResFAIL;
-  mvt = PoolMVT(pool);
-  if (!TESTT(MVT, mvt))
-    return ResFAIL;
+  if (!TESTC(MVTPool, mvt))
+    return ResPARAM;
   if (stream == NULL)
     return ResFAIL;
 
-  res = WriteF(stream, depth,
-               "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", WriteFYesNo(mvt->abqOverflow),
-               "  splinter: $S\n", WriteFYesNo(mvt->splinter),
-               "  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 = NextMethod(Pool, MVTPool, describe)(pool, stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
+               "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", WriteFYesNo(mvt->abqOverflow),
+               "splinter: $S\n", WriteFYesNo(mvt->splinter),
+               "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;
@@ -1103,8 +1103,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(stream, depth, "} MVT $P\n", (WriteFP)mvt, NULL);
-  return res;
+  return ResOK;
 }
 
 
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 5269f233a3e..dda5779eddc 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -673,26 +673,24 @@ static Size MVFFFreeSize(Pool pool)
 
 static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
 {
+  MVFF mvff = CouldBeA(MVFFPool, pool);
   Res res;
-  MVFF mvff;
 
-  if (!TESTT(Pool, pool))
-    return ResFAIL;
-  mvff = PoolMVFF(pool);
-  if (!TESTT(MVFF, mvff))
-    return ResFAIL;
+  if (!TESTC(MVFFPool, mvff))
+    return ResPARAM;
   if (stream == NULL)
-    return ResFAIL;
+    return ResPARAM;
 
-  res = WriteF(stream, depth,
-               "MVFF $P {\n", (WriteFP)mvff,
-               "  pool $P ($U)\n",
-               (WriteFP)pool, (WriteFU)pool->serial,
-               "  extendBy  $W\n",  (WriteFW)mvff->extendBy,
-               "  avgSize   $W\n",  (WriteFW)mvff->avgSize,
-               "  firstFit  $U\n",  (WriteFU)mvff->firstFit,
-               "  slotHigh  $U\n",  (WriteFU)mvff->slotHigh,
-               "  spare     $D\n",  (WriteFD)mvff->spare,
+  res = NextMethod(Pool, MVFFPool, describe)(pool, stream, depth);
+  if (res != ResOK)
+    return res;
+
+  res = WriteF(stream, depth + 2,
+               "extendBy  $W\n",  (WriteFW)mvff->extendBy,
+               "avgSize   $W\n",  (WriteFW)mvff->avgSize,
+               "firstFit  $U\n",  (WriteFU)mvff->firstFit,
+               "slotHigh  $U\n",  (WriteFU)mvff->slotHigh,
+               "spare     $D\n",  (WriteFD)mvff->spare,
                NULL);
   if (res != ResOK)
     return res;
@@ -716,8 +714,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream, Count depth)
   if (res != ResOK)
     return res;
 
-  res = WriteF(stream, depth, "} MVFF $P\n", (WriteFP)mvff, NULL);
-  return res;
+  return ResOK;
 }
 
 

From 056a2980036d87eaedda565a3065770cb2532d42 Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Sat, 23 Apr 2016 00:48:48 +0100
Subject: [PATCH 06/31] Turning segment describe methods the right way in, so
 that they call next-method.  deleting duplicate implementation of basic
 segment describe!

Copied from Perforce
 Change: 191588
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h     |   1 +
 mps/code/poolamc.c |  43 +++++++------------
 mps/code/poolams.c |  25 +++++------
 mps/code/seg.c     | 102 ++++++++++++++-------------------------------
 4 files changed, 59 insertions(+), 112 deletions(-)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 9bc8b4b59cb..556886c7104 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -669,6 +669,7 @@ extern void SegSetRankSet(Seg seg, RankSet rankSet);
 extern void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary);
 extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi);
 extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at);
+extern Res SegAbsDescribe(Seg seg, mps_lib_FILE *stream, Count depth);
 extern Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth);
 extern void SegSetSummary(Seg seg, RefSet summary);
 extern Buffer SegBuffer(Seg seg);
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 192c688881a..b7fe2fbaf27 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -236,22 +236,22 @@ static void AMCSegSketch(Seg seg, char *pbSketch, size_t cbSketch)
  */
 static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
-  Res res;
   amcSeg amcseg = CouldBeA(amcSeg, seg);
+  Res res;
   Pool pool;
   Addr i, p, base, limit, init;
   Align step;
   Size row;
   char abzSketch[5];
 
-  if(!TESTC(amcSeg, amcseg))
+  if (!TESTC(amcSeg, amcseg))
     return ResPARAM;
-  if(stream == NULL)
+  if (stream == NULL)
     return ResPARAM;
 
   /* Describe the superclass fields first via next-method call */
   res = NextMethod(Seg, amcSeg, describe)(seg, stream, depth);
-  if(res != ResOK)
+  if (res != ResOK)
     return res;
 
   pool = SegPool(seg);
@@ -262,16 +262,9 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   p = AddrAdd(base, pool->format->headerSize);
   limit = SegLimit(seg);
 
-  res = WriteF(stream, depth,
-               "AMC seg $P [$A,$A){\n",
-               (WriteFP)seg, (WriteFA)base, (WriteFA)limit,
-               NULL);
-  if(res != ResOK)
-    return res;
-
-  if(amcSegHasNailboard(seg)) {
+  if (amcSegHasNailboard(seg)) {
     res = WriteF(stream, depth + 2, "Boarded\n", NULL);
-  } else if(SegNailed(seg) == TraceSetEMPTY) {
+  } else if (SegNailed(seg) == TraceSetEMPTY) {
     res = WriteF(stream, depth + 2, "Mobile\n", NULL);
   } else {
     res = WriteF(stream, depth + 2, "Stuck\n", NULL);
@@ -281,32 +274,32 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 
   res = WriteF(stream, depth + 2,
                "Map:  *===:object  @+++:nails  bbbb:buffer\n", NULL);
-  if(res != ResOK)
+  if (res != ResOK)
     return res;
 
-  if(SegBuffer(seg) != NULL)
+  if (SegBuffer(seg) != NULL)
     init = BufferGetInit(SegBuffer(seg));
   else
     init = limit;
   
-  for(i = base; i < limit; i = AddrAdd(i, row)) {
+  for (i = base; i < limit; i = AddrAdd(i, row)) {
     Addr j;
     char c;
 
     res = WriteF(stream, depth + 2, "$A  ", (WriteFA)i, NULL);
-    if(res != ResOK)
+    if (res != ResOK)
       return res;
 
     /* @@@@ This misses a header-sized pad at the end. */
-    for(j = i; j < AddrAdd(i, row); j = AddrAdd(j, step)) {
-      if(j >= limit)
+    for (j = i; j < AddrAdd(i, row); j = AddrAdd(j, step)) {
+      if (j >= limit)
         c = ' ';  /* if seg is not a whole number of print rows */
-      else if(j >= init)
+      else if (j >= init)
         c = 'b';
       else {
         Bool nailed = amcSegHasNailboard(seg)
           && NailboardGet(amcSegNailboard(seg), j);
-        if(j == p) {
+        if (j == p) {
           c = (nailed ? '@' : '*');
           p = (pool->format->skip)(p);
         } else {
@@ -314,12 +307,12 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
         }
       }
       res = WriteF(stream, 0, "$C", (WriteFC)c, NULL);
-      if(res != ResOK)
+      if (res != ResOK)
         return res;
     }
 
     res = WriteF(stream, 0, "\n", NULL);
-    if(res != ResOK)
+    if (res != ResOK)
       return res;
   }
 
@@ -328,10 +321,6 @@ static Res AMCSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
   if(res != ResOK)
     return res;
 
-  res = WriteF(stream, depth, "} AMC Seg $P\n", (WriteFP)seg, NULL);
-  if(res != ResOK)
-    return res;
-
   return ResOK;
 }
 
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index aa0e8bd4567..8218fa53f81 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -525,18 +525,15 @@ failCreateTablesLo:
 
 static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
+  AMSSeg amsseg = CouldBeA(AMSSeg, seg);
   Res res;
-  AMSSeg amsseg;
   Buffer buffer;               /* the segment's buffer, if it has one */
   Index i;
 
-  if (!TESTT(Seg, seg))
-    return ResFAIL;
+  if (!TESTC(AMSSeg, amsseg))
+    return ResPARAM;
   if (stream == NULL)
-    return ResFAIL;
-  amsseg = Seg2AMSSeg(seg);
-  if (!TESTT(AMSSeg, amsseg))
-    return ResFAIL;
+    return ResPARAM;
 
   /* Describe the superclass fields first via next-method call */
   res = NextMethod(Seg, AMSSeg, describe)(seg, stream, depth);
@@ -545,13 +542,13 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 
   buffer = SegBuffer(seg);
 
-  res = WriteF(stream, depth,
-               "  AMS $P\n", (WriteFP)amsseg->ams,
-               "  grains $W\n", (WriteFW)amsseg->grains,
-               "  freeGrains $W\n", (WriteFW)amsseg->freeGrains,
-               "  buffferedGrains $W\n", (WriteFW)amsseg->bufferedGrains,
-               "  newGrains $W\n", (WriteFW)amsseg->newGrains,
-               "  oldGrains $W\n", (WriteFW)amsseg->oldGrains,
+  res = WriteF(stream, depth + 2,
+               "AMS $P\n", (WriteFP)amsseg->ams,
+               "grains $W\n", (WriteFW)amsseg->grains,
+               "freeGrains $W\n", (WriteFW)amsseg->freeGrains,
+               "buffferedGrains $W\n", (WriteFW)amsseg->bufferedGrains,
+               "newGrains $W\n", (WriteFW)amsseg->newGrains,
+               "oldGrains $W\n", (WriteFW)amsseg->oldGrains,
                NULL);
   if (res != ResOK)
     return res;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 9143245832f..88b34fe6e55 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -375,61 +375,57 @@ Addr SegBufferScanLimit(Seg seg)
 
 /* SegDescribe -- describe a segment */
 
-Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
+Res SegAbsDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
   Res res;
   Pool pool;
-  SegClass klass;
 
   if (!TESTC(Seg, seg))
     return ResPARAM;
   if (stream == NULL)
     return ResPARAM;
 
-  pool = SegPool(seg);
-  klass = ClassOfPoly(Seg, seg);
+  res = InstDescribe(CouldBeA(Inst, seg), stream, depth);
+  if (res != ResOK)
+    return res;
 
-  res = WriteF(stream, depth,
-               "Segment $P [$A,$A) {\n", (WriteFP)seg,
-               (WriteFA)SegBase(seg), (WriteFA)SegLimit(seg),
-               "  class $P (\"$S\")\n",
-               (WriteFP)klass, (WriteFS)ClassName(klass),
-               "  pool $P ($U)\n",
-               (WriteFP)pool, (WriteFU)pool->serial,
-               "  depth $U\n", seg->depth,
-               "  pm",
+  pool = SegPool(seg);
+
+  res = WriteF(stream, depth + 2,
+               "base  $A\n", (WriteFA)SegBase(seg),
+               "limit $A\n", (WriteFA)SegLimit(seg),
+               "pool  $P ($U)\n", (WriteFP)pool, (WriteFU)pool->serial,
+               "depth $U\n", seg->depth,
+               "pm",
                seg->pm == AccessSetEMPTY ? " EMPTY" : "",
                seg->pm & AccessREAD ? " READ" : "",
                seg->pm & AccessWRITE ? " WRITE" : "",
                "\n",
-               "  sm",
+               "sm",
                seg->sm == AccessSetEMPTY ? " EMPTY" : "",
                seg->sm & AccessREAD ? " READ" : "",
                seg->sm & AccessWRITE ? " WRITE" : "",
                "\n",
-               "  grey $B\n", (WriteFB)seg->grey,
-               "  white $B\n", (WriteFB)seg->white,
-               "  nailed $B\n", (WriteFB)seg->nailed,
-               "  rankSet",
+               "grey $B\n", (WriteFB)seg->grey,
+               "white $B\n", (WriteFB)seg->white,
+               "nailed $B\n", (WriteFB)seg->nailed,
+               "rankSet",
                seg->rankSet == RankSetEMPTY ? " EMPTY" : "",
                BS_IS_MEMBER(seg->rankSet, RankAMBIG) ? " AMBIG" : "",
                BS_IS_MEMBER(seg->rankSet, RankEXACT) ? " EXACT" : "",
                BS_IS_MEMBER(seg->rankSet, RankFINAL) ? " FINAL" : "",
                BS_IS_MEMBER(seg->rankSet, RankWEAK)  ? " WEAK"  : "",
+               "\n",
                NULL);
   if (res != ResOK)
     return res;
 
-  res = Method(Seg, seg, describe)(seg, stream, depth + 2);
-  if (res != ResOK)
-    return res;
+  return ResOK;
+}
 
-  res = WriteF(stream, 0, "\n", NULL);
-  if (res != ResOK)
-    return res;
-
-  res = WriteF(stream, depth, "} Segment $P\n", (WriteFP)seg, NULL);
-  return res;
+Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
+{
+  return Method(Seg, seg, describe)(seg, stream, depth);
 }
 
 
@@ -1011,39 +1007,6 @@ static Res segTrivSplit(Seg seg, Seg segHi,
 }
 
 
-/* segTrivDescribe -- Basic Seg description method */
-
-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, depth,
-               "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;
-}
-
-
 /* Class GCSeg -- Segment class with GC support
  */
 
@@ -1553,32 +1516,29 @@ failSuper:
 
 static Res gcSegDescribe(Seg seg, mps_lib_FILE *stream, Count depth)
 {
+  GCSeg gcseg = CouldBeA(GCSeg, seg);
   Res res;
-  GCSeg gcseg;
 
-  if (!TESTT(Seg, seg))
-    return ResFAIL;
+  if (!TESTC(GCSeg, gcseg))
+    return ResPARAM;
   if (stream == NULL)
-    return ResFAIL;
-  gcseg = SegGCSeg(seg);
-  if (!TESTT(GCSeg, gcseg))
-    return ResFAIL;
+    return ResPARAM;
 
   /* Describe the superclass fields first via next-method call */
   res = NextMethod(Seg, GCSeg, describe)(seg, stream, depth);
   if (res != ResOK)
     return res;
 
-  res = WriteF(stream, depth,
+  res = WriteF(stream, depth + 2,
                "summary $W\n", (WriteFW)gcseg->summary,
                NULL);
   if (res != ResOK)
     return res;
 
   if (gcseg->buffer == NULL) {
-    res = WriteF(stream, depth, "buffer: NULL\n", NULL);
+    res = WriteF(stream, depth + 2, "buffer: NULL\n", NULL);
   } else {
-    res = BufferDescribe(gcseg->buffer, stream, depth);
+    res = BufferDescribe(gcseg->buffer, stream, depth + 2);
   }
   if (res != ResOK)
     return res;
@@ -1629,7 +1589,7 @@ DEFINE_CLASS(Seg, Seg, klass)
   klass->setRankSummary = segNoSetRankSummary;
   klass->merge = segTrivMerge;
   klass->split = segTrivSplit;
-  klass->describe = segTrivDescribe;
+  klass->describe = SegAbsDescribe;
   klass->sig = SegClassSig;
   AVERT(SegClass, klass);
 }

From a2ce7619a142eb6b57961d2f789bd611c3391e8a Mon Sep 17 00:00:00 2001
From: Richard Brooksby <rb@ravenbrook.com>
Date: Sat, 23 Apr 2016 00:57:46 +0100
Subject: [PATCH 07/31] Turning buffer describe methods the right way in, so
 that they use next-method.

Copied from Perforce
 Change: 191589
 ServerID: perforce.ravenbrook.com
---
 mps/code/buffer.c | 80 +++++++++++++++++------------------------------
 1 file changed, 29 insertions(+), 51 deletions(-)

diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index f16897a3c2c..a35b7b55a12 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -119,54 +119,46 @@ Bool BufferCheck(Buffer buffer)
  *
  * See <code/mpmst.h> for structure definitions.  */
 
-Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
+static Res BufferAbsDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
 {
   Res res;
-  BufferClass klass;
 
   if (!TESTC(Buffer, buffer))
     return ResPARAM;
   if (stream == NULL)
     return ResPARAM;
 
-  klass = ClassOfPoly(Buffer, buffer);
-
-  res = WriteF(stream, depth,
-               "Buffer $P ($U) {\n",
-               (WriteFP)buffer, (WriteFU)buffer->serial,
-               "  class $P (\"$S\")\n",
-               (WriteFP)klass, (WriteFS)ClassName(klass),
-               "  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",        (WriteFA)buffer->base,
-               "  initAtFlip $A\n",  (WriteFA)buffer->initAtFlip,
-               "  init $A\n",        (WriteFA)buffer->ap_s.init,
-               "  alloc $A\n",       (WriteFA)buffer->ap_s.alloc,
-               "  limit $A\n",       (WriteFA)buffer->ap_s.limit,
-               "  poolLimit $A\n",   (WriteFA)buffer->poolLimit,
-               "  alignment $W\n",   (WriteFW)buffer->alignment,
-               "  rampCount $U\n",   (WriteFU)buffer->rampCount,
-               NULL);
+  res = InstDescribe(CouldBeA(Inst, buffer), stream, depth);
   if (res != ResOK)
     return res;
 
-  res = Method(Buffer, buffer, describe)(buffer, stream, depth + 2);
-  if (res != ResOK)
-    return res;
+  return WriteF(stream, depth + 2,
+                "serial $U\n", (WriteFU)buffer->serial,
+                "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",        (WriteFA)buffer->base,
+                "initAtFlip $A\n",  (WriteFA)buffer->initAtFlip,
+                "init $A\n",        (WriteFA)buffer->ap_s.init,
+                "alloc $A\n",       (WriteFA)buffer->ap_s.alloc,
+                "limit $A\n",       (WriteFA)buffer->ap_s.limit,
+                "poolLimit $A\n",   (WriteFA)buffer->poolLimit,
+                "alignment $W\n",   (WriteFW)buffer->alignment,
+                "rampCount $U\n",   (WriteFU)buffer->rampCount,
+                NULL);
+}
 
-  res = WriteF(stream, depth, "} Buffer $P ($U)\n",
-               (WriteFP)buffer, (WriteFU)buffer->serial,
-               NULL);
-  return res;
+Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
+{
+  return Method(Buffer, buffer, describe)(buffer, stream, depth);
 }
 
 
@@ -1006,20 +998,6 @@ static void bufferNoReassignSeg(Buffer buffer, Seg seg)
 }
 
 
-/* bufferTrivDescribe -- basic Buffer describe method */
-
-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;
-}
-
-
 /* BufferClassCheck -- check the consistency of a BufferClass */
 
 Bool BufferClassCheck(BufferClass klass)
@@ -1059,7 +1037,7 @@ DEFINE_CLASS(Buffer, Buffer, klass)
   klass->finish = BufferAbsFinish;
   klass->attach = bufferTrivAttach;
   klass->detach = bufferTrivDetach;
-  klass->describe = bufferTrivDescribe;
+  klass->describe = BufferAbsDescribe;
   klass->seg = bufferNoSeg;
   klass->rankSet = bufferTrivRankSet;
   klass->setRankSet = bufferNoSetRankSet;

From 0dd2505fc5973d06f4e37b55ba9214e359b1f4c9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 1 May 2016 09:35:24 +0100
Subject: [PATCH 08/31] Epoch now only counts flips in which objects might have
 moved.

Copied from Perforce
 Change: 191748
 ServerID: perforce.ravenbrook.com
---
 mps/design/arena.txt | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/mps/design/arena.txt b/mps/design/arena.txt
index 426e6d6da4f..c50d3476982 100644
--- a/mps/design/arena.txt
+++ b/mps/design/arena.txt
@@ -567,9 +567,10 @@ _`.ld`: The ``historyStruct`` contains fields used to maintain a
 history of garbage collection and in particular object motion in order
 to implement location dependency.
 
-_`.ld.epoch`: The ``epoch`` is the "current epoch". This is the
-number of 'flips' of traces in the arena since the arena was created.
-From the mutator's point of view locations change atomically at flip.
+_`.ld.epoch`: The ``epoch`` is the "current epoch". This is the number
+of "flips" of traces, in which objects might have moved, in the arena
+since it was created. From the mutator's point of view, locations
+change atomically at flip.
 
 _`.ld.history`: The ``history`` is a circular buffer of
 ``LDHistoryLENGTH`` elements of type ``RefSet``. These are the
@@ -619,7 +620,7 @@ Document History
 Copyright and License
 ---------------------
 
-Copyright © 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+Copyright © 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
 All rights reserved. This is an open source license. Contact
 Ravenbrook for commercial licensing options.
 

From fa2fced30641d2a9c8c7cb19c83682aba1017c16 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 2 May 2016 13:06:07 +0100
Subject: [PATCH 09/31] Clear the emergency before removing the trace from
 busytraces, to avoid violating <code/global.c#emergency.invariant>.

Copied from Perforce
 Change: 191774
 ServerID: perforce.ravenbrook.com
---
 mps/code/global.c | 7 ++++---
 mps/code/trace.c  | 8 +++++---
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/mps/code/global.c b/mps/code/global.c
index fa2eb684c5b..9fd8d7aeed8 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1,7 +1,7 @@
 /* global.c: ARENA-GLOBAL INTERFACES
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * .sources: See <design/arena/>.  design.mps.thread-safety is relevant
@@ -188,7 +188,8 @@ Bool GlobalsCheck(Globals arenaGlobals)
   CHECKL(RingCheck(&arenaRing));
 
   CHECKL(BoolCheck(arena->emergency));
-  /* There can only be an emergency when a trace is busy. */
+  /* .emergency.invariant: There can only be an emergency when a trace
+   * is busy. */
   CHECKL(!arena->emergency || arena->busyTraces != TraceSetEMPTY);
   
   if (arenaGlobals->defaultChain != NULL)
@@ -1066,7 +1067,7 @@ Bool ArenaEmergency(Arena arena)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/trace.c b/mps/code/trace.c
index 2672799dd38..02c04e4b841 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -846,12 +846,14 @@ void TraceDestroyFinished(Trace trace)
 
   EVENT1(TraceDestroy, trace);
 
+  /* Hopefully the trace reclaimed some memory, so clear any emergency.
+   * Do this before removing the trace from busyTraces, to avoid
+   * violating <code/global.c#emergency.invariant>. */
+  ArenaSetEmergency(trace->arena, FALSE);
+
   trace->sig = SigInvalid;
   trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace);
   trace->arena->flippedTraces = TraceSetDel(trace->arena->flippedTraces, trace);
-
-  /* Hopefully the trace reclaimed some memory, so clear any emergency. */
-  ArenaSetEmergency(trace->arena, FALSE);
 }
 
 

From 11944d44c262d766be2f0fd2b1a577c9841bce42 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 2 May 2016 13:49:43 +0100
Subject: [PATCH 10/31] Patch the mfs pool's alloc method instead of rewriting
 its class -- the latter violates the class invariants and so asserts when
 deep checking is turned on.

Copied from Perforce
 Change: 191779
 ServerID: perforce.ravenbrook.com
---
 mps/code/fotest.c   | 80 +++++++++++++++------------------------------
 mps/code/poolmfs.c  |  8 ++---
 mps/code/poolmfs.h  |  6 ++--
 mps/code/poolmv2.c  | 18 ++--------
 mps/code/poolmvff.c | 18 ++--------
 5 files changed, 36 insertions(+), 94 deletions(-)

diff --git a/mps/code/fotest.c b/mps/code/fotest.c
index 33ec227b19a..09ba0a2d8db 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -1,7 +1,7 @@
 /* fotest.c: FAIL-OVER TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * This tests fail-over behaviour in low memory situations. The MVFF
@@ -10,9 +10,8 @@
  * request due to running out of memory, they fall back to a Freelist
  * (which has zero memory overhead, at some cost in performance).
  *
- * This is a white box test: it patches the class of the CBS's
- * internal block pool (MFS) with a pointer to a dummy class whose
- * alloc() method always returns ResMEMORY.
+ * This is a white box test: it monkey-patches the MFS pool's alloc
+ * method with a method that always returns a memory error code.
  */
 
 
@@ -36,40 +35,6 @@
 #define testLOOPS 10
 
 
-/* Accessors for the CBS used to implement a pool. */
-
-extern Land _mps_mvff_cbs(Pool);
-extern Land _mps_mvt_cbs(Pool);
-
-
-/* "OOM" pool class -- dummy alloc/free pool class whose alloc()
- * method always fails and whose free method does nothing. */
-
-static Res oomAlloc(Addr *pReturn, Pool pool, Size size)
-{
-  UNUSED(pReturn);
-  UNUSED(pool);
-  UNUSED(size);
-  switch (rnd() % 3) {
-  case 0:
-    return ResRESOURCE;
-  case 1:
-    return ResMEMORY;
-  default:
-    return ResCOMMIT_LIMIT;
-  }
-}
-
-DECLARE_CLASS(Pool, OOMPool, AbstractPool);
-DEFINE_CLASS(Pool, OOMPool, klass)
-{
-  INHERIT_CLASS(klass, OOMPool, AbstractPool);
-  klass->alloc = oomAlloc;
-  klass->free = PoolTrivFree;
-  klass->size = sizeof(PoolStruct);
-}
-
-
 /* make -- allocate one object */
 
 static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
@@ -86,20 +51,33 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 }
 
 
-/* set_oom -- set blockPool of CBS to OOM or MFS according to argument. */
+/* oomAlloc -- allocation function that always fails
+ *
+ * Returns a randomly chosen memory error code.
+ */
 
-static void set_oom(Land land, int oom)
+static Res oomAlloc(Addr *pReturn, Pool pool, Size size)
 {
-  CBS cbs = MustBeA(CBS, land);
-  SetClassOfPoly(cbs->blockPool, oom ? CLASS(OOMPool) : PoolClassMFS());
+  UNUSED(pReturn);
+  UNUSED(pool);
+  UNUSED(size);
+  switch (rnd() % 3) {
+  case 0:
+    return ResRESOURCE;
+  case 1:
+    return ResMEMORY;
+  default:
+    return ResCOMMIT_LIMIT;
+  }
 }
 
 
 /* stress -- create an allocation point and allocate in it */
 
 static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
-                        mps_align_t alignment, mps_pool_t pool, Land cbs)
+                        mps_align_t alignment, mps_pool_t pool)
 {
+  PoolAllocMethod mfs_alloc = CLASS_STATIC(MFSPool).alloc;
   mps_res_t res = MPS_RES_OK;
   mps_ap_t ap;
   unsigned long i, k;
@@ -146,9 +124,9 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
         goto allocFail;
     }
 
-    set_oom(cbs, rnd() % 2);
+    CLASS_STATIC(MFSPool).alloc = rnd() % 2 ? mfs_alloc : oomAlloc;
   }
-  set_oom(cbs, 0);
+  CLASS_STATIC(MFSPool).alloc = mfs_alloc;
 
 allocFail:
   mps_ap_destroy(ap);
@@ -187,10 +165,7 @@ int main(int argc, char *argv[])
     MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, rnd() % 2);
     die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args), "create MVFF");
   } MPS_ARGS_END(args);
-  {
-    die(stress(randomSizeAligned, alignment, pool, _mps_mvff_cbs(pool)),
-        "stress MVFF");
-  }
+  die(stress(randomSizeAligned, alignment, pool), "stress MVFF");
   mps_pool_destroy(pool);
   mps_arena_destroy(arena);
 
@@ -206,10 +181,7 @@ int main(int argc, char *argv[])
     MPS_ARGS_ADD(args, MPS_KEY_MVT_FRAG_LIMIT, (rnd() % 101) / 100.0);
     die(mps_pool_create_k(&pool, arena, mps_class_mvt(), args), "create MVFF");
   } MPS_ARGS_END(args);
-  {
-    die(stress(randomSizeAligned, alignment, pool, _mps_mvt_cbs(pool)),
-        "stress MVT");
-  }
+  die(stress(randomSizeAligned, alignment, pool), "stress MVT");
   mps_pool_destroy(pool);
   mps_arena_destroy(arena);
 
@@ -220,7 +192,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/poolmfs.c b/mps/code/poolmfs.c
index 92627aaf4f8..3195eac6102 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -1,7 +1,7 @@
 /* poolmfs.c: MANUAL FIXED SMALL UNIT POOL
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * This is the implementation of the MFS pool class.
  *
@@ -39,10 +39,6 @@
 SRCID(poolmfs, "$Id$");
 
 
-typedef MFS MFSPool;
-DECLARE_CLASS(Pool, MFSPool, AbstractPool);
-
-
 /* ROUND -- Round up
  *
  *  Rounds n up to the nearest multiple of unit.
@@ -386,7 +382,7 @@ Bool MFSCheck(MFS mfs)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/poolmfs.h b/mps/code/poolmfs.h
index 70d4124cb42..e17054140c6 100644
--- a/mps/code/poolmfs.h
+++ b/mps/code/poolmfs.h
@@ -2,7 +2,7 @@
  *
  *  $Id$
  *
- *  Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ *  Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  *  The MFS pool is used to manage small fixed-size chunks of memory.  It
  *  stores control structures in the memory it manages, rather than to one
@@ -32,6 +32,8 @@
 #include "mpscmfs.h"
 
 typedef struct MFSStruct *MFS;
+typedef MFS MFSPool;
+DECLARE_CLASS(Pool, MFSPool, AbstractPool);
 
 #define MFSPool(mfs) (&(mfs)->poolStruct)
 
@@ -55,7 +57,7 @@ extern void MFSFinishTracts(Pool pool, MFSTractVisitor visitor,
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/poolmv2.c b/mps/code/poolmv2.c
index f563922588a..f029525b031 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -1,7 +1,7 @@
 /* poolmv2.c: MANUAL VARIABLE-SIZED TEMPORAL POOL
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .purpose: A manual-variable pool designed to take advantage of
  * placement according to predicted deathtime.
@@ -1352,23 +1352,9 @@ static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena)
 }
 
 
-/* Return the CBS of an MVT pool for the benefit of fotest.c. */
-
-extern Land _mps_mvt_cbs(Pool);
-Land _mps_mvt_cbs(Pool pool) {
-  MVT mvt;
-
-  AVERT(Pool, pool);
-  mvt = PoolMVT(pool);
-  AVERT(MVT, mvt);
-
-  return MVTFreePrimary(mvt);
-}
-
-
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/poolmvff.c b/mps/code/poolmvff.c
index dda5779eddc..de19688a142 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -1,7 +1,7 @@
 /* poolmvff.c: First Fit Manual Variable Pool
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * .purpose: This is a pool class for manually managed objects of
@@ -796,23 +796,9 @@ static Bool MVFFCheck(MVFF mvff)
 }
 
 
-/* Return the CBS of an MVFF pool for the benefit of fotest.c. */
-
-extern Land _mps_mvff_cbs(Pool);
-Land _mps_mvff_cbs(Pool pool) {
-  MVFF mvff;
-
-  AVERT(Pool, pool);
-  mvff = PoolMVFF(pool);
-  AVERT(MVFF, mvff);
-
-  return MVFFFreePrimary(mvff);
-}
-
-
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

From 6f196185a1060fec516755dc568bbf8fc299e5c0 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Tue, 3 May 2016 17:25:27 +0100
Subject: [PATCH 11/31] Make shield assertions robust against deep checking --
 when shieldcover is called from shieldraise there is one unsynced segment
 that has not yet been queued. record this fact in a new queuepending flag in
 the shield structure.

Remove incorrect shield assertion "shield->depth == 0 || shield->suspended" -- depth may be increased without suspending the mutator if the segment did not need protecting.

Copied from Perforce
 Change: 191812
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpmst.h  |  5 +++--
 mps/code/shield.c | 25 ++++++++++++++-----------
 2 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 065088e9cf0..3ab10ec7561 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -695,7 +695,9 @@ typedef struct SortStruct {
 
 typedef struct ShieldStruct {
   Sig sig;           /* design.mps.sig */
-  Bool inside;       /* design.mps.shield.def.inside */
+  BOOLFIELD(inside); /* design.mps.shield.def.inside */
+  BOOLFIELD(suspended); /* mutator suspended? */
+  BOOLFIELD(queuePending); /* queue insertion pending? */
   Seg *queue;        /* queue of unsynced segs */
   Count length;      /* number of elements in shield queue */
   Index next;        /* next free element in shield queue */
@@ -703,7 +705,6 @@ typedef struct ShieldStruct {
   Count depth;       /* sum of depths of all segs */
   Count unsynced;    /* number of unsynced segments */
   Count holds;       /* number of holds */
-  Bool suspended;    /* mutator suspended? */
   SortStruct sortStruct; /* workspace for queue sort */
 } ShieldStruct;
 
diff --git a/mps/code/shield.c b/mps/code/shield.c
index 84b7c0d9c70..6ec0405f612 100644
--- a/mps/code/shield.c
+++ b/mps/code/shield.c
@@ -18,6 +18,8 @@ SRCID(shield, "$Id$");
 void ShieldInit(Shield shield)
 {
   shield->inside = FALSE;
+  shield->suspended = FALSE;
+  shield->queuePending = FALSE;
   shield->queue = NULL;
   shield->length = 0;
   shield->next = 0;
@@ -25,7 +27,6 @@ void ShieldInit(Shield shield)
   shield->depth = 0;
   shield->unsynced = 0;
   shield->holds = 0;
-  shield->suspended = FALSE;
   shield->sig = ShieldSig;
 }
 
@@ -64,11 +65,10 @@ static Bool SegIsSynced(Seg seg);
 Bool ShieldCheck(Shield shield)
 {
   CHECKS(Shield, shield);
-  CHECKL(BoolCheck(shield->inside));
+  /* Can't check Boolean bitfields <design/type/#bool.bitfield.check> */
   CHECKL(shield->queue == NULL || shield->length > 0);
   CHECKL(shield->limit <= shield->length);
   CHECKL(shield->next <= shield->limit);
-  CHECKL(BoolCheck(shield->suspended));
 
   /* The mutator is not suspended while outside the shield
      (design.mps.shield.inv.outside.running). */
@@ -78,9 +78,6 @@ Bool ShieldCheck(Shield shield)
      (design.mps.shield.inv.unsynced.suspended). */
   CHECKL(shield->unsynced == 0 || shield->suspended);
 
-  /* If any segment is exposed, the mutator is suspended. */
-  CHECKL(shield->depth == 0 || shield->suspended);
-
   /* The total depth is zero while outside the shield
      (design.mps.shield.inv.outside.depth). */
   CHECKL(shield->inside || shield->depth == 0);
@@ -90,7 +87,7 @@ Bool ShieldCheck(Shield shield)
 
   /* Every unsynced segment should be on the queue, because we have to
      remember to sync it before we return to the mutator. */
-  CHECKL(shield->limit >= shield->unsynced);
+  CHECKL(shield->limit + shield->queuePending >= shield->unsynced);
 
   /* The mutator is suspeneded if there are any holds. */
   CHECKL(shield->holds == 0 || shield->suspended);
@@ -100,18 +97,15 @@ Bool ShieldCheck(Shield shield)
      16. */
 #if defined(AVER_AND_CHECK_ALL)
   {
-    Count depth = 0;
     Count unsynced = 0;
     Index i;
     for (i = 0; i < shield->limit; ++i) {
       Seg seg = shield->queue[i];
       CHECKD(Seg, seg);
-      depth += SegDepth(seg);
       if (!SegIsSynced(seg))
         ++unsynced;
     }
-    CHECKL(depth == shield->depth);
-    CHECKL(unsynced == shield->unsynced);
+    CHECKL(unsynced + shield->queuePending == shield->unsynced);
   }
 #endif
 
@@ -539,9 +533,14 @@ static void shieldQueue(Arena arena, Seg seg)
 
 void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode)
 {
+  Shield shield;
+
   SHIELD_AVERT(Arena, arena);
   SHIELD_AVERT(Seg, seg);
   AVERT(AccessSet, mode);
+  shield = ArenaShield(arena);
+  AVER(!shield->queuePending);
+  shield->queuePending = TRUE;
 
   /* design.mps.shield.inv.prot.shield preserved */
   shieldSetSM(ArenaShield(arena), seg, BS_UNION(SegSM(seg), mode));
@@ -549,6 +548,7 @@ void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode)
   /* Ensure design.mps.shield.inv.unsynced.suspended and
      design.mps.shield.inv.unsynced.depth */
   shieldQueue(arena, seg);
+  shield->queuePending = FALSE;
 
   /* Check queue and segment consistency. */
   AVERT(Arena, arena);
@@ -619,6 +619,7 @@ static void shieldDebugCheck(Arena arena)
   Shield shield;
   Seg seg;
   Count queued = 0;
+  Count depth = 0;
 
   AVERT(Arena, arena);
   shield = ArenaShield(arena);
@@ -626,6 +627,7 @@ static void shieldDebugCheck(Arena arena)
 
   if (SegFirst(&seg, arena))
     do {
+      depth += SegDepth(seg);
       if (shield->limit == 0) {
         AVER(!seg->queued);
         AVER(SegIsSynced(seg));
@@ -638,6 +640,7 @@ static void shieldDebugCheck(Arena arena)
       }
     } while(SegNext(&seg, arena, seg));
 
+  AVER(depth == shield->depth);
   AVER(queued == shield->limit);
 }
 #endif

From 9b81dcb5c41c7494f9e63cb66a042084dcd8bc46 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Thu, 2 Jun 2016 15:02:05 +0100
Subject: [PATCH 12/31] New program mpseventpy emits python data structures
 representing telemetry events.

Copied from Perforce
 Change: 191895
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk     |   7 ++-
 mps/code/commpost.nmk |  10 +++-
 mps/code/commpre.nmk  |   2 +-
 mps/code/eventpy.c    | 103 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 117 insertions(+), 5 deletions(-)
 create mode 100644 mps/code/eventpy.c

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index b61c48a1e0e..5042cb126df 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -73,9 +73,9 @@ endif
 # EXTRA TARGETS
 #
 # Don't build mpseventsql by default (might not have sqlite3 installed),
-# but do build mpseventcnv and mpseventtxt.
+# but do build mpseventcnv, mpseventpy and mpseventtxt.
 
-EXTRA_TARGETS ?= mpseventcnv mpseventtxt
+EXTRA_TARGETS ?= mpseventcnv mpseventpy mpseventtxt
 
 
 #
@@ -572,6 +572,9 @@ $(PFM)/$(VARIETY)/zmess: $(PFM)/$(VARIETY)/zmess.o \
 $(PFM)/$(VARIETY)/mpseventcnv: $(PFM)/$(VARIETY)/eventcnv.o \
   $(PFM)/$(VARIETY)/mps.a
 
+$(PFM)/$(VARIETY)/mpseventpy: $(PFM)/$(VARIETY)/eventpy.o \
+  $(PFM)/$(VARIETY)/mps.a
+
 $(PFM)/$(VARIETY)/mpseventtxt: $(PFM)/$(VARIETY)/eventtxt.o \
   $(PFM)/$(VARIETY)/mps.a
 
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 0917fe86431..2e5a999744c 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -1,7 +1,7 @@
 # commpost.nmk: SECOND COMMON FRAGMENT FOR PLATFORMS USING NMAKE -*- makefile -*-
 #
 # $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
 #
 # DESCRIPTION
 #
@@ -315,6 +315,9 @@ $(PFM)\$(VARIETY)\ztfm.exe: $(PFM)\$(VARIETY)\ztfm.obj \
 $(PFM)\$(VARIETY)\mpseventcnv.exe: $(PFM)\$(VARIETY)\eventcnv.obj \
 	$(PFM)\$(VARIETY)\mps.lib
 
+$(PFM)\$(VARIETY)\mpseventpy.exe: $(PFM)\$(VARIETY)\eventpy.obj \
+	$(PFM)\$(VARIETY)\mps.lib
+
 $(PFM)\$(VARIETY)\mpseventtxt.exe: $(PFM)\$(VARIETY)\eventtxt.obj \
 	$(PFM)\$(VARIETY)\mps.lib
 
@@ -335,6 +338,9 @@ $(PFM)\$(VARIETY)\replaysw.obj: $(PFM)\$(VARIETY)\replay.obj
 $(PFM)\$(VARIETY)\mpseventcnv.obj: $(PFM)\$(VARIETY)\eventcnv.obj
 	copy $** $@ >nul:
 
+$(PFM)\$(VARIETY)\mpseventpy.obj: $(PFM)\$(VARIETY)\eventpy.obj
+	copy $** $@ >nul:
+
 $(PFM)\$(VARIETY)\mpseventtxt.obj: $(PFM)\$(VARIETY)\eventtxt.obj
 	copy $** $@ >nul:
 
@@ -385,7 +391,7 @@ $(PFM)\$(VARIETY)\sqlite3.obj:
 
 # C. COPYRIGHT AND LICENSE
 #
-# Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+# Copyright (c) 2001-2016 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/commpre.nmk b/mps/code/commpre.nmk
index 7141d83dd2e..8a79096f42c 100644
--- a/mps/code/commpre.nmk
+++ b/mps/code/commpre.nmk
@@ -105,7 +105,7 @@ TEST_TARGETS=\
 # Stand-alone programs go in EXTRA_TARGETS if they should always be
 # built, or in OPTIONAL_TARGETS if they should only be built if 
 
-EXTRA_TARGETS=mpseventcnv.exe mpseventtxt.exe
+EXTRA_TARGETS=mpseventcnv.exe mpseventpy.exe mpseventtxt.exe
 OPTIONAL_TARGETS=mpseventsql.exe
 
 # This target records programs that we were once able to build but
diff --git a/mps/code/eventpy.c b/mps/code/eventpy.c
new file mode 100644
index 00000000000..23d14c5f63c
--- /dev/null
+++ b/mps/code/eventpy.c
@@ -0,0 +1,103 @@
+/* eventpy.c: GENERATE PYTHON INTERFACE TO EVENTS
+ *
+ * $Id$
+ * Copyright (c) 2016 Ravenbrook Limited.  See end of file for license.
+ *
+ * This command-line program emits Python data structures that can be
+ * used to parse an event stream in text format (as output by the
+ * mpseventcnv program).
+ */
+
+#include <stdio.h> /* printf, puts */
+
+#include "event.h"
+
+int main(int argc, char *argv[])
+{
+  UNUSED(argc);
+  UNUSED(argv);
+
+  puts("from collections import namedtuple");
+
+  printf("__version__ = %d, %d, %d\n", EVENT_VERSION_MAJOR,
+         EVENT_VERSION_MEDIAN, EVENT_VERSION_MINOR);
+
+  puts("EventKind = namedtuple('EventKind', 'name code doc')");
+  puts("class kind:");
+#define ENUM(_, NAME, DOC)                                              \
+  printf("    " #NAME " = EventKind('" #NAME "', %d, \"%s\")\n",        \
+         EventKind ## NAME, DOC);
+  EventKindENUM(ENUM, _);
+#undef ENUM
+
+  puts("kinds = {");
+#define ENUM(_, NAME, _1) \
+  printf("    %d: kind." #NAME ",\n", EventKind ## NAME);
+  EventKindENUM(ENUM, _);
+#undef ENUM
+  puts("}");
+
+  puts("EventParam = namedtuple('EventParam', 'sort, name')");
+  puts("Event = namedtuple('Event', 'name code always kind params')");
+  puts("class event:");
+#define EVENT_PARAM(X, INDEX, SORT, NAME)               \
+  puts("        EventParam('" #SORT "', '" #NAME "'),");
+#define EVENT_DEFINE(X, NAME, CODE, ALWAYS, KIND)                       \
+  printf("    " #NAME " = Event('" #NAME "', %d, %s, kind." #KIND ", [\n", \
+         CODE, ALWAYS ? "True" : "False");                              \
+  EVENT_ ## NAME ## _PARAMS(EVENT_PARAM, X);                            \
+  puts("    ]);");
+  EVENT_LIST(EVENT_DEFINE, 0);
+#undef EVENT
+
+  puts("events = {");
+#define EVENT_ITEM(X, NAME, CODE, ALWAYS, KIND) \
+  printf("    %d: event." #NAME ",\n", CODE);
+  EVENT_LIST(EVENT_ITEM, 0);
+#undef EVENT
+  puts("}");
+
+  return 0;
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (c) 2016 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 8dd574301c5aeeb93a41643204fa166dbea51320 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 13:25:11 +0100
Subject: [PATCH 13/31] Fix typos and other problems with the manual.

Copied from Perforce
 Change: 192091
 ServerID: perforce.ravenbrook.com
---
 mps/design/prot.txt                         | 12 ++---
 mps/design/protocol.txt                     | 13 ++---
 mps/design/strategy.txt                     |  4 +-
 mps/manual/source/extensions/mps/designs.py | 33 ++++++------
 mps/manual/source/guide/advanced.rst        |  6 +--
 mps/manual/source/release.rst               |  8 +++
 mps/manual/source/topic/arena.rst           |  6 ++-
 mps/manual/source/topic/deprecated.rst      | 59 +++++++++++++++++----
 mps/manual/source/topic/finalization.rst    |  2 +-
 mps/manual/source/topic/format.rst          | 11 ++--
 mps/manual/source/topic/location.rst        |  4 +-
 mps/manual/source/topic/plinth.rst          |  4 +-
 mps/manual/source/topic/porting.rst         |  5 +-
 mps/manual/source/topic/telemetry.rst       | 12 +++--
 mps/manual/source/topic/thread.rst          |  3 +-
 15 files changed, 115 insertions(+), 67 deletions(-)

diff --git a/mps/design/prot.txt b/mps/design/prot.txt
index 0cdd8d38fcd..a3ff8e35a38 100644
--- a/mps/design/prot.txt
+++ b/mps/design/prot.txt
@@ -55,11 +55,11 @@ write-protected segment. See ``TraceSegAccess()``.)
 Design
 ------
 
-_`.sol.sync`: If memory protection is not available, only way to meet
-`.req.consistent`_, is ensure that no protection is required,
-essentially by running the collector until it has no more incremental
-work to do. (This makes it impossible to meet real-time requirements
-on pause times, but may be the best that can be done.)
+_`.sol.sync`: If memory protection is not available, the only way to
+meet `.req.consistent`_ is to ensure that no protection is required,
+by running the collector until it has no more incremental work to do.
+(This makes it impossible to meet real-time requirements on pause
+times, but may be the best that can be done.)
 
 _`.sol.fault.handle`: The protection module handles protection faults
 by decoding the context of the fault (see
@@ -165,7 +165,7 @@ Document History
 Copyright and License
 ---------------------
 
-Copyright © 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+Copyright © 2013-2016 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/design/protocol.txt b/mps/design/protocol.txt
index b2bd308adeb..f3ed7246896 100644
--- a/mps/design/protocol.txt
+++ b/mps/design/protocol.txt
@@ -90,8 +90,8 @@ describes it, like this::
 
 _`.overview.prefix`: We make use of the fact that we can cast between
 structures with common prefixes, or between structures and their first
-members, to provide dynamic typing and subtyping (see [K&R_1998]_,
-A.8.3).
+members, to provide dynamic typing and subtyping (see
+[Kernighan_1988]_, A.8.3).
 
 _`.overview.method`: The ``InstClassStruct`` it itself at the start of
 a class structure contains pointers to functions that can be called to
@@ -575,6 +575,8 @@ level.  The level is statically defined using enum constants, and the
 id is the address of the canonical class object, so the test is fast
 and simple.
 
+.. _RB: http://www.ravenbrook.com/consultants/rb/
+
 
 A. References
 -------------
@@ -582,14 +584,14 @@ A. References
 .. [Cohen_1991] "Type-Extension Type Tests Can Be Performed In
    Constant Time"; Norman H Cohen; IBM Thomas J Watson Research
    Center; ACM Transactions on Programming Languages and Systems,
-   Vol. 13 No. 4, pp626-629; 1991-10.
+   Vol. 13 No. 4, pp. 626-629; 1991-10.
 
 .. [Gibbs_2004] "Fast Dynamic Casting"; Michael Gibbs, Bjarne
    Stroustrup; 2004;
    <http://www.stroustrup.com/fast_dynamic_casting.pdf>.
 
-.. [K&R_1988] "The C Programming language 2nd Edition";
-   Brian W. Kernighan, Dennis M. Ritchie; 1998.
+.. [Kernighan_1988] "The C Programming language 2nd Edition"; Brian W.
+   Kernighan, Dennis M. Ritchie; 1988.
 
 
 B. Document History
@@ -612,7 +614,6 @@ B. Document History
 
 - 2016-04-19 RB_ Miscellaneous clean-up in response to review by GDR_.
 
-.. _RB: http://www.ravenbrook.com/consultants/rb/
 .. _GDR: http://www.ravenbrook.com/consultants/gdr/
 
 
diff --git a/mps/design/strategy.txt b/mps/design/strategy.txt
index db6965c59e5..ab22849df4a 100644
--- a/mps/design/strategy.txt
+++ b/mps/design/strategy.txt
@@ -549,11 +549,13 @@ clock time when the MPS was entered; ``moreWork`` and ``tracedWork``
 are the results of the last call to ``TracePoll()``.
 
 _`.policy.poll.impl`: The implementation keep doing work until either
-the maximum pause time is exceeded (see design.mps.arena.pause-time_),
+the maximum pause time is exceeded (see `design.mps.arena.pause-time`_),
 or there is no more work to do. Then it schedules the next collection
 so that there is approximately one call to ``TracePoll()`` for every
 ``ArenaPollALLOCTIME`` bytes of allocation.
 
+.. _design.mps.arena.pause-time: arena#pause-time
+
 
 References
 ----------
diff --git a/mps/manual/source/extensions/mps/designs.py b/mps/manual/source/extensions/mps/designs.py
index 18149092a19..234e99d2c94 100644
--- a/mps/manual/source/extensions/mps/designs.py
+++ b/mps/manual/source/extensions/mps/designs.py
@@ -32,7 +32,7 @@ TYPES = '''
 
 mode = re.compile(r'\.\. mode: .*\n')
 prefix = re.compile(r'^:Tag: ([a-z][a-z.0-9-]*[a-z0-9])$', re.MULTILINE)
-rst_tag = re.compile(r'^:(?:Author|Date|Status|Revision|Copyright|Organization|Format|Index terms):.*?$\n', re.MULTILINE | re.IGNORECASE)
+rst_tag = re.compile(r'^:(?:Author|Date|Status|Revision|Copyright|Organization|Format|Index terms|Readership):.*?$\n', re.MULTILINE | re.IGNORECASE)
 mps_tag = re.compile(r'_`\.([a-z][A-Za-z.0-9_-]*[A-Za-z0-9])`:')
 mps_ref = re.compile(r'`(\.[a-z][A-Za-z.0-9_-]*[A-Za-z0-9])`_(?:        )?')
 funcdef = re.compile(r'^``([^`]*\([^`]*\))``$', re.MULTILINE)
@@ -61,10 +61,10 @@ def secnum_sub(m):
 #     .. [THVV_1995] Tom Van Vleck. 1995. "`Structure Marking <http://www.multicians.org/thvv/marking.html>`__".
 citation = re.compile(
     r'''
-        ^\.\.\s+(?P<ref>\[.*?\])\s*
-        "(?P<title>[^"]*?)"\s*
-        ;\s*(?P<author>[^;]*?)\s*
-        (?:;\s*(?P<organization>[^;]*?)\s*)?
+        ^\.\.\s+(?P<ref>\[[^\n\]]+\])\s*
+        "(?P<title>[^"]+?)"\s*
+        ;\s*(?P<author>[^;]+?)\s*
+        (?:;\s*(?P<organization>[^;]+?)\s*)?
         ;\s*(?P<date>[0-9-]+)\s*
         (?:;\s*<\s*(?P<url>[^>]*?)\s*>\s*)?
         \.
@@ -72,21 +72,18 @@ citation = re.compile(
     re.VERBOSE | re.MULTILINE | re.IGNORECASE | re.DOTALL
 )
 def citation_sub(m):
-    groups = m.groupdict()
-    for key in groups:
-        if groups[key]:
-            groups[key] = re.sub(r'\s+', ' ', groups[key])
-    result = '.. {ref} {author}.'.format(**groups)
-    if groups.get('organization'):
-        result += ' {organization}.'.format(**groups)
-    result += ' {date}.'.format(**groups)
-    if groups.get('url'):
-        result += ' "`{title} <{url}>`__".'.format(**groups)
+    groups = {k: re.sub(r'\s+', ' ', v) for k, v in m.groupdict().items() if v}
+    fmt = '.. {ref} {author}.'
+    if 'organization' in groups:
+        fmt += ' {organization}.'
+    fmt += ' {date}.'
+    if 'url' in groups:
+        fmt += ' "`{title} <{url}>`__".'
     else:
-        result += ' "{title}".'.format(**groups)
-    return result
+        fmt += ' "{title}".'
+    return fmt.format(**groups)
 
-index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)', re.MULTILINE | re.IGNORECASE)
+index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)', re.IGNORECASE)
 
 # <http://sphinx-doc.org/markup/misc.html#directive-index>
 index_term = re.compile(r'^\s*(\w+):\s*(.*?)\s*$', re.MULTILINE)
diff --git a/mps/manual/source/guide/advanced.rst b/mps/manual/source/guide/advanced.rst
index b56edf14fa4..c7cc53af363 100644
--- a/mps/manual/source/guide/advanced.rst
+++ b/mps/manual/source/guide/advanced.rst
@@ -141,9 +141,9 @@ releasing the resource (here, the Scheme function
 
 But this raises the possibility that a port will be closed twice: once
 via ``close-input-port`` and a second time via finalization. So it's
-necessary to make ports robust against be closed multiple times. The
-toy Scheme interpreter does so by setting ``stream`` to ``NULL``: this
-ensures that the file handle won't be closed more than once.
+necessary to make ports robust against being closed multiple times.
+The toy Scheme interpreter does so by setting ``stream`` to ``NULL``:
+this ensures that the file handle won't be closed more than once.
 
 .. code-block:: c
     :emphasize-lines: 6
diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index d39467f495c..db37e516ca3 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -508,6 +508,14 @@ Interface changes
    ``dont-handle-bad-access`` or to request special handling of
    ``SIGBUS``.
 
+#. The (undocumented) reservoir functions
+   :c:func:`mps_ap_fill_with_reservoir_permit`,
+   :c:func:`mps_reservoir_available`, :c:func:`mps_reservoir_limit`,
+   :c:func:`mps_reservoir_limit_set`, and
+   :c:func:`mps_reserve_with_reservoir_permit`, together with the
+   ``has_reservoir_permit`` arguments to :c:func:`mps_sac_alloc` and
+   :c:func:`MPS_SAC_ALLOC_FAST` are deprecated.
+
 
 Other changes
 .............
diff --git a/mps/manual/source/topic/arena.rst b/mps/manual/source/topic/arena.rst
index ba46a746b6f..0aed4a1b582 100644
--- a/mps/manual/source/topic/arena.rst
+++ b/mps/manual/source/topic/arena.rst
@@ -15,8 +15,10 @@ An arena is an object that encapsulates the state of the Memory Pool
 System, and tells it where to get the memory it manages. You typically
 start a session with the MPS by creating an arena with
 :c:func:`mps_arena_create_k` and end the session by destroying it with
-:c:func:`mps_arena_destroy`. The only function you might need to call
-before making an arena is :c:func:`mps_telemetry_control`.
+:c:func:`mps_arena_destroy`. The only functions you might need to call
+before making an arena are :term:`telemetry` functions like
+:c:func:`mps_telemetry_set` and the :term:`plinth` function
+:c:func:`mps_lib_assert_fail_install`.
 
 Before destroying an arena, you must first destroy all objects and
 data in it, as usual for abstract data types in the MPS. If you can't
diff --git a/mps/manual/source/topic/deprecated.rst b/mps/manual/source/topic/deprecated.rst
index cb1cbc6d8f4..95da1a44d90 100644
--- a/mps/manual/source/topic/deprecated.rst
+++ b/mps/manual/source/topic/deprecated.rst
@@ -25,6 +25,15 @@ supported interface.
 Deprecated in version 1.115
 ...........................
 
+.. c:function:: mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
+
+    .. deprecated::
+
+        Identical to :c:func:`mps_ap_fill`, which should be used
+        instead. Formerly, this function gave the MPS permission to
+        draw on the ‘low-memory reservoir’, but this no longer exists.
+
+
 .. c:type:: typedef mps_pool_class_t mps_class_t
 
     .. deprecated::
@@ -118,6 +127,41 @@ Deprecated in version 1.115
     is the sum of allocated space and free space.
 
 
+.. c:function:: mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
+
+    .. deprecated::
+
+        Identical to :c:func:`mps_reserve`, which should be used
+        instead. Formerly, this function gave the MPS permission to
+        draw on the ‘low-memory reservoir’, but this no longer
+        exists.
+
+
+.. c:function:: void mps_reservoir_limit_set(mps_arena_t arena, size_t size)
+
+    .. deprecated::
+
+        Has no effect. Formerly, it updated the recommended size of
+        the ‘low-memory reservoir’, but this no longer exists.
+
+
+.. c:function:: size_t mps_reservoir_limit(mps_arena_t arena)
+
+    .. deprecated::
+
+        Returns zero. Formerly, it returned the recommended size of
+        the ‘low-memory reservoir’, but this no longer exists.
+
+
+.. c:function:: size_t mps_reservoir_available(mps_arena_t arena)
+
+    .. deprecated::
+
+        Returns zero. Formerly, it returned the size of the available
+        memory in the ‘low-memory reservoir’, but this no longer
+        exists.
+
+
 .. c:function:: mps_res_t mps_root_create_reg(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_reg_scan_t reg_scan, void *p, size_t s)
 
     .. deprecated::
@@ -275,16 +319,15 @@ Deprecated in version 1.115
 
     .. deprecated::
 
-        This function is equivalent to::
+        Use :c:func:`mps_root_create_area_tagged` instead, passing
+        zero for the ``pattern`` argument. This function is equivalent
+        to::
 
             mps_root_create_area_tagged(root_o, arena, rank, rm,
                                         base, base + size,
                                         mps_scan_area_tagged,
                                         mask, 0)
 
-        Use :c:func:`mps_root_create_area_masked` instead, passing
-        zero for the ``pattern`` argument.
-
     Register a :term:`root` that consists of a vector of :term:`tagged
     references` whose pattern is zero.
 
@@ -323,18 +366,12 @@ Deprecated in version 1.115
 
         :ref:`topic-scanning`.
 
-    .. note::
-
-        :term:`Client programs` are not expected to
-        write scanning functions of this type. The built-in MPS
-        function :c:func:`mps_stack_scan_ambig` must be used.
-
 
 .. c:function:: mps_reg_scan_t mps_stack_scan_ambig
 
     .. deprecated::
 
-        Use :c:func:`mps_root_create_thread` instead, passing
+        Use :c:func:`mps_root_create_thread_tagged` instead, passing
         ``sizeof(mps_word_t) - 1`` for the ``mask`` argument, and
         ``0`` for the ``pattern`` argument.
 
diff --git a/mps/manual/source/topic/finalization.rst b/mps/manual/source/topic/finalization.rst
index 7edadb9e3cc..c0648599ab2 100644
--- a/mps/manual/source/topic/finalization.rst
+++ b/mps/manual/source/topic/finalization.rst
@@ -194,7 +194,7 @@ Cautions
         are finalized is to maintain a table of :term:`weak
         references (1)` to all such objects. The weak references don't
         prevent the objects from being finalized, but you can iterate
-        over the list at an appropriate point and finalize any
+        over the table at an appropriate point and finalize any
         remaining objects yourself.
 
 #.  Not all :term:`pool classes` support finalization. In general, only
diff --git a/mps/manual/source/topic/format.rst b/mps/manual/source/topic/format.rst
index ec1f707aea3..ccf6c27ec65 100644
--- a/mps/manual/source/topic/format.rst
+++ b/mps/manual/source/topic/format.rst
@@ -243,11 +243,12 @@ Cautions
 
    a. call library code;
 
-   b. perform a non-local exit (for example, by calling ``longjmp``);
+   b. perform a non-local exit (for example, by throwing an exception,
+      or calling :c:func:`longjmp`);
 
-   c. call any functions in the MPS other than the fix functions
-      (:c:func:`mps_fix`, :c:func:`MPS_FIX1`, :c:func:`MPS_FIX12`, and
-      :c:func:`MPS_FIX2`).
+   c. call any functions or macros in the MPS other than the fix
+      macros :c:func:`MPS_FIX1`, :c:func:`MPS_FIX12`, and
+      :c:func:`MPS_FIX2`.
 
    It's permissible to call other functions in the client program, but
    see :c:func:`MPS_FIX_CALL` for a restriction on passing the
@@ -368,7 +369,7 @@ Format methods
         object format has a non-zero
         :c:macro:`MPS_KEY_FMT_HEADER_SIZE`.
 
-   .. note::
+    .. note::
 
         The MPS will ask for padding objects of any size aligned to
         the pool alignment, no matter what size objects the pool
diff --git a/mps/manual/source/topic/location.rst b/mps/manual/source/topic/location.rst
index fa928756a69..aa70a071683 100644
--- a/mps/manual/source/topic/location.rst
+++ b/mps/manual/source/topic/location.rst
@@ -77,8 +77,8 @@ the function :c:func:`mps_ld_reset`.
 
 .. note::
 
-    This means that it is not possible to statically create a location
-    dependency that has been reset.
+    It is not possible to statically create a location dependency that
+    has been reset.
 
 You can call :c:func:`mps_ld_reset` at any later point to clear all
 dependencies from the structure. For example, this is normally done
diff --git a/mps/manual/source/topic/plinth.rst b/mps/manual/source/topic/plinth.rst
index f771f6c1c31..e138cb60347 100644
--- a/mps/manual/source/topic/plinth.rst
+++ b/mps/manual/source/topic/plinth.rst
@@ -468,8 +468,8 @@ Library module
 
     A :term:`plinth` function to supply a default value for the
     :term:`telemetry filter` from the environment. See
-    :c:func:`mps_telemetry_control` for more information on the
-    significant of the value.
+    :envvar:`MPS_TELEMETRY_CONTROL` for more information on the
+    significance of the value.
 
     Returns the default value of the telemetry filter, as derived from
     the environment. It is recommended that the environment be
diff --git a/mps/manual/source/topic/porting.rst b/mps/manual/source/topic/porting.rst
index 0d04c04f3a4..571e7dc9b09 100644
--- a/mps/manual/source/topic/porting.rst
+++ b/mps/manual/source/topic/porting.rst
@@ -66,9 +66,8 @@ usable.
 
    There is a generic implementation in ``protan.c``, which can't
    provide memory protection, so it forces memory to be scanned until
-   that there is no further need to protect it. This means it can't
-   support incremental collection, and has no control over pause
-   times.
+   there is no further need to protect it. This means it can't support
+   incremental collection, and has no control over pause times.
 
 #. The **protection mutator context** module figures out what the
    :term:`mutator` was doing when it caused a :term:`protection
diff --git a/mps/manual/source/topic/telemetry.rst b/mps/manual/source/topic/telemetry.rst
index 2c9136ce7da..09445c9a66c 100644
--- a/mps/manual/source/topic/telemetry.rst
+++ b/mps/manual/source/topic/telemetry.rst
@@ -491,9 +491,10 @@ used in queries, for example:
     .. note::
 
         If the ``User`` event category is not turned on in the
-        :term:`telemetry filter` (via :c:func:`mps_telemetry_control`)
-        then the string is not sent to the telemetry stream. A label
-        is still returned in this case, but it is useless.
+        :term:`telemetry filter` (via :c:func:`mps_telemetry_set` or
+        :envvar:`MPS_TELEMETRY_CONTROL`) then the string is not sent
+        to the telemetry stream. A label is still returned in this
+        case, but it is useless.
 
 
 .. c:function:: void mps_telemetry_label(mps_addr_t addr, mps_label_t label)
@@ -512,8 +513,9 @@ used in queries, for example:
     .. note::
 
         If the ``User`` event category is not turned on in the
-        :term:`telemetry filter` (via :c:func:`mps_telemetry_control`)
-        then calling this function has no effect.
+        :term:`telemetry filter` (via :c:func:`mps_telemetry_set` or
+        :envvar:`MPS_TELEMETRY_CONTROL`) then calling this function
+        has no effect.
 
 
 .. index::
diff --git a/mps/manual/source/topic/thread.rst b/mps/manual/source/topic/thread.rst
index 0697daac301..e814fbe939a 100644
--- a/mps/manual/source/topic/thread.rst
+++ b/mps/manual/source/topic/thread.rst
@@ -44,8 +44,7 @@ access that memory. This means that threads must be registered with
 the MPS by calling :c:func:`mps_thread_reg` (and thread roots created;
 see :ref:`topic-root-thread`).
 
-For simplicity, we recommend that a thread must be registered with an
-:term:`arena` if:
+A thread must be registered with an :term:`arena` if:
 
 * its :term:`control stack` and :term:`registers` form a root (this is
   enforced by :c:func:`mps_root_create_thread`); or

From 88a58c88482a85719547fe4071bed042f9111739 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 13:27:05 +0100
Subject: [PATCH 14/31] Deprecation of reservoir functions was in release
 1.115.

Copied from Perforce
 Change: 192092
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/release.rst | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index db37e516ca3..fdf28461f50 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -112,6 +112,14 @@ Interface changes
 #. The :ref:`pool-snc` pool class now implements
    :c:func:`mps_pool_total_size` and :c:func:`mps_pool_free_size`.
 
+#. The (undocumented) reservoir functions
+   :c:func:`mps_ap_fill_with_reservoir_permit`,
+   :c:func:`mps_reservoir_available`, :c:func:`mps_reservoir_limit`,
+   :c:func:`mps_reservoir_limit_set`, and
+   :c:func:`mps_reserve_with_reservoir_permit`, together with the
+   ``has_reservoir_permit`` arguments to :c:func:`mps_sac_alloc` and
+   :c:func:`MPS_SAC_ALLOC_FAST` are now deprecated.
+
 
 Other changes
 .............
@@ -508,14 +516,6 @@ Interface changes
    ``dont-handle-bad-access`` or to request special handling of
    ``SIGBUS``.
 
-#. The (undocumented) reservoir functions
-   :c:func:`mps_ap_fill_with_reservoir_permit`,
-   :c:func:`mps_reservoir_available`, :c:func:`mps_reservoir_limit`,
-   :c:func:`mps_reservoir_limit_set`, and
-   :c:func:`mps_reserve_with_reservoir_permit`, together with the
-   ``has_reservoir_permit`` arguments to :c:func:`mps_sac_alloc` and
-   :c:func:`MPS_SAC_ALLOC_FAST` are deprecated.
-
 
 Other changes
 .............

From 55adbe705d50553cdc56c229487fbb7bcdb22cca Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 14:11:08 +0100
Subject: [PATCH 15/31] Fix assertion text in the manual.

Place a cross-reference by each assertion the appears in the manual, to assist in keeping the manual up to date.

Copied from Perforce
 Change: 192097
 ServerID: perforce.ravenbrook.com
---
 mps/code/buffer.c                 |  2 +-
 mps/code/dbgpool.c                |  8 ++++----
 mps/code/format.c                 |  6 +++---
 mps/code/global.c                 | 10 +++++-----
 mps/code/lockix.c                 |  6 +++---
 mps/code/lockli.c                 |  6 +++---
 mps/code/lockw3.c                 |  6 +++---
 mps/code/locus.c                  |  2 +-
 mps/code/mpsi.c                   |  6 +++---
 mps/code/poolams.c                |  2 +-
 mps/code/poolsnc.c                |  2 +-
 mps/code/seg.c                    |  2 +-
 mps/code/trace.c                  |  4 ++--
 mps/design/check.txt              | 14 +++++++++++++-
 mps/manual/source/topic/error.rst |  4 ++--
 15 files changed, 46 insertions(+), 34 deletions(-)

diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index a35b7b55a12..1c9cca6b7da 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -485,7 +485,7 @@ Res BufferReserve(Addr *pReturn, Buffer buffer, Size size)
   AVERT(Buffer, buffer);
   AVER(size > 0);
   AVER(SizeIsAligned(size, BufferPool(buffer)->alignment));
-  AVER(BufferIsReady(buffer));
+  AVER(BufferIsReady(buffer)); /* <design/check/#.common> */
 
   /* Is there enough room in the unallocated portion of the buffer to */
   /* satisfy the request?  If so, just increase the alloc marker and */
diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c
index 8068dc64b97..69b39650034 100644
--- a/mps/code/dbgpool.c
+++ b/mps/code/dbgpool.c
@@ -1,7 +1,7 @@
 /* dbgpool.c: POOL DEBUG MIXIN
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * .source: design.mps.object-debug
@@ -523,7 +523,7 @@ static void fenceFree(PoolDebugMixin debug,
 {
   Size alignedFenceSize, alignedSize;
 
-  ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free");
+  ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free"); /* <design/check/#.common> */
 
   alignedFenceSize = SizeAlignUp(debug->fenceSize, PoolAlignment(pool));
   alignedSize = SizeAlignUp(size, PoolAlignment(pool));
@@ -738,7 +738,7 @@ void DebugPoolFreeCheck(Pool pool, Addr base, Addr limit)
     AVERT(PoolDebugMixin, debug);
     if (debug->freeSize != 0)
       ASSERT(freeCheck(debug, pool, base, limit),
-             "free space corrupted on release");
+             "free space corrupted on release"); /* <design/check/#.common> */
   }
 }
 
@@ -784,7 +784,7 @@ void PoolClassMixInDebug(PoolClass klass)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/format.c b/mps/code/format.c
index fadeadce489..b9c4a59fb14 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -1,7 +1,7 @@
 /* format.c: OBJECT FORMATS
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (c) 2002 Global Graphics Software.
  *
  * DESIGN
@@ -168,7 +168,7 @@ Res FormatCreate(Format *formatReturn, Arena arena, ArgList args)
 void FormatDestroy(Format format)
 {
   AVERT(Format, format);
-  AVER(format->poolCount == 0);
+  AVER(format->poolCount == 0); /* <design/check/#.common> */
 
   RingRemove(&format->arenaRing);
 
@@ -250,7 +250,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/global.c b/mps/code/global.c
index 9fd8d7aeed8..02b2f04928e 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -464,12 +464,12 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
    * and so RingCheck dereferences a pointer into that unmapped memory
    * and we get a crash instead of an assertion. See job000652.
    */
-  AVER(RingIsSingle(&arena->formatRing));
-  AVER(RingIsSingle(&arena->chainRing));
+  AVER(RingIsSingle(&arena->formatRing)); /* <design/check/#.common> */
+  AVER(RingIsSingle(&arena->chainRing)); /* <design/check/#.common> */
   AVER(RingIsSingle(&arena->messageRing));
-  AVER(RingIsSingle(&arena->threadRing));
+  AVER(RingIsSingle(&arena->threadRing)); /* <design/check/#.common> */
   AVER(RingIsSingle(&arena->deadRing));
-  AVER(RingIsSingle(&arenaGlobals->rootRing));
+  AVER(RingIsSingle(&arenaGlobals->rootRing)); /* <design/check/#.common> */
   for(rank = RankMIN; rank < RankLIMIT; ++rank)
     AVER(RingIsSingle(&arena->greyRing[rank]));
 
@@ -479,7 +479,7 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
    * 2. arena->controlPoolStruct.blockPoolStruct
    * 3. arena->controlPoolStruct.spanPoolStruct
    */
-  AVER(RingLength(&arenaGlobals->poolRing) == 4);
+  AVER(RingLength(&arenaGlobals->poolRing) == 4); /* <design/check/#.common> */
 }
 
 
diff --git a/mps/code/lockix.c b/mps/code/lockix.c
index c982bf0cb17..d43e458f430 100644
--- a/mps/code/lockix.c
+++ b/mps/code/lockix.c
@@ -1,7 +1,7 @@
 /* lockix.c: RECURSIVE LOCKS FOR POSIX SYSTEMS
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .posix: The implementation uses a POSIX interface, and should be reusable
  * for many Unix-like operating systems.
@@ -122,7 +122,7 @@ void (LockClaim)(Lock lock)
 
   res = pthread_mutex_lock(&lock->mut);
   /* pthread_mutex_lock will error if we own the lock already. */
-  AVER(res == 0);
+  AVER(res == 0); /* <design/check/#.common> */
 
   /* This should be the first claim.  Now we own the mutex */
   /* it is ok to check this. */
@@ -245,7 +245,7 @@ void (LockReleaseGlobal)(void)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/lockli.c b/mps/code/lockli.c
index 0dc98fb8a25..a3369abda90 100644
--- a/mps/code/lockli.c
+++ b/mps/code/lockli.c
@@ -1,7 +1,7 @@
 /* lockli.c: RECURSIVE LOCKS FOR POSIX SYSTEMS
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .linux: This implementation currently just supports LinuxThreads
  * (platform MPS_OS_LI), Single Unix i/f.
@@ -136,7 +136,7 @@ void (LockClaim)(Lock lock)
 
   res = pthread_mutex_lock(&lock->mut);
   /* pthread_mutex_lock will error if we own the lock already. */
-  AVER(res == 0);
+  AVER(res == 0); /* <design/check/#.common> */
 
   /* This should be the first claim.  Now we own the mutex */
   /* it is ok to check this. */
@@ -259,7 +259,7 @@ void (LockReleaseGlobal)(void)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/lockw3.c b/mps/code/lockw3.c
index 53da970aed2..daf2473d4e3 100644
--- a/mps/code/lockw3.c
+++ b/mps/code/lockw3.c
@@ -1,7 +1,7 @@
 /* lockw3.c: RECURSIVE LOCKS IN WIN32
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .design: These are implemented using critical sections.
  *  See the section titled "Synchronization functions" in the Groups
@@ -75,7 +75,7 @@ void (LockClaim)(Lock lock)
   EnterCriticalSection(&lock->cs);
   /* This should be the first claim.  Now we are inside the
    * critical section it is ok to check this. */
-  AVER(lock->claims == 0);
+  AVER(lock->claims == 0); /* <design/check/#.common> */
   lock->claims = 1;
 }
 
@@ -158,7 +158,7 @@ void (LockReleaseGlobal)(void)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/locus.c b/mps/code/locus.c
index 4e68cbcb8c8..30f8e4a5076 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -269,7 +269,7 @@ void ChainDestroy(Chain chain)
   size_t i;
 
   AVERT(Chain, chain);
-  AVER(chain->activeTraces == TraceSetEMPTY);
+  AVER(chain->activeTraces == TraceSetEMPTY); /* <design/check/#.common> */
 
   arena = chain->arena;
   genCount = chain->genCount;
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index 2bc48179b3a..080b660fac3 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -1,7 +1,7 @@
 /* mpsi.c: MEMORY POOL SYSTEM C INTERFACE LAYER
  *
  * $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (c) 2002 Global Graphics Software.
  *
  * .purpose: This code bridges between the MPS interface to C,
@@ -1060,7 +1060,7 @@ mps_res_t mps_ap_fill(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
   AVER(p_o != NULL);
   AVERT(Buffer, buf);
   AVER(size > 0);
-  AVER(SizeIsAligned(size, BufferPool(buf)->alignment));
+  AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); /* <design/check/#.common> */
 
   res = BufferFill(&p, buf, size);
 
@@ -2141,7 +2141,7 @@ void _mps_args_set_key(mps_arg_s args[MPS_ARGS_MAX], unsigned i,
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/poolams.c b/mps/code/poolams.c
index 8218fa53f81..96a82628d60 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -1491,7 +1491,7 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   case RankFINAL:
   case RankWEAK:
     AVER_CRITICAL(AddrIsAligned(base, PoolAlignment(pool)));
-    AVER_CRITICAL(AMS_ALLOCED(seg, i));
+    AVER_CRITICAL(AMS_ALLOCED(seg, i)); /* <design/check/#.common> */
     if (AMS_IS_WHITE(seg, i)) {
       ss->wasMarked = FALSE;
       if (ss->rank == RankWEAK) { /* then splat the reference */
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index db0cb5f6173..ae8f11d64aa 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -564,7 +564,7 @@ static Res SNCFramePop(Pool pool, Buffer buf, AllocFrame frame)
     arena = PoolArena(pool);
     addr = (Addr)frame;
     foundSeg = SegOfAddr(&seg, arena, addr);
-    AVER(foundSeg);
+    AVER(foundSeg); /* <design/check/#.common> */
     AVER(SegPool(seg) == pool);
 
     if (SegBuffer(seg) == buf) {
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 88b34fe6e55..fe52b961898 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -1086,7 +1086,7 @@ static void gcSegFinish(Seg seg)
   gcseg->sig = SigInvalid;
 
   /* Don't leave a dangling buffer allocating into hyperspace. */
-  AVER(gcseg->buffer == NULL);
+  AVER(gcseg->buffer == NULL); /* <design/check/#.common> */
 
   RingFinish(&gcseg->greyRing);
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 02c04e4b841..cd056b1a178 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1178,7 +1178,7 @@ static Res traceScanSegRes(TraceSet ts, Rank rank, Arena arena, Seg seg)
     /* .verify.segsummary: were the seg contents, as found by this 
      * scan, consistent with the recorded SegSummary?
      */
-    AVER(RefSetSub(ScanStateUnfixedSummary(ss), SegSummary(seg)));
+    AVER(RefSetSub(ScanStateUnfixedSummary(ss), SegSummary(seg))); /* <design/check/#.common> */
 
     /* Write barrier deferral -- see design.mps.write-barrier.deferral. */
     /* Did the segment refer to the white set? */
@@ -1373,7 +1373,7 @@ mps_res_t _mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
   if (!BTGet(chunk->allocTable, i)) {
     /* Reference points into a chunk but not to an allocated tract.
      * See <design/trace/#exact.legal> */
-    AVER_CRITICAL(ss->rank < RankEXACT);
+    AVER_CRITICAL(ss->rank < RankEXACT); /* <design/check/#.common> */
     goto done;
   }
 
diff --git a/mps/design/check.txt b/mps/design/check.txt
index 2cf5bf091c6..7f89027c5b4 100644
--- a/mps/design/check.txt
+++ b/mps/design/check.txt
@@ -122,6 +122,18 @@ reference this tag. The structure could be considered for addition to
 ``mpmst.h``.
 
 
+Common assertions
+-----------------
+
+_`.common`: Some assertions are commonly triggered by mistakes in the
+:term:`client program`. These are listed in the section "Common
+assertions and their causes" in the MPS Reference, together with an
+explanation of their likely cause, and advice for fixing the problem.
+To assist with keeping the MPS Reference up to date, these assertions
+are marked with a cross-reference to this tag. When you update the
+assertion, you must also update the MPS Reference.
+
+
 Document History
 ----------------
 
@@ -138,7 +150,7 @@ Document History
 Copyright and License
 ---------------------
 
-Copyright © 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+Copyright © 2013-2016 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/manual/source/topic/error.rst b/mps/manual/source/topic/error.rst
index 796edda1699..b47e24858e5 100644
--- a/mps/manual/source/topic/error.rst
+++ b/mps/manual/source/topic/error.rst
@@ -286,7 +286,7 @@ this documentation.
     It is necessary to call :c:func:`mps_fmt_destroy` first.
 
 
-``global.c: RingIsSingle(&arena->rootRing)``
+``global.c: RingIsSingle(&arenaGlobals->rootRing)``
 
     The client program called :c:func:`mps_arena_destroy` without
     destroying all the :term:`roots` belonging to the arena.
@@ -300,7 +300,7 @@ this documentation.
     It is necessary to call :c:func:`mps_thread_dereg` first.
 
 
-``global.c: RingLength(&arenaGlobals->poolRing) == 5``
+``global.c: RingLength(&arenaGlobals->poolRing) == 4``
 
     The client program called :c:func:`mps_arena_destroy` without
     destroying all the :term:`pools` belonging to the arena.

From 4ead68befc51c80b5d88b4b51be954de594b3b8d Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 19:07:45 +0100
Subject: [PATCH 16/31] Fix glossary references.

Copied from Perforce
 Change: 192102
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/topic/arena.rst | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/mps/manual/source/topic/arena.rst b/mps/manual/source/topic/arena.rst
index 0aed4a1b582..f1386781572 100644
--- a/mps/manual/source/topic/arena.rst
+++ b/mps/manual/source/topic/arena.rst
@@ -16,7 +16,7 @@ System, and tells it where to get the memory it manages. You typically
 start a session with the MPS by creating an arena with
 :c:func:`mps_arena_create_k` and end the session by destroying it with
 :c:func:`mps_arena_destroy`. The only functions you might need to call
-before making an arena are :term:`telemetry` functions like
+before making an arena are :term:`telemetry system` functions like
 :c:func:`mps_telemetry_set` and the :term:`plinth` function
 :c:func:`mps_lib_assert_fail_install`.
 
@@ -472,8 +472,8 @@ Arena properties
     When the pause time is short, the MPS needs to take more slices of
     time in order to make :term:`garbage collection` progress, and
     make more use of :term:`barriers (1)` to support
-    :term:`incremental collection`.  This increases time overheads,
-    and especially operating system overheads.
+    :term:`incremental garbage collection`. This increases time
+    overheads, and especially operating system overheads.
 
     The pause time may be set to zero, in which case the MPS returns
     as soon as it can, without regard for overall efficiency.  This
@@ -487,7 +487,7 @@ Arena properties
     The pause time may be set to infinity, in which case the MPS
     completes all outstanding :term:`garbage collection` work before
     returning from an operation. The consequence is that the MPS will
-    be able to save on the overheads due to :term:`incremental
+    be able to save on the overheads due to :term:`incremental garbage
     collection`, leading to lower total time spent in collection. This
     value is suitable for non-interactive applications where total
     time is important.

From 1d4cfd56b3653080169b816bb9422ef2a83025e9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 19:08:13 +0100
Subject: [PATCH 17/31] Index regexp needs multiline flag.

Copied from Perforce
 Change: 192103
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/extensions/mps/designs.py | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/mps/manual/source/extensions/mps/designs.py b/mps/manual/source/extensions/mps/designs.py
index 234e99d2c94..ff532d63a92 100644
--- a/mps/manual/source/extensions/mps/designs.py
+++ b/mps/manual/source/extensions/mps/designs.py
@@ -83,7 +83,8 @@ def citation_sub(m):
         fmt += ' "{title}".'
     return fmt.format(**groups)
 
-index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)', re.IGNORECASE)
+index = re.compile(r'^:Index\s+terms:(.*$\n(?:[ \t]+.*$\n)*)',
+                   re.MULTILINE | re.IGNORECASE)
 
 # <http://sphinx-doc.org/markup/misc.html#directive-index>
 index_term = re.compile(r'^\s*(\w+):\s*(.*?)\s*$', re.MULTILINE)

From 7d5e5ac0e0ed17149515b6b785b0d2f09f6e0b83 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Sep 2016 19:20:58 +0100
Subject: [PATCH 18/31] Avoid strict aliasing errors in the mps test suite, so
 that it compiles and runs using gcc 6.1.

Update the manual entries for mps_alloc and mps_sac_alloc with notes highlighting the problem.

Copied from Perforce
 Change: 192104
 ServerID: perforce.ravenbrook.com
---
 mps/code/apss.c                        | 13 +++++----
 mps/code/fotest.c                      |  9 ++++--
 mps/code/mpmss.c                       | 13 +++++----
 mps/code/mv2test.c                     | 18 +++++++-----
 mps/code/sacss.c                       | 15 ++++++----
 mps/manual/source/topic/allocation.rst | 14 +++++++++
 mps/manual/source/topic/cache.rst      | 40 +++++++++++++++-----------
 7 files changed, 80 insertions(+), 42 deletions(-)

diff --git a/mps/code/apss.c b/mps/code/apss.c
index fbe58f249df..0e855b07733 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -1,7 +1,7 @@
 /* apss.c: AP MANUAL ALLOC STRESS TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  */
 
@@ -77,11 +77,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
 
   /* allocate a load of objects */
   for (i=0; i<testSetSIZE; ++i) {
+    mps_addr_t obj;
     ss[i] = (*size)(i, align);
-
-    res = make((mps_addr_t *)&ps[i], ap, ss[i]);
+    res = make(&obj, ap, ss[i]);
     if (res != MPS_RES_OK)
       goto allocFail;
+    ps[i] = obj;
     allocated += ss[i] + debugOverhead;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
@@ -121,10 +122,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
+      mps_addr_t obj;
       ss[i] = (*size)(i, align);
-      res = make((mps_addr_t *)&ps[i], ap, ss[i]);
+      res = make(&obj, ap, ss[i]);
       if (res != MPS_RES_OK)
         goto allocFail;
+      ps[i] = obj;
       allocated += ss[i] + debugOverhead;
     }
     check_allocated_size(pool, ap, allocated);
@@ -259,7 +262,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/fotest.c b/mps/code/fotest.c
index 09ba0a2d8db..61f1d8745a4 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -88,11 +88,12 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
 
   /* allocate a load of objects */
   for (i=0; i<testSetSIZE; ++i) {
+    mps_addr_t obj;
     ss[i] = (*size)(i, alignment);
-
-    res = make((mps_addr_t *)&ps[i], ap, ss[i]);
+    res = make(&obj, ap, ss[i]);
     if (res != MPS_RES_OK)
       goto allocFail;
+    ps[i] = obj;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
   }
@@ -118,10 +119,12 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
+      mps_addr_t obj;
       ss[i] = (*size)(i, alignment);
-      res = make((mps_addr_t *)&ps[i], ap, ss[i]);
+      res = make(&obj, ap, ss[i]);
       if (res != MPS_RES_OK)
         goto allocFail;
+      ps[i] = obj;
     }
 
     CLASS_STATIC(MFSPool).alloc = rnd() % 2 ? mfs_alloc : oomAlloc;
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 31616425a65..2e1d9f970c0 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -1,7 +1,7 @@
 /* mpmss.c: MPM STRESS TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  */
 
@@ -57,11 +57,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
 
   /* allocate a load of objects */
   for (i=0; i<testSetSIZE; ++i) {
+    mps_addr_t obj;
     ss[i] = (*size)(i);
-
-    res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
+    res = mps_alloc(&obj, pool, ss[i]);
     if (res != MPS_RES_OK)
       return res;
+    ps[i] = obj;
     allocated += alignUp(ss[i], align) + debugOverhead;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
@@ -93,10 +94,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
+      mps_addr_t obj;
       ss[i] = (*size)(i);
-      res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
+      res = mps_alloc(&obj, pool, ss[i]);
       if (res != MPS_RES_OK)
         return res;
+      ps[i] = obj;
       allocated += alignUp(ss[i], align) + debugOverhead;
     }
     check_allocated_size(pool, allocated);
@@ -241,7 +244,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/mv2test.c b/mps/code/mv2test.c
index 4670abbf076..a47a520af7f 100644
--- a/mps/code/mv2test.c
+++ b/mps/code/mv2test.c
@@ -1,7 +1,7 @@
 /* mv2test.c: POOLMVT STRESS TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  */
 
 #include <math.h>
@@ -102,13 +102,15 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
 
   /* allocate a load of objects */
   for(i=0; i<TEST_SET_SIZE; ++i) {
+    mps_addr_t obj;
     ss[i] = (*size)(i);
-
-    res = make((mps_addr_t *)&ps[i], ap, ss[i], align);
-    if(res != MPS_RES_OK)
+    res = make(&obj, ap, ss[i], align);
+    if (res != MPS_RES_OK) {
       ss[i] = 0;
-    else
+    } else {
+      ps[i]= obj;
       *ps[i] = 1; /* Write something, so it gets swap. */
+    }
 
     if (verbose) {
       if (i && i%4==0)
@@ -146,10 +148,12 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
     }
     /* allocate some new objects */
     for(i=x; i<TEST_SET_SIZE; ++i) {
+      mps_addr_t obj;
       size_t s = (*size)(i);
-      res = make((mps_addr_t *)&ps[i], ap, s, align);
+      res = make(&obj, ap, s, align);
       if(res != MPS_RES_OK)
         break;
+      ps[i] = obj;      
       ss[i] = s;
      
       if (verbose) {
@@ -218,7 +222,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/sacss.c b/mps/code/sacss.c
index d85b3ae5073..59550490910 100644
--- a/mps/code/sacss.c
+++ b/mps/code/sacss.c
@@ -1,7 +1,7 @@
 /* sacss.c: SAC MANUAL ALLOC STRESS TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  */
 
@@ -74,11 +74,12 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
 
   /* allocate a load of objects */
   for (i = 0; i < testSetSIZE; ++i) {
+    mps_addr_t obj;
     ss[i] = (*size)(i);
-
-    res = make((mps_addr_t *)&ps[i], sac, ss[i]);
+    res = make(&obj, sac, ss[i]);
     if (res != MPS_RES_OK)
       return res;
+    ps[i] = obj;
     if (ss[i] >= sizeof(ps[i]))
       *ps[i] = 1; /* Write something, so it gets swap. */
   }
@@ -113,17 +114,19 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
     }
     /* allocate some new objects */
     for (i=testSetSIZE/2; i<testSetSIZE; ++i) {
+      mps_addr_t obj;
       ss[i] = (*size)(i);
       switch (k % 2) {
       case 0:
-        res = make((mps_addr_t *)&ps[i], sac, ss[i]);
+        res = make(&obj, sac, ss[i]);
         break;
       default:
-        res = mps_sac_alloc((mps_addr_t *)&ps[i], sac, ss[i], FALSE);
+        res = mps_sac_alloc(&obj, sac, ss[i], FALSE);
         break;
       }
       if (res != MPS_RES_OK)
         return res;
+      ps[i] = obj;
     }
   }
    
@@ -246,7 +249,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/manual/source/topic/allocation.rst b/mps/manual/source/topic/allocation.rst
index 445f9c4583e..bab89bc2d79 100644
--- a/mps/manual/source/topic/allocation.rst
+++ b/mps/manual/source/topic/allocation.rst
@@ -45,6 +45,20 @@ Manual allocation
     unaligned, it will be rounded up to the pool's :term:`alignment`
     (unless the pool documentation says otherwise).
 
+    .. note::
+
+        It is tempting to call :c:func:`mps_alloc` with a cast from
+        the desired pointer type to ``mps_addr_t *``, like this::
+
+            my_object *obj;
+            res = mps_alloc((mps_addr_t *)&obj, pool, sizeof *p);
+            if (res != MPS_RES_OK)
+                error(...);
+
+        but this is :term:`type punning`, and its behaviour is not
+        defined in ANSI/ISO Standard C. See :ref:`topic-interface-pun`
+        for more details.
+
 
 .. c:function:: void mps_free(mps_pool_t pool, mps_addr_t addr, size_t size)
 
diff --git a/mps/manual/source/topic/cache.rst b/mps/manual/source/topic/cache.rst
index d4446d7a97b..041c2d22ab4 100644
--- a/mps/manual/source/topic/cache.rst
+++ b/mps/manual/source/topic/cache.rst
@@ -285,26 +285,34 @@ Allocation interface
 
     .. note::
 
-        There's also a macro :c:func:`MPS_SAC_ALLOC_FAST` that does
-        the same thing. The macro is faster, but generates more code
-        and does less checking.
+        1. There's also a macro :c:func:`MPS_SAC_ALLOC_FAST` that does
+           the same thing. The macro is faster, but generates more
+           code and does less checking.
 
-    .. note::
+        2. The :term:`client program` is responsible for synchronizing
+           the access to the cache, but if the cache decides to access
+           the pool, the MPS will properly synchronize with any other
+           :term:`threads` that might be accessing the same pool.
 
-        The :term:`client program` is responsible for synchronizing
-        the access to the cache, but if the cache decides to access
-        the pool, the MPS will properly synchronize with any other
-        :term:`threads` that might be accessing the same
-        pool.
+        3. Blocks allocated through a segregated allocation cache
+           should only be freed through a segregated allocation cache
+           with the same class structure. Calling :c:func:`mps_free`
+           on them can cause :term:`memory leaks`, because the size of
+           the block might be larger than you think. Naturally, the
+           cache must also be attached to the same pool.
 
-    .. note::
+        4. It is tempting to call :c:func:`mps_sac_alloc` with a cast
+           from the desired pointer type to ``mps_addr_t *``, like
+           this::
 
-        Blocks allocated through a segregated allocation cache should
-        only be freed through a segregated allocation cache with the
-        same class structure. Calling :c:func:`mps_free` on them can
-        cause :term:`memory leaks`, because the size of
-        the block might be larger than you think. Naturally, the cache
-        must also be attached to the same pool.
+               my_object *obj;
+               res = mps_alloc((mps_addr_t *)&obj, sac, sizeof *p, 0);
+               if (res != MPS_RES_OK)
+                   error(...);
+
+           but this is :term:`type punning`, and its behaviour is not
+           defined in ANSI/ISO Standard C. See
+           :ref:`topic-interface-pun` for more details.
 
 
 .. c:function:: MPS_SAC_ALLOC_FAST(mps_res_t res_v, mps_addr_t *p_v, mps_sac_t sac, size_t size, mps_bool_t has_reservoir_permit)

From 89b1b02ee59fca3d28dac41a8e898cf4ef4f4330 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 11:56:09 +0100
Subject: [PATCH 19/31] Add a case for rootthread to rootcheck.

Add test coverage for mps_root_create_thread_scanned and mps_root_create_area; improve coverage for mps_root_create_area_tagged, mps_scan_area_tagged, mps_scan_area.

Copied from Perforce
 Change: 192111
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpsicv.c | 52 ++++++++++++++++++++++++++++++++++++-----------
 mps/code/root.c   |  8 ++++++++
 2 files changed, 48 insertions(+), 12 deletions(-)

diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c
index d026f2cd684..d1a9759a3b8 100644
--- a/mps/code/mpsicv.c
+++ b/mps/code/mpsicv.c
@@ -1,7 +1,7 @@
 /* mpsicv.c: MPSI COVERAGE TEST
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (c) 2002 Global Graphics Software.
  */
 
@@ -338,7 +338,8 @@ static void *test(void *arg, size_t s)
   mps_arena_t arena;
   mps_fmt_t format;
   mps_chain_t chain;
-  mps_root_t exactRoot, ambigRoot, singleRoot, fmtRoot;
+  mps_root_t exactAreaRoot, exactTableRoot, ambigAreaRoot, ambigTableRoot,
+    singleRoot, fmtRoot;
   unsigned long i;
   /* Leave arena clamped until we have allocated this many objects.
      is 0 when arena has not been clamped. */
@@ -386,14 +387,29 @@ static void *test(void *arg, size_t s)
     ambigRoots[j] = rnd_addr();
   }
 
-  die(mps_root_create_table_masked(&exactRoot, arena,
+  die(mps_root_create_area_tagged(&exactAreaRoot, arena,
+                                  mps_rank_exact(), (mps_rm_t)0,
+                                  &exactRoots[0],
+                                  &exactRoots[exactRootsCOUNT / 2],
+                                  mps_scan_area_tagged,
+                                  MPS_WORD_CONST(1), 0),
+      "root_create_area_tagged(exact)");
+  die(mps_root_create_table_masked(&exactTableRoot, arena,
                                    mps_rank_exact(), (mps_rm_t)0,
-                                   &exactRoots[0], exactRootsCOUNT,
+                                   &exactRoots[exactRootsCOUNT / 2],
+                                   (exactRootsCOUNT + 1) / 2,
                                    MPS_WORD_CONST(1)),
-      "root_create_table(exact)");
-  die(mps_root_create_table(&ambigRoot, arena,
+      "root_create_table_masked(exact)");
+  die(mps_root_create_area(&ambigAreaRoot, arena,
+                           mps_rank_ambig(), (mps_rm_t)0,
+                           &ambigRoots[0],
+                           &ambigRoots[ambigRootsCOUNT / 2],
+                           mps_scan_area, NULL),
+      "root_create_area(ambig)");
+  die(mps_root_create_table(&ambigTableRoot, arena,
                             mps_rank_ambig(), (mps_rm_t)0,
-                            &ambigRoots[0], ambigRootsCOUNT),
+                            &ambigRoots[ambigRootsCOUNT / 2],
+                            (ambigRootsCOUNT + 1) / 2),
       "root_create_table(ambig)");
 
   obj = objNULL;
@@ -519,8 +535,10 @@ static void *test(void *arg, size_t s)
   mps_ap_destroy(ap);
   mps_root_destroy(fmtRoot);
   mps_root_destroy(singleRoot);
-  mps_root_destroy(exactRoot);
-  mps_root_destroy(ambigRoot);
+  mps_root_destroy(exactAreaRoot);
+  mps_root_destroy(exactTableRoot);
+  mps_root_destroy(ambigAreaRoot);
+  mps_root_destroy(ambigTableRoot);
   mps_pool_destroy(amcpool);
   mps_chain_destroy(chain);
   mps_fmt_destroy(format);
@@ -551,15 +569,25 @@ int main(int argc, char *argv[])
   } MPS_ARGS_END(args);
   die(mps_thread_reg(&thread, arena), "thread_reg");
 
-  if (rnd() % 2) {
+  switch (rnd() % 3) {
+  default:
+  case 0:
     die(mps_root_create_reg(&reg_root, arena,
                             mps_rank_ambig(), (mps_rm_t)0,
                             thread, &mps_stack_scan_ambig,
                             marker, (size_t)0),
         "root_create_reg");
-  } else {
+    break;
+  case 1:
     die(mps_root_create_thread(&reg_root, arena, thread, marker),
         "root_create_thread");
+    break;
+  case 2:
+    die(mps_root_create_thread_scanned(&reg_root, arena, mps_rank_ambig(),
+                                       (mps_rm_t)0, thread, mps_scan_area,
+                                       NULL, marker),
+        "root_create_thread");
+    break;
   }
 
   mps_tramp(&r, test, arena, 0);
@@ -574,7 +602,7 @@ int main(int argc, char *argv[])
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (c) 2001-2016 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/root.c b/mps/code/root.c
index c241430ab63..e6322a60d9b 100644
--- a/mps/code/root.c
+++ b/mps/code/root.c
@@ -129,6 +129,14 @@ Bool RootCheck(Root root)
        scan. */
     break;
 
+  case RootTHREAD:
+    CHECKD_NOSIG(Thread, root->the.thread.thread); /* <design/check/#hidden-type> */
+    CHECKL(FUNCHECK(root->the.thread.scan_area));
+    /* Can't check anything about closure as it could mean anything to
+       scan_area. */
+    /* Can't check anything about stackCold. */
+    break;
+
   case RootTHREAD_TAGGED:
     CHECKD_NOSIG(Thread, root->the.thread.thread); /* <design/check/#hidden-type> */
     CHECKL(FUNCHECK(root->the.thread.scan_area));

From 05a43727e254aa534413175945314fb569051e03 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 12:15:34 +0100
Subject: [PATCH 20/31] Fix type punning examples.

Copied from Perforce
 Change: 192116
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/topic/allocation.rst | 2 +-
 mps/manual/source/topic/cache.rst      | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/mps/manual/source/topic/allocation.rst b/mps/manual/source/topic/allocation.rst
index bab89bc2d79..08f33d08771 100644
--- a/mps/manual/source/topic/allocation.rst
+++ b/mps/manual/source/topic/allocation.rst
@@ -51,7 +51,7 @@ Manual allocation
         the desired pointer type to ``mps_addr_t *``, like this::
 
             my_object *obj;
-            res = mps_alloc((mps_addr_t *)&obj, pool, sizeof *p);
+            res = mps_alloc((mps_addr_t *)&obj, pool, sizeof *obj);
             if (res != MPS_RES_OK)
                 error(...);
 
diff --git a/mps/manual/source/topic/cache.rst b/mps/manual/source/topic/cache.rst
index 041c2d22ab4..1d722049776 100644
--- a/mps/manual/source/topic/cache.rst
+++ b/mps/manual/source/topic/cache.rst
@@ -306,7 +306,7 @@ Allocation interface
            this::
 
                my_object *obj;
-               res = mps_alloc((mps_addr_t *)&obj, sac, sizeof *p, 0);
+               res = mps_alloc((mps_addr_t *)&obj, sac, sizeof *obj, 0);
                if (res != MPS_RES_OK)
                    error(...);
 

From 5c7dee4d28843630ffbc266ab0251ddffb4b94b4 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 12:20:37 +0100
Subject: [PATCH 21/31] Update release notes for job004036 and job004037.

Copied from Perforce
 Change: 192117
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/release.rst | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index fdf28461f50..51b487fe04e 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -36,6 +36,15 @@ Other changes
 
    .. _job004011: https://www.ravenbrook.com/project/mps/issue/job004011/
 
+#. Roots created by :c:func:`mps_root_create_thread_scanned` no longer
+   cause an assertion failure. See job004036_.
+
+   .. _job004036: https://www.ravenbrook.com/project/mps/issue/job004036/
+
+#. The MPS test suite now compiles and passes with GCC 6.1. See job004037_.
+
+   .. _job004037: https://www.ravenbrook.com/project/mps/issue/job004037/
+
 
 .. _release-notes-1.115:
 

From 08bd2f3474fd48b638406185828b1b2005ac6e55 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 13:55:39 +0100
Subject: [PATCH 22/31] New preprocessor constants config_pthreadext_sigsuspend
 and config_pthreadext_sigresume for configuring the signals used to suspend
 and resume threads.

Copied from Perforce
 Change: 192122
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h                  | 23 +++++++++++++++++++++
 mps/code/pthrdext.c                | 13 ++----------
 mps/design/config.txt              | 10 +++++++++
 mps/design/pthreadext.txt          | 17 ++++++++++-----
 mps/manual/source/release.rst      |  3 +++
 mps/manual/source/topic/thread.rst | 33 +++++++++++++++++++++---------
 6 files changed, 73 insertions(+), 26 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index b5a5b6d1a93..7e3d2ac5461 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -610,6 +610,29 @@
 #endif
 
 
+/* POSIX thread extensions configuration -- see <code/pthrdext.c> */
+
+#if defined(MPS_OS_LI) || defined(MPS_OS_FR)
+
+/* PTHREADEXT_SIGSUSPEND -- signal used to suspend a thread
+ * See <design/pthreadext/#impl.signals>
+ */
+#if defined(CONFIG_PTHREADEXT_SIGSUSPEND)
+#define PTHREADEXT_SIGSUSPEND CONFIG_PTHREADEXT_SIGSUSPEND
+#else
+#define PTHREADEXT_SIGSUSPEND SIGXFSZ
+#endif
+
+/* PTHREADEXT_SIGRESUME -- signal used to resume a thread
+ * See <design/pthreadext/#impl.signals>
+ */
+#if defined(CONFIG_PTHREADEXT_SIGRESUME)
+#define PTHREADEXT_SIGRESUME CONFIG_PTHREADEXT_SIGRESUME
+#else
+#define PTHREADEXT_SIGRESUME SIGXCPU
+#endif
+
+#endif
 
 
 /* Tracer Configuration -- see <code/trace.c> */
diff --git a/mps/code/pthrdext.c b/mps/code/pthrdext.c
index 59d5899c326..19f39c0b470 100644
--- a/mps/code/pthrdext.c
+++ b/mps/code/pthrdext.c
@@ -1,7 +1,7 @@
 /* pthreadext.c: POSIX THREAD EXTENSIONS
  *
  *  $Id$
- *  Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ *  Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .purpose: Provides extension to Pthreads.
  *
@@ -28,15 +28,6 @@
 SRCID(pthreadext, "$Id$");
 
 
-/* PTHREADEXT_SIGSUSPEND, PTHREADEXT_SIGRESUME -- signals used
- *
- * See <design/pthreadext/#impl.signals>
- */
-
-#define PTHREADEXT_SIGSUSPEND SIGXFSZ
-#define PTHREADEXT_SIGRESUME SIGXCPU
-
-
 /* Static data initialized on first use of the module
  * See <design/pthreadext/#impl.static>.*
  */
@@ -366,7 +357,7 @@ unlock:
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/design/config.txt b/mps/design/config.txt
index 544b9a61ed1..458ccdfe890 100644
--- a/mps/design/config.txt
+++ b/mps/design/config.txt
@@ -550,6 +550,16 @@ happen if requested explicitly via ``mps_arena_collect()`` or
 ``mps_arena_step()``, but it also means that protection is not needed,
 and so shield operations can be replaced with no-ops in ``mpm.h``.
 
+_`.opt.signal.suspend`: ``CONFIG_PTHREADEXT_SIGSUSPEND`` names the
+signal used to suspend a thread, on platforms using the POSIX thread
+extensions module. See design.pthreadext.impl.signals_.
+
+.. _design.pthreadext.impl.signals: pthreadext#impl.signals
+
+_`.opt.signal.resume`: ``CONFIG_PTHREADEXT_SIGRESUME`` names the
+signal used to resume a thread, on platforms using the POSIX thread
+extensions module. See design.pthreadext.impl.signals_.
+
 
 To document
 -----------
diff --git a/mps/design/pthreadext.txt b/mps/design/pthreadext.txt
index b2d886b75a5..2f05c7413c9 100644
--- a/mps/design/pthreadext.txt
+++ b/mps/design/pthreadext.txt
@@ -324,10 +324,17 @@ likely to be generated and/or handled by other parts of the
 application and so should not be used (for example, ``SIGSEGV``). Some
 implementations of PThreads use some signals for themselves, so they
 may not be used; for example, LinuxThreads uses ``SIGUSR1`` and
-``SIGUSR2`` for its own purposes. The design abstractly names the
-signals ``PTHREADEXT_SIGSUSPEND`` and ``PTHREAD_SIGRESUME``, so that
-they may be easily mapped to appropriate real signal values. Candidate
-choices are ``SIGXFSZ`` and ``SIGPWR``.
+``SIGUSR2`` for its own purposes, and so do popular tools like
+Valgrind that we would like to be compatible with the MPS. The design
+therefore abstractly names the signals ``PTHREADEXT_SIGSUSPEND`` and
+``PTHREAD_SIGRESUME``, so that they may be easily mapped to
+appropriate real signal values. Candidate choices are ``SIGXFSZ`` and
+``SIGXCPU``.
+
+_`.impl.signals.config`: The identity of the signals used to suspend
+and resume threads can be configured at compilation time using the
+preprocessor constants ``CONFIG_PTHREADEXT_SIGSUSPEND`` and
+``CONFIG_PTHREADEXT_SIGRESUME`` respectively.
 
 
 Attachments
@@ -368,7 +375,7 @@ Document History
 Copyright and License
 ---------------------
 
-Copyright © 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+Copyright © 2013-2016 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/manual/source/release.rst b/mps/manual/source/release.rst
index 51b487fe04e..a5095f4088c 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -15,6 +15,9 @@ Interface changes
 
 #. Allocation frames are no longer deprecated. See :ref:`topic-frame`.
 
+#. On Linux and FreeBSD, it is now possible to configure the signals
+   used to suspend and resume threads. See :ref:`topic-thread-signal`.
+
 
 Other changes
 .............
diff --git a/mps/manual/source/topic/thread.rst b/mps/manual/source/topic/thread.rst
index e814fbe939a..96e80c06ea1 100644
--- a/mps/manual/source/topic/thread.rst
+++ b/mps/manual/source/topic/thread.rst
@@ -69,17 +69,30 @@ Signal and exception handling issues
 
 .. warning::
 
-    On Unix platforms (except OS X), the MPS suspends and resumes
-    threads by sending them signals. There's a shortage of available
-    signals that aren't already dedicated to other purposes (for
-    example, ValGrind uses ``SIGUSR1`` and ``SIGUSR2``), so the MPS uses
-    ``SIGXCPU`` and ``SIGXFSZ``. This means that programs must not mask
-    these two signals.
+    On Linux and FreeBSD, the MPS suspends and resumes threads by
+    sending them signals. There's a shortage of available signals that
+    aren't already dedicated to other purposes (for example, ValGrind
+    uses ``SIGUSR1`` and ``SIGUSR2``), so the MPS uses ``SIGXCPU`` and
+    ``SIGXFSZ``. This means that programs must not mask or handle
+    either of these signals.
 
-    If your program needs to handle these signals, then it must
-    co-operate with the MPS. At present, there's no documented
-    mechanism for co-operating: if you are in this situation, please
-    :ref:`contact us <contact>`.
+    If your program needs to mask or handle either of these signals,
+    then you can configure the MPS to use another pair of signals of
+    your choosing, by defining these preprocessor constants:
+
+    .. c:macro:: CONFIG_PTHREADEXT_SIGSUSPEND
+
+        If this preprocessor constant is defined, its definition names
+        the signal used to suspend a thread. For example::
+
+            cc -DCONFIG_PTHREADEXT_SIGSUSPEND=SIGUSR1 -c mps.c
+
+    .. c:macro:: CONFIG_PTHREADEXT_SIGRESUME
+
+        If this preprocessor constant is defined, its definition names
+        the signal used to resume a thread. For example::
+
+            cc -DCONFIG_PTHREADEXT_SIGSUSPEND=SIGUSR2 -c mps.c
 
 .. warning::
 

From 0400178bf4f438494d700b19635482da8100a2a6 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 14:23:07 +0100
Subject: [PATCH 23/31] Support registering a thread with the mps multiple
 times on os x.

Restore test case.

Copied from Perforce
 Change: 192127
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcssth.c            | 13 +++++++++----
 mps/code/protxc.c             |  7 ++++---
 mps/manual/source/release.rst |  7 +++++++
 3 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c
index 3ce82054931..d914427eb46 100644
--- a/mps/code/amcssth.c
+++ b/mps/code/amcssth.c
@@ -120,13 +120,17 @@ typedef struct closure_s {
 static void *kid_thread(void *arg)
 {
   void *marker = &marker;
-  mps_thr_t thread;
+  mps_thr_t thread1, thread2;
   mps_root_t reg_root;
   mps_ap_t ap;
   closure_t cl = arg;
 
-  die(mps_thread_reg(&thread, (mps_arena_t)arena), "thread_reg");
-  die(mps_root_create_thread(&reg_root, arena, thread, marker),
+  /* Register the thread twice to check this is supported -- see
+   * <design/thread-manager/#req.register.multi>
+   */
+  die(mps_thread_reg(&thread1, arena), "thread_reg");
+  die(mps_thread_reg(&thread2, arena), "thread_reg");
+  die(mps_root_create_thread(&reg_root, arena, thread1, marker),
       "root_create");
 
   die(mps_ap_create(&ap, cl->pool, mps_rank_exact()), "BufferCreate(fooey)");
@@ -136,7 +140,8 @@ static void *kid_thread(void *arg)
   mps_ap_destroy(ap);
 
   mps_root_destroy(reg_root);
-  mps_thread_dereg(thread);
+  mps_thread_dereg(thread2);
+  mps_thread_dereg(thread1);
 
   return NULL;
 }
diff --git a/mps/code/protxc.c b/mps/code/protxc.c
index 7e8f230d061..0d29010c771 100644
--- a/mps/code/protxc.c
+++ b/mps/code/protxc.c
@@ -1,7 +1,7 @@
 /* protxc.c: PROTECTION EXCEPTION HANDLER FOR OS X MACH
  *
  * $Id$
- * Copyright (c) 2013-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2013-2016 Ravenbrook Limited.  See end of file for license.
  *
  * This is the protection exception handling code for OS X using the
  * Mach interface (not pthreads).
@@ -338,7 +338,8 @@ extern void ProtThreadRegister(Bool setup)
     mach_error("ERROR: MPS thread_swap_exception_ports", kr); /* .trans.must */
   AVER(old_exception_masks == EXC_MASK_BAD_ACCESS);
   AVER(old_exception_count == 1);
-  AVER(old_exception_ports == MACH_PORT_NULL); /* .assume.only-port */
+  AVER(old_exception_ports == MACH_PORT_NULL
+       || old_exception_ports == protExcPort); /* .assume.only-port */
 }
 
 
@@ -401,7 +402,7 @@ void ProtSetup(void)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2013-2016 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/manual/source/release.rst b/mps/manual/source/release.rst
index a5095f4088c..9d2961faec2 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -22,6 +22,13 @@ Interface changes
 Other changes
 .............
 
+#. It is now possible to register a thread with the MPS multiple times
+   on OS X, thus supporting the use case where a program that does not
+   use the MPS is calling into MPS-using code from multiple threads.
+   (This was already supported on other platforms.) See job003559_.
+
+   .. _job003559: https://www.ravenbrook.com/project/mps/issue/job003559/
+
 #. Objects in :ref:`pool-snc` pools are no longer scanned after their
    :term:`allocation frame` is popped, and so do not keep objects in
    automatically managed pools alive. See job003883_.

From 8005cb5f77912f018005fc153e68a63cfa897acb Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 14:28:28 +0100
Subject: [PATCH 24/31] Initialize in/out parameter old_exception_count before
 passing it to thread_swap_exception_ports.

Copied from Perforce
 Change: 192128
 ServerID: perforce.ravenbrook.com
---
 mps/code/protxc.c             | 2 +-
 mps/manual/source/release.rst | 5 +++++
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/mps/code/protxc.c b/mps/code/protxc.c
index 0d29010c771..f955e438286 100644
--- a/mps/code/protxc.c
+++ b/mps/code/protxc.c
@@ -292,7 +292,7 @@ static void *protCatchThread(void *p) {
 extern void ProtThreadRegister(Bool setup)
 {
   kern_return_t kr;
-  mach_msg_type_number_t old_exception_count;
+  mach_msg_type_number_t old_exception_count = 1;
   exception_mask_t old_exception_masks;
   exception_behavior_t behavior;
   mach_port_t old_exception_ports;
diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst
index 9d2961faec2..dbb3342e896 100644
--- a/mps/manual/source/release.rst
+++ b/mps/manual/source/release.rst
@@ -55,6 +55,11 @@ Other changes
 
    .. _job004037: https://www.ravenbrook.com/project/mps/issue/job004037/
 
+#. The MPS no longer passes an uninitialized variable to
+   :c:func:`thread_swap_exception_ports` on OS X. See job004040_.
+
+   .. _job004040: https://www.ravenbrook.com/project/mps/issue/job004040/
+
 
 .. _release-notes-1.115:
 

From 4dd6e899f50187e78c682223db39b8ef4917b697 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 14:47:08 +0100
Subject: [PATCH 25/31] Build and test the toy scheme interpreter during
 continuous integration, to reduce the risk of accidentally breaking it.

Copied from Perforce
 Change: 192133
 ServerID: perforce.ravenbrook.com
---
 mps/Makefile.in   | 2 +-
 mps/code/comm.gmk | 9 +++++++--
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/mps/Makefile.in b/mps/Makefile.in
index 71673c67db3..cdefe0890ea 100644
--- a/mps/Makefile.in
+++ b/mps/Makefile.in
@@ -71,7 +71,7 @@ make-install-dirs:
 install: @INSTALL_TARGET@
 
 test-make-build:
-	$(MAKE) $(TARGET_OPTS) testci testratio
+	$(MAKE) $(TARGET_OPTS) testci testratio testscheme
 	$(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool clean testansi
 	$(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool CFLAGS="-DCONFIG_POLL_NONE" clean testpollnone
 
diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 5042cb126df..b65ca3d025a 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -332,8 +332,7 @@ RATIO=$$(awk "BEGIN{print int(100 * $$TIME_HOT / $$TIME_RASH)}"); \
 printf "Performance ratio (hot/rash) for $(2): %d%%\n" $$RATIO
 endef
 
-.PHONY: testratio
-testratio:
+testratio: phony
 	$(MAKE) -f $(PFM).gmk VARIETY=hot djbench gcbench
 	$(MAKE) -f $(PFM).gmk VARIETY=rash djbench gcbench
 	$(call ratio,gcbench,amc)
@@ -354,6 +353,12 @@ $(PFM)/$(VARIETY)/testmmqa:
 	(cd ../test && $(MMQA) runset testsets/passing)
 
 
+# == Toy Scheme interpreter ==
+
+testscheme: phony
+	$(MAKE) -C ../example/scheme test
+
+
 # These convenience targets allow one to type "make foo" to build target
 # foo in selected varieties (or none, for the latter rule).
 

From 72133a72a06670b603c0a488c34c481447d891e9 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 15:28:25 +0100
Subject: [PATCH 26/31] Document security issues in the mps.

Copied from Perforce
 Change: 192138
 ServerID: perforce.ravenbrook.com
---
 mps/manual/source/topic/index.rst    |  2 +-
 mps/manual/source/topic/security.rst | 64 ++++++++++++++++++++++++++++
 2 files changed, 65 insertions(+), 1 deletion(-)
 create mode 100644 mps/manual/source/topic/security.rst

diff --git a/mps/manual/source/topic/index.rst b/mps/manual/source/topic/index.rst
index 3f2cb2863bf..b3139c16fb6 100644
--- a/mps/manual/source/topic/index.rst
+++ b/mps/manual/source/topic/index.rst
@@ -30,4 +30,4 @@ Reference
     platform
     porting
     deprecated
-    
+    security
diff --git a/mps/manual/source/topic/security.rst b/mps/manual/source/topic/security.rst
new file mode 100644
index 00000000000..c9294e834a5
--- /dev/null
+++ b/mps/manual/source/topic/security.rst
@@ -0,0 +1,64 @@
+.. index::
+   single: security issues
+
+.. _topic-security:
+
+Security issues
+===============
+
+This chapter describes security issues that may be present when using
+the MPS.
+
+
+.. index::
+   pair: security issues; predictable address space layout
+   single: address space; predictable layout
+
+Predictable address space layout
+--------------------------------
+
+The MPS acquires :term:`address space` using the operating system's
+:term:`virtual memory` interface (specifically, :c:func:`mmap` on Unix
+platforms, and :c:func:`VirtualAlloc` on Windows). None of the
+supported platforms randomize the allocated regions of address space,
+which means that the :term:`addresses` of :term:`blocks` allocated by
+the MPS are predictable: a :term:`client program` that makes an
+identical series of calls to the MPS gets an identical series of
+addresses back.
+
+This means that if a program using the MPS has a buffer overflow, the
+overflow is more easily exploitable by an attacker than if the program
+had used :c:func:`malloc` (which has some randomization of the
+allocated addresses), because it is easier for an attacker to
+determine the address of allocated structures.
+
+There is currently no workaround for this issue. If this affects you,
+please :ref:`contact us <contact>`.
+
+
+.. index::
+   pair: security issues; telemetry
+
+Telemetry
+---------
+
+In its :term:`hot` and :term:`cool` varieties, the MPS contains a
+:term:`telemetry system` which can be configured to record a stream of
+events for later analysis and debugging. When using the default
+:term:`plinth`, the behaviour of the telemetry system is under the
+control of the environment variable :envvar:`MPS_TELEMETRY_CONTROL`,
+and the telemetry stream is written to the file named by the
+environment variable :envvar:`MPS_TELEMETRY_FILENAME`.
+
+This means that an attacker who can set arbitrary environment
+variables when running a program that uses the MPS can cause that
+program to write a telemetry stream to an arbitrary file. This
+behaviour might be unexpected, and might enable a data overwriting
+attack, or a denial-of-service attack, since telemetry streams are
+typically very large.
+
+If this is an issue for your program, then you can modify or replace
+the :ref:`topic-plinth-io` in the :term:`plinth` so that it meets your
+requirements, or distribute the :term:`rash` variety of the MPS, which
+omits the :term:`telemetry system` entirely, and use the other
+varieties only for development and testing.

From d0e71995e44b8bb641bf76c5e6a13d9c9485f972 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 16:25:26 +0100
Subject: [PATCH 27/31] Sort the tables of platform codes. document the
 (working, but not officially supported) platform xci6gc.

Copied from Perforce
 Change: 192143
 ServerID: perforce.ravenbrook.com
---
 mps/manual/build.txt                 |  7 +++----
 mps/manual/source/topic/platform.rst | 24 ++++++++++++++++--------
 2 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/mps/manual/build.txt b/mps/manual/build.txt
index b462f013ea9..c2aa184997f 100644
--- a/mps/manual/build.txt
+++ b/mps/manual/build.txt
@@ -136,17 +136,16 @@ well:
 Platform     OS          Architecture    Compiler      Makefile
 ==========   =========   =============   ============  =================
 ``fri3gc``   FreeBSD     IA-32           GCC           ``fri3gc.gmk``
-``fri6gc``   FreeBSD     x86_64          GCC           ``fri6gc.gmk``
 ``fri3ll``   FreeBSD     IA-32           Clang         ``fri3ll.gmk``
+``fri6gc``   FreeBSD     x86_64          GCC           ``fri6gc.gmk``
 ``fri6ll``   FreeBSD     x86_64          Clang         ``fri6ll.gmk``
 ``lii3gc``   Linux       IA-32           GCC           ``lii3gc.gmk``
 ``lii6gc``   Linux       x86_64          GCC           ``lii6gc.gmk``
 ``lii6ll``   Linux       x86_64          Clang         ``lii6ll.gmk``
-``xci3ll``   Mac OS X    IA-32           Clang         ``mps.xcodeproj``
-``xci6ll``   Mac OS X    x86_64          Clang         ``mps.xcodeproj``
-``xci3gc``   Mac OS X    IA-32           GCC (legacy)  ``xci3gc.gmk``
 ``w3i3mv``   Windows     IA-32           Microsoft C   ``w3i3mv.nmk``
 ``w3i6mv``   Windows     x86_64          Microsoft C   ``w3i6mv.nmk``
+``xci3ll``   Mac OS X    IA-32           Clang         ``mps.xcodeproj``
+``xci6ll``   Mac OS X    x86_64          Clang         ``mps.xcodeproj``
 ==========   =========   =============   ============  =================
 
 Historically, the MPS worked on a much wider variety of platforms, and
diff --git a/mps/manual/source/topic/platform.rst b/mps/manual/source/topic/platform.rst
index 15873d27af4..b075ea71e94 100644
--- a/mps/manual/source/topic/platform.rst
+++ b/mps/manual/source/topic/platform.rst
@@ -142,14 +142,7 @@ Platform interface
     IA-32 processor architecture, and the GCC compiler.
 
 
-.. c:macro:: MPS_PF_FRI6GC
-
-    A :term:`C` preprocessor macro that indicates, if defined, that
-    the :term:`platform` consists of the FreeBSD operating system, the
-    x86-64 processor architecture, and the GCC compiler.
-
-
-.. c:macro:: MPS_PF_FRI3GC
+.. c:macro:: MPS_PF_FRI3LL
 
     A :term:`C` preprocessor macro that indicates, if defined, that
     the :term:`platform` consists of the FreeBSD operating system, the
@@ -158,6 +151,13 @@ Platform interface
 
 .. c:macro:: MPS_PF_FRI6GC
 
+    A :term:`C` preprocessor macro that indicates, if defined, that
+    the :term:`platform` consists of the FreeBSD operating system, the
+    x86-64 processor architecture, and the GCC compiler.
+
+
+.. c:macro:: MPS_PF_FRI6LL
+
     A :term:`C` preprocessor macro that indicates, if defined, that
     the :term:`platform` consists of the FreeBSD operating system, the
     x86-64 processor architecture, and the Clang/LLVM compiler.
@@ -220,6 +220,13 @@ Platform interface
     IA-32 processor architecture, and the Clang/LLVM compiler.
 
 
+.. c:macro:: MPS_PF_XCI6GC
+
+    A :term:`C` preprocessor macro that indicates, if defined, that
+    the :term:`platform` consists of the OS X operating system, the
+    x86-64 processor architecture, and the GCC compiler.
+
+
 .. c:macro:: MPS_PF_XCI6LL
 
     A :term:`C` preprocessor macro that indicates, if defined, that
@@ -373,6 +380,7 @@ Platform    Status
 ``w3ppmv``  *Not supported*
 ``xci3gc``  *Not supported*
 ``xci3ll``  Supported
+``xci6gc``  *Not supported*
 ``xci6ll``  Supported
 ``xcppgc``  *Not supported*
 ==========  =======================

From 49198a35ee4ea850c9d53addc577c3c0413c4771 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Sun, 4 Sep 2016 19:20:05 +0100
Subject: [PATCH 28/31] Add _critical to assertions on the critical path for
 manual-allocation-bound programs using mvff. this brings the hot/rash ratio
 for "djbench mvff" down from over 150% to about 130%.

Copied from Perforce
 Change: 192148
 ServerID: perforce.ravenbrook.com
---
 mps/code/cbs.c      | 19 +++++++++++--------
 mps/code/land.c     | 40 ++++++++++++++++++++++++++--------------
 mps/code/mpsi.c     | 14 +++++++-------
 mps/code/pool.c     | 34 ++++++++++++++++++++--------------
 mps/code/poolmvff.c | 34 +++++++++++++++++++++-------------
 mps/code/splay.c    | 14 +++++++-------
 mps/code/tract.c    | 24 ++++++++++++------------
 7 files changed, 104 insertions(+), 75 deletions(-)

diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index c081ed61610..e4ed5243362 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -1,7 +1,7 @@
 /* cbs.c: COALESCING BLOCK STRUCTURE IMPLEMENTATION
  *
  * $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .intro: This is a portable implementation of coalescing block
  * structures.
@@ -441,6 +441,9 @@ static void cbsBlockInsert(CBS cbs, CBSBlock block)
  *
  * .insert.alloc: Will only allocate a block if the range does not
  * abut an existing range.
+ *
+ * .insert.critical: In manual-allocation-bound programs using MVFF
+ * this is on the critical path.
  */
 
 static Res cbsInsert(Range rangeReturn, Land land, Range range)
@@ -454,9 +457,9 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range)
   Bool leftMerge, rightMerge;
   Size oldSize;
 
-  AVER(rangeReturn != NULL);
-  AVERT(Range, range);
-  AVER(RangeIsAligned(range, LandAlignment(land)));
+  AVER_CRITICAL(rangeReturn != NULL);
+  AVERT_CRITICAL(Range, range);
+  AVER_CRITICAL(RangeIsAligned(range, LandAlignment(land)));
 
   base = RangeBase(range);
   limit = RangeLimit(range);
@@ -526,14 +529,14 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range)
     cbsBlockInsert(cbs, block);
   }
 
-  AVER(newBase <= base);
-  AVER(newLimit >= limit);
+  AVER_CRITICAL(newBase <= base);
+  AVER_CRITICAL(newLimit >= limit);
   RangeInit(rangeReturn, newBase, newLimit);
 
   return ResOK;
 
 fail:
-  AVER(res != ResOK);
+  AVER_CRITICAL(res != ResOK);
   return res;
 }
 
@@ -1163,7 +1166,7 @@ DEFINE_CLASS(Land, CBSZoned, klass)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/land.c b/mps/code/land.c
index 3d2bb84bdec..d0434a3a9f8 100644
--- a/mps/code/land.c
+++ b/mps/code/land.c
@@ -1,7 +1,7 @@
 /* land.c: LAND (COLLECTION OF ADDRESS RANGES) IMPLEMENTATION
  *
  * $Id$
- * Copyright (c) 2014-2015 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2014-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .design: <design/land/>
  */
@@ -190,12 +190,15 @@ void LandFinish(Land land)
 /* LandSize -- return the total size of ranges in land
  *
  * See <design/land/#function.size>
+ *
+ * .size.critical: In manual-allocation-bound programs using MVFF this
+ * is on the critical path.
  */
 
 Size LandSize(Land land)
 {
   /* .enter-leave.simple */
-  AVERC(Land, land);
+  AVERC_CRITICAL(Land, land);
 
   return Method(Land, land, sizeMethod)(land);
 }
@@ -204,17 +207,20 @@ Size LandSize(Land land)
 /* LandInsert -- insert range of addresses into land
  *
  * See <design/land/#function.insert>
+ *
+ * .insert.critical: In manual-allocation-bound programs using MVFF
+ * this is on the critical path.
  */
 
 Res LandInsert(Range rangeReturn, Land land, Range range)
 {
   Res res;
 
-  AVER(rangeReturn != NULL);
-  AVERC(Land, land);
-  AVERT(Range, range);
-  AVER(RangeIsAligned(range, land->alignment));
-  AVER(!RangeIsEmpty(range));
+  AVER_CRITICAL(rangeReturn != NULL);
+  AVERC_CRITICAL(Land, land);
+  AVERT_CRITICAL(Range, range);
+  AVER_CRITICAL(RangeIsAligned(range, land->alignment));
+  AVER_CRITICAL(!RangeIsEmpty(range));
   landEnter(land);
 
   res = Method(Land, land, insert)(rangeReturn, land, range);
@@ -249,13 +255,16 @@ Res LandDelete(Range rangeReturn, Land land, Range range)
 /* LandIterate -- iterate over isolated ranges of addresses in land
  *
  * See <design/land/#function.iterate>
+ *
+ * .iterate.critical: In manual-allocation-bound programs using MVFF
+ * this is on the critical path.
  */
 
 Bool LandIterate(Land land, LandVisitor visitor, void *closure)
 {
   Bool b;
-  AVERC(Land, land);
-  AVER(FUNCHECK(visitor));
+  AVERC_CRITICAL(Land, land);
+  AVER_CRITICAL(FUNCHECK(visitor));
   landEnter(land);
 
   b = Method(Land, land, iterate)(land, visitor, closure);
@@ -274,8 +283,8 @@ Bool LandIterate(Land land, LandVisitor visitor, void *closure)
 Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closure)
 {
   Bool b;
-  AVERC(Land, land);
-  AVER(FUNCHECK(visitor));
+  AVERC_CRITICAL(Land, land);
+  AVER_CRITICAL(FUNCHECK(visitor));
   landEnter(land);
 
   b = Method(Land, land, iterateAndDelete)(land, visitor, closure);
@@ -426,12 +435,15 @@ static Bool landFlushVisitor(Bool *deleteReturn, Land land, Range range,
 /* LandFlush -- move ranges from src to dest
  *
  * See <design/land/#function.flush>
+ *
+ * .flush.critical: In manual-allocation-bound programs using MVFF
+ * this is on the critical path.
  */
 
 Bool LandFlush(Land dest, Land src)
 {
-  AVERC(Land, dest);
-  AVERC(Land, src);
+  AVERC_CRITICAL(Land, dest);
+  AVERC_CRITICAL(Land, src);
 
   return LandIterateAndDelete(src, landFlushVisitor, dest);
 }
@@ -594,7 +606,7 @@ DEFINE_CLASS(Land, Land, klass)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2014-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2014-2016 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/mpsi.c b/mps/code/mpsi.c
index 080b660fac3..9ae6fcbfa97 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -745,16 +745,16 @@ mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t pool, size_t size)
   Addr p;
   Res res;
 
-  AVER(TESTT(Pool, pool));
+  AVER_CRITICAL(TESTT(Pool, pool));
   arena = PoolArena(pool);
 
   ArenaEnter(arena);
 
   ArenaPoll(ArenaGlobals(arena)); /* .poll */
 
-  AVER(p_o != NULL);
-  AVERT(Pool, pool);
-  AVER(size > 0);
+  AVER_CRITICAL(p_o != NULL);
+  AVERT_CRITICAL(Pool, pool);
+  AVER_CRITICAL(size > 0);
   /* Note: class may allow unaligned size, see */
   /* <design/class-interface/#alloc.size.align>. */
   /* Rest ignored, see .varargs. */
@@ -787,13 +787,13 @@ void mps_free(mps_pool_t pool, mps_addr_t p, size_t size)
 {
   Arena arena;
 
-  AVER(TESTT(Pool, pool));
+  AVER_CRITICAL(TESTT(Pool, pool));
   arena = PoolArena(pool);
 
   ArenaEnter(arena);
 
-  AVERT(Pool, pool);
-  AVER(size > 0);
+  AVERT_CRITICAL(Pool, pool);
+  AVER_CRITICAL(size > 0);
   /* Note: class may allow unaligned size, see */
   /* <design/class-interface/#alloc.size.align>. */
 
diff --git a/mps/code/pool.c b/mps/code/pool.c
index bb1a6f34f74..b6e949ed039 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -227,22 +227,24 @@ BufferClass PoolDefaultBufferClass(Pool pool)
 }
 
 
-/* PoolAlloc -- allocate a block of memory from a pool */
+/* PoolAlloc -- allocate a block of memory from a pool
+ *
+ * .alloc.critical: In manual-allocation-bound programs this is on the
+ * critical path.
+ */
 
 Res PoolAlloc(Addr *pReturn, Pool pool, Size size)
 {
   Res res;
 
-  AVER(pReturn != NULL);
-  AVERT(Pool, pool);
-  AVER(size > 0);
+  AVER_CRITICAL(pReturn != NULL);
+  AVERT_CRITICAL(Pool, pool);
+  AVER_CRITICAL(size > 0);
 
   res = Method(Pool, pool, alloc)(pReturn, pool, size);
   if (res != ResOK)
     return res;
   /* Make sure that the allocated address was in the pool's memory. */
-  /* .hasaddr.critical: The PoolHasAddr check is expensive, and in */
-  /* allocation-bound programs this is on the critical path. */
   AVER_CRITICAL(PoolHasAddr(pool, *pReturn));
   /* All allocations should be aligned to the pool's alignment */
   AVER_CRITICAL(AddrIsAligned(*pReturn, pool->alignment));
@@ -257,16 +259,20 @@ Res PoolAlloc(Addr *pReturn, Pool pool, Size size)
 }
 
 
-/* PoolFree -- deallocate a block of memory allocated from the pool */
+/* PoolFree -- deallocate a block of memory allocated from the pool
+ *
+ * .free.critical: In manual-allocation-bound programs this is on the
+ * critical path.
+ */
 
 void PoolFree(Pool pool, Addr old, Size size)
 {
-  AVERT(Pool, pool);
-  AVER(old != NULL);
+  AVERT_CRITICAL(Pool, pool);
+  AVER_CRITICAL(old != NULL);
   /* The pool methods should check that old is in pool. */
-  AVER(size > 0);
-  AVER(AddrIsAligned(old, pool->alignment));
-  AVER(PoolHasRange(pool, old, AddrAdd(old, size)));
+  AVER_CRITICAL(size > 0);
+  AVER_CRITICAL(AddrIsAligned(old, pool->alignment));
+  AVER_CRITICAL(PoolHasRange(pool, old, AddrAdd(old, size)));
 
   Method(Pool, pool, free)(pool, old, size);
  
@@ -596,8 +602,8 @@ Bool PoolHasRange(Pool pool, Addr base, Addr limit)
   Arena arena;
   Bool managed;
 
-  AVERT(Pool, pool);
-  AVER(base < limit);
+  AVERT_CRITICAL(Pool, pool);
+  AVER_CRITICAL(base < limit);
 
   arena = PoolArena(pool);
   managed = PoolOfRange(&rangePool, arena, base, limit);
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index de19688a142..1269d92b528 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -297,7 +297,11 @@ static Res mvffFindFree(Range rangeReturn, MVFF mvff, Size size,
 }
 
 
-/* MVFFAlloc -- Allocate a block */
+/* MVFFAlloc -- Allocate a block
+ *
+ * .alloc.critical: In manual-allocation-bound programs this is on the
+ * critical path.
+ */
 
 static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size)
 {
@@ -307,11 +311,11 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size)
   LandFindMethod findMethod;
   FindDelete findDelete;
 
-  AVER(aReturn != NULL);
-  AVERT(Pool, pool);
+  AVER_CRITICAL(aReturn != NULL);
+  AVERT_CRITICAL(Pool, pool);
   mvff = PoolMVFF(pool);
-  AVERT(MVFF, mvff);
-  AVER(size > 0);
+  AVERT_CRITICAL(MVFF, mvff);
+  AVER_CRITICAL(size > 0);
 
   size = SizeAlignUp(size, PoolAlignment(pool));
   findMethod = mvff->firstFit ? LandFindFirst : LandFindLast;
@@ -321,13 +325,17 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size)
   if (res != ResOK)
     return res;
 
-  AVER(RangeSize(&range) == size);
+  AVER_CRITICAL(RangeSize(&range) == size);
   *aReturn = RangeBase(&range);
   return ResOK;
 }
 
 
-/* MVFFFree -- free the given block */
+/* MVFFFree -- free the given block
+ *
+ * .free.critical: In manual-allocation-bound programs this is on the
+ * critical path.
+ */
 
 static void MVFFFree(Pool pool, Addr old, Size size)
 {
@@ -335,18 +343,18 @@ static void MVFFFree(Pool pool, Addr old, Size size)
   RangeStruct range, coalescedRange;
   MVFF mvff;
 
-  AVERT(Pool, pool);
+  AVERT_CRITICAL(Pool, pool);
   mvff = PoolMVFF(pool);
-  AVERT(MVFF, mvff);
+  AVERT_CRITICAL(MVFF, mvff);
 
-  AVER(old != (Addr)0);
-  AVER(AddrIsAligned(old, PoolAlignment(pool)));
-  AVER(size > 0);
+  AVER_CRITICAL(old != (Addr)0);
+  AVER_CRITICAL(AddrIsAligned(old, PoolAlignment(pool)));
+  AVER_CRITICAL(size > 0);
 
   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);
+  AVER_CRITICAL(res == ResOK);
   MVFFReduce(mvff);
 }
 
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 0030b4aee65..2ec56398532 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -1,7 +1,7 @@
 /* splay.c: SPLAY TREE IMPLEMENTATION
  *
  * $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .purpose: Splay trees are used to manage potentially unbounded
  * collections of ordered things.  In the MPS these are usually
@@ -509,9 +509,9 @@ static Compare SplaySplitRev(SplayStateStruct *stateReturn,
   Tree middle, leftLast, rightFirst;
   Compare cmp;
 
-  AVERT(SplayTree, splay);
-  AVER(FUNCHECK(compare));
-  AVER(!SplayTreeIsEmpty(splay));
+  AVERT_CRITICAL(SplayTree, splay);
+  AVER_CRITICAL(FUNCHECK(compare));
+  AVER_CRITICAL(!SplayTreeIsEmpty(splay));
   
   leftLast = TreeEMPTY;
   rightFirst = TreeEMPTY;
@@ -633,8 +633,8 @@ static void SplayAssembleRev(SplayTree splay, SplayState state)
 {
   Tree left, right;
 
-  AVERT(SplayTree, splay);
-  AVER(state->middle != TreeEMPTY);
+  AVERT_CRITICAL(SplayTree, splay);
+  AVER_CRITICAL(state->middle != TreeEMPTY);
   
   left = TreeLeft(state->middle);
   left = SplayUpdateRightSpine(splay, state->leftLast, left);
@@ -1394,7 +1394,7 @@ Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream, Count depth,
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 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/tract.c b/mps/code/tract.c
index 45fbb668c94..badd7615da0 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -1,7 +1,7 @@
 /* tract.c: PAGE TABLES
  *
  * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  *
  * .ullagepages: Pages whose page index is < allocBase are recorded as
  * free but never allocated as alloc starts searching after the tables.
@@ -60,8 +60,8 @@ Bool TractCheck(Tract tract)
 
 void TractInit(Tract tract, Pool pool, Addr base)
 {
-  AVER(tract != NULL);
-  AVERT(Pool, pool);
+  AVER_CRITICAL(tract != NULL);
+  AVERT_CRITICAL(Pool, pool);
 
   tract->pool.pool = pool;
   tract->base = base;
@@ -456,11 +456,11 @@ void PageAlloc(Chunk chunk, Index pi, Pool pool)
   Addr base;
   Page page;
 
-  AVERT(Chunk, chunk);
-  AVER(pi >= chunk->allocBase);
-  AVER(pi < chunk->pages);
-  AVER(!BTGet(chunk->allocTable, pi));
-  AVERT(Pool, pool);
+  AVERT_CRITICAL(Chunk, chunk);
+  AVER_CRITICAL(pi >= chunk->allocBase);
+  AVER_CRITICAL(pi < chunk->pages);
+  AVER_CRITICAL(!BTGet(chunk->allocTable, pi));
+  AVERT_CRITICAL(Pool, pool);
 
   page = ChunkPage(chunk, pi);
   tract = PageTract(page);
@@ -476,9 +476,9 @@ void PageInit(Chunk chunk, Index pi)
 {
   Page page;
 
-  AVERT(Chunk, chunk);
-  AVER(pi < chunk->pages);
-  
+  AVERT_CRITICAL(Chunk, chunk);
+  AVER_CRITICAL(pi < chunk->pages);
+
   page = ChunkPage(chunk, pi);
 
   BTRes(chunk->allocTable, pi);
@@ -504,7 +504,7 @@ void PageFree(Chunk chunk, Index pi)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

From d7e36f8dbb4def0d0b255cfe638831dcf8698094 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 5 Sep 2016 11:37:19 +0100
Subject: [PATCH 29/31] Don't pick a grain size that's so large that you can't
 avoid hitting the commit limit.

Copied from Perforce
 Change: 192154
 ServerID: perforce.ravenbrook.com
---
 mps/code/apss.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/mps/code/apss.c b/mps/code/apss.c
index 0e855b07733..6efcf8a1e8d 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -230,7 +230,7 @@ int main(int argc, char *argv[])
   
   testlib_init(argc, argv);
 
-  arena_grain_size = rnd_grain(2 * testArenaSIZE);
+  arena_grain_size = rnd_grain(testArenaSIZE);
   MPS_ARGS_BEGIN(args) {
     MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 2 * testArenaSIZE);
     MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);

From b9b1ad9074d4a6e936798e8c699aa7f5335d6877 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 5 Sep 2016 12:03:46 +0100
Subject: [PATCH 30/31] Correct the logic in mvfreesize -- lost spans are not
 accounted as free. only sum the free space in the spans in checking
 varieties, otherwise just return the cached sum.

Copied from Perforce
 Change: 192159
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmv.c | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 821c8eea21f..6849d03a2ba 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -1,7 +1,7 @@
 /* poolmv.c: MANUAL VARIABLE POOL
  *
  * $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited.  See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * **** RESTRICTION: This pool may not allocate from the arena control
@@ -733,22 +733,22 @@ static Size MVTotalSize(Pool pool)
 
 static Size MVFreeSize(Pool pool)
 {
-  MV mv;
-  Size size = 0;
-  Ring node, next;
+  MV mv = MustBeA(MVPool, pool);
 
-  AVERT(Pool, pool);
-  mv = PoolMV(pool);
-  AVERT(MV, mv);
-
-  RING_FOR(node, &mv->spans, next) {
-    MVSpan span = RING_ELT(MVSpan, spans, node);
-    AVERT(MVSpan, span);
-    size += span->free;
+#if defined(AVER_AND_CHECK_ALL)
+  {
+    Size size = 0;
+    Ring node, next;
+    RING_FOR(node, &mv->spans, next) {
+      MVSpan span = RING_ELT(MVSpan, spans, node);
+      AVERT(MVSpan, span);
+      size += span->free;
+    }
+    AVER(size == mv->free);
   }
+#endif
 
-  AVER(size == mv->free + mv->lost);
-  return size;
+  return mv->free + mv->lost;
 }
 
 
@@ -929,7 +929,7 @@ Bool MVCheck(MV mv)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

From 18e0381952441bead471756bb26d78d8c7074236 Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Mon, 5 Sep 2016 13:17:59 +0100
Subject: [PATCH 31/31] When injecting allocation failures to test the
 fail-over land, don't also inject failures into the arena's free land's block
 pool.

Copied from Perforce
 Change: 192164
 ServerID: perforce.ravenbrook.com
---
 mps/code/fotest.c | 31 ++++++++++++++++++++++---------
 1 file changed, 22 insertions(+), 9 deletions(-)

diff --git a/mps/code/fotest.c b/mps/code/fotest.c
index 61f1d8745a4..262414bacf7 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -51,6 +51,10 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 }
 
 
+/* The original alloc method on the MFS pool. */
+static PoolAllocMethod mfs_alloc;
+
+
 /* oomAlloc -- allocation function that always fails
  *
  * Returns a randomly chosen memory error code.
@@ -58,16 +62,25 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 
 static Res oomAlloc(Addr *pReturn, Pool pool, Size size)
 {
+  MFS mfs = MustBeA(MFSPool, pool);
   UNUSED(pReturn);
-  UNUSED(pool);
   UNUSED(size);
-  switch (rnd() % 3) {
-  case 0:
-    return ResRESOURCE;
-  case 1:
-    return ResMEMORY;
-  default:
-    return ResCOMMIT_LIMIT;
+  if (mfs->extendSelf) {
+    /* This is the MFS block pool belonging to the CBS belonging to
+     * the MVFF or MVT pool under test, so simulate a failure to
+     * enforce the fail-over behaviour. */
+    switch (rnd() % 3) {
+    case 0:
+      return ResRESOURCE;
+    case 1:
+      return ResMEMORY;
+    default:
+      return ResCOMMIT_LIMIT;
+    }
+  } else {
+    /* This is the MFS block pool belonging to the arena's free land,
+     * so succeed here (see job004041). */
+    return mfs_alloc(pReturn, pool, size);
   }
 }
 
@@ -77,7 +90,6 @@ static Res oomAlloc(Addr *pReturn, Pool pool, Size size)
 static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
                         mps_align_t alignment, mps_pool_t pool)
 {
-  PoolAllocMethod mfs_alloc = CLASS_STATIC(MFSPool).alloc;
   mps_res_t res = MPS_RES_OK;
   mps_ap_t ap;
   unsigned long i, k;
@@ -158,6 +170,7 @@ int main(int argc, char *argv[])
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
       "mps_arena_create");
+  mfs_alloc = CLASS_STATIC(MFSPool).alloc;
   alignment = sizeof(void *) << (rnd() % 4);
   MPS_ARGS_BEGIN(args) {
     MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, (64 + rnd() % 64) * 1024);