Integrate changes from global graphics.

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

103 files changed, 2818 insertions, 1420 deletions

diff --git a/mps/code/action.c b/mps/code/action.c
deleted file mode 100644
index 32c3a933f27..00000000000
--- a/mps/code/action.c
+++ /dev/null
@@ -1,12 +0,0 @@
-/* impl.c.action: STRATEGIC ACTION
- *
- * Copyright (c) 2001 Ravenbrook Limited.
- * $Id$
- */
-
-#include "mpm.h"
-
-SRCID(action, "$Id$");
-
-
-/* All contents obsolete. */
diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index d8569c7873f..b89f2559579 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 #include "fmtdy.h"
@@ -18,10 +19,12 @@
 #include <string.h>
 
 
-/* These values have been tuned to cause one top-generation collection. */
+/* These values have been tuned in the hope of getting one dynamic collection. */
 #define testArenaSIZE     ((size_t)1000*1024)
+#define gen1SIZE          ((size_t)150)
+#define gen2SIZE          ((size_t)170)
 #define avLEN             3
-#define exactRootsCOUNT   200
+#define exactRootsCOUNT   180
 #define ambigRootsCOUNT   50
 #define genCOUNT          2
 #define collectionsCOUNT  37
@@ -31,41 +34,50 @@
 /* testChain -- generation parameters for the test */
 
 static mps_gen_param_s testChain[genCOUNT] = {
-  { 150, 0.85 }, { 170, 0.45 } };
+  { gen1SIZE, 0.85 }, { gen2SIZE, 0.45 } };
 
 
 /* objNULL needs to be odd so that it's ignored in exactRoots. */
 #define objNULL           ((mps_addr_t)0xDECEA5ED)
 
+
 static mps_pool_t pool;
 static mps_ap_t ap;
 static mps_addr_t exactRoots[exactRootsCOUNT];
 static mps_addr_t ambigRoots[ambigRootsCOUNT];
 
 
-static void enable(mps_arena_t arena)
-{
-    mps_message_type_enable(arena, mps_message_type_gc());
-}
+/* report - report statistics from any terminated GCs */
 
 static void report(mps_arena_t arena)
 {
-    mps_message_t message;
-
-    while (mps_message_get(&message, arena, mps_message_type_gc())) {
-        size_t live, condemned, not_condemned;
+  mps_message_t message;
+  static int nCollections = 0;
+    
+  while (mps_message_get(&message, arena, mps_message_type_gc())) {
+    size_t live, condemned, not_condemned;
+
+    live = mps_message_gc_live_size(arena, message);
+    condemned = mps_message_gc_condemned_size(arena, message);
+    not_condemned = mps_message_gc_not_condemned_size(arena, message);
+
+    printf("\nCollection %d finished:\n", ++nCollections);
+    printf("live %lu\n", (unsigned long)live);
+    printf("condemned %lu\n", (unsigned long)condemned);
+    printf("not_condemned %lu\n", (unsigned long)not_condemned);
+
+    mps_message_discard(arena, message);
+
+    if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024)
+      /* When condemned size is larger than could happen in a gen 2
+       * collection (discounting ramps, natch), guess that was a dynamic
+       * collection, and reset the commit limit, so it doesn't run out. */
+      die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
+  }
+}
 
-        live = mps_message_gc_live_size(arena, message);
-        condemned = mps_message_gc_condemned_size(arena, message);
-        not_condemned = mps_message_gc_not_condemned_size(arena, message);
 
-        mps_message_discard(arena, message);
-
-        printf("live %lu\n", (unsigned long)live);
-        printf("condemned %lu\n", (unsigned long)condemned);
-        printf("not_condemned %lu\n", (unsigned long)not_condemned);
-    }
-}
+/* make -- create one new object */
 
 static mps_addr_t make(void)
 {
@@ -76,10 +88,10 @@ static mps_addr_t make(void)
 
   do {
     MPS_RESERVE_BLOCK(res, p, ap, size);
-    if(res)
+    if (res)
       die(res, "MPS_RESERVE_BLOCK");
     res = dylan_init(p, size, exactRoots, exactRootsCOUNT);
-    if(res)
+    if (res)
       die(res, "dylan_init");
   } while(!mps_commit(ap, p, size));
 
@@ -87,6 +99,8 @@ static mps_addr_t make(void)
 }
 
 
+/* test_stepper -- stepping function for walk */
+
 static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pol,
                          void *p, size_t s)
 {
@@ -126,7 +140,7 @@ static void *test(void *arg, size_t s)
   for(i = 0; i < exactRootsCOUNT; ++i)
     exactRoots[i] = objNULL;
   for(i = 0; i < ambigRootsCOUNT; ++i)
-    ambigRoots[i] = (mps_addr_t)rnd();
+    ambigRoots[i] = rnd_addr();
 
   die(mps_root_create_table_masked(&exactRoot, arena,
                                    MPS_RANK_EXACT, (mps_rm_t)0,
@@ -143,74 +157,81 @@ static void *test(void *arg, size_t s)
 
   collections = 0;
   rampSwitch = rampSIZE;
-  mps_ap_alloc_pattern_begin(ap, ramp);
-  mps_ap_alloc_pattern_begin(busy_ap, ramp);
+  die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
+  die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
   ramping = 1;
   objs = 0;
-  while(collections < collectionsCOUNT) {
+  while (collections < collectionsCOUNT) {
     unsigned long c;
     size_t r;
+    size_t hitRatio;
 
     c = mps_collections(arena);
 
-    if(collections != c) {
+    if (collections != c) {
       collections = c;
-      printf("\nCollection %lu, %lu objects.\n",
-             c, objs);
-      do {
-          mps_addr_t p = (mps_addr_t)rnd();
-          if (mps_arena_has_addr(arena, p)) {
-              printf("0x%08x is in arena\n", (int)p);
-              break;
-          }
-      } while(1);
+      printf("\nCollection %lu started, %lu objects.\n", c, objs);
+
+      /* test mps_arena_has_addr */
+      hitRatio = ((size_t)-1 / mps_arena_committed(arena));
+      /* That's roughly how often a random addr should hit the arena. */
+      for (i = 0; i < 4 * hitRatio ; i++) {
+        mps_addr_t p = rnd_addr();
+        if (mps_arena_has_addr(arena, p)) {
+          printf("%p is in the arena\n", p);
+        }
+      }
 
       report(arena);
-      for(r = 0; r < exactRootsCOUNT; ++r)
-        cdie(exactRoots[r] == objNULL ||
-             (dylan_check(exactRoots[r]) &&
-              mps_arena_has_addr(arena, exactRoots[r])),
+      for (i = 0; i < exactRootsCOUNT; ++i)
+        cdie(exactRoots[i] == objNULL
+             || (dylan_check(exactRoots[i])
+                 && mps_arena_has_addr(arena, exactRoots[i])),
              "all roots check");
       cdie(!mps_arena_has_addr(arena, NULL),
            "NULL in arena");
 
-      if(collections == collectionsCOUNT / 2) {
+      if (collections == collectionsCOUNT / 2) {
         unsigned long object_count = 0;
         mps_arena_park(arena);
         mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
         mps_arena_release(arena);
         printf("stepped on %lu objects.\n", object_count);
       }
-      if(collections == rampSwitch) {
+      if (collections == rampSwitch) {
+        int begin_ramp = !ramping
+          || /* Every other time, switch back immediately. */ (collections & 1);
+
         rampSwitch += rampSIZE;
-        if(ramping) {
-          mps_ap_alloc_pattern_end(ap, ramp);
-          mps_ap_alloc_pattern_end(busy_ap, ramp);
+        if (ramping) {
+          die(mps_ap_alloc_pattern_end(ap, ramp), "pattern end (ap)");
+          die(mps_ap_alloc_pattern_end(busy_ap, ramp), "pattern end (busy_ap)");
+          ramping = 0;
           /* kill half of the roots */
           for(i = 0; i < exactRootsCOUNT; i += 2) {
-            if(exactRoots[i] != objNULL) {
+            if (exactRoots[i] != objNULL) {
               cdie(dylan_check(exactRoots[i]), "ramp kill check");
               exactRoots[i] = objNULL;
             }
           }
-          /* Every other time, switch back immediately. */
-          if(collections & 1) ramping = 0;
         }
-        if(!ramping) {
-          mps_ap_alloc_pattern_begin(ap, ramp);
-          mps_ap_alloc_pattern_begin(busy_ap, ramp);
+        if (begin_ramp) {
+          die(mps_ap_alloc_pattern_begin(ap, ramp),
+              "pattern rebegin (ap)");
+          die(mps_ap_alloc_pattern_begin(busy_ap, ramp),
+              "pattern rebegin (busy_ap)");
           ramping = 1;
         }
       }
     }
 
     r = (size_t)rnd();
-    if(r & 1) {
+    if (r & 1) {
       i = (r >> 1) % exactRootsCOUNT;
-      if(exactRoots[i] != objNULL)
+      if (exactRoots[i] != objNULL)
         cdie(dylan_check(exactRoots[i]), "dying root check");
       exactRoots[i] = make();
-      if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
+      if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
         dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
                     exactRoots, exactRootsCOUNT);
     } else {
@@ -220,10 +241,11 @@ static void *test(void *arg, size_t s)
       ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1);
     }
 
-    if(r % initTestFREQ == 0)
+    if (r % initTestFREQ == 0)
       *(int*)busy_init = -1; /* check that the buffer is still there */
 
-    if(objs % 1024 == 0) {
+    if (objs % 1024 == 0) {
+      report(arena);
       putchar('.');
       fflush(stdout);
     }
@@ -253,7 +275,7 @@ int main(int argc, char **argv)
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
       "arena_create");
-  enable(arena);
+  mps_message_type_enable(arena, mps_message_type_gc());
   die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit");
   die(mps_thread_reg(&thread, arena), "thread_reg");
   mps_tramp(&r, test, arena, 0);
diff --git a/mps/code/amcsshe.c b/mps/code/amcsshe.c
index bc5de2f184c..6486f416252 100644
--- a/mps/code/amcsshe.c
+++ b/mps/code/amcsshe.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  */
 
 #include "fmthe.h"
@@ -18,8 +19,12 @@
 #include <string.h>
 
 
-/* These values have been tuned to cause one top-generation collection. */
-#define testArenaSIZE     ((size_t)1400*1024)
+/* These values have been tuned in the hope of getting one dynamic collection. */
+#define headerFACTOR      ((float)(20 + headerSIZE) / 20)
+/* headerFACTOR measures how much larger objects are compared to fmtdy. */
+#define testArenaSIZE     ((size_t)(1000*headerFACTOR)*1024)
+#define gen1SIZE          ((size_t)150*headerFACTOR)
+#define gen2SIZE          ((size_t)170*headerFACTOR)
 #define avLEN             3
 #define exactRootsCOUNT   200
 #define ambigRootsCOUNT   50
@@ -32,7 +37,7 @@
 /* testChain -- generation parameters for the test */
 
 static mps_gen_param_s testChain[genCOUNT] = {
-  { 210, 0.85 }, { 248, 0.45 } };
+  { gen1SIZE, 0.85 }, { gen2SIZE, 0.45 } };
 
 
 /* objNULL needs to be odd so that it's ignored in exactRoots. */
@@ -68,6 +73,36 @@ static mps_addr_t make(void)
 }
 
 
+/* report - report statistics from any terminated GCs */
+
+static void report(mps_arena_t arena)
+{
+  mps_message_t message;
+  static int nCollections = 0;
+    
+  while (mps_message_get(&message, arena, mps_message_type_gc())) {
+    size_t live, condemned, not_condemned;
+
+    live = mps_message_gc_live_size(arena, message);
+    condemned = mps_message_gc_condemned_size(arena, message);
+    not_condemned = mps_message_gc_not_condemned_size(arena, message);
+
+    printf("\nCollection %d finished:\n", ++nCollections);
+    printf("live %lu\n", (unsigned long)live);
+    printf("condemned %lu\n", (unsigned long)condemned);
+    printf("not_condemned %lu\n", (unsigned long)not_condemned);
+
+    mps_message_discard(arena, message);
+
+    if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024)
+      /* When condemned size is larger than could happen in a gen 2
+       * collection (discounting ramps, natch), guess that was a dynamic
+       * collection, and reset the commit limit, so it doesn't run out. */
+      die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
+  }
+}
+
+
 /* test -- the body of the test */
 
 static void *test(void *arg, size_t s)
@@ -98,7 +133,7 @@ static void *test(void *arg, size_t s)
   for(i = 0; i < exactRootsCOUNT; ++i)
     exactRoots[i] = objNULL;
   for(i = 0; i < ambigRootsCOUNT; ++i)
-    ambigRoots[i] = (mps_addr_t)rnd();
+    ambigRoots[i] = rnd_addr();
 
   die(mps_root_create_table_masked(&exactRoot, arena,
                                    MPS_RANK_EXACT, (mps_rm_t)0,
@@ -119,11 +154,11 @@ static void *test(void *arg, size_t s)
 
   collections = 0;
   rampSwitch = rampSIZE;
-  mps_ap_alloc_pattern_begin(ap, ramp);
-  mps_ap_alloc_pattern_begin(busy_ap, ramp);
+  die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
+  die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
   ramping = 1;
   objs = 0;
-  while(collections < collectionsCOUNT) {
+  while (collections < collectionsCOUNT) {
     unsigned long c;
     size_t r;
 
@@ -132,15 +167,20 @@ static void *test(void *arg, size_t s)
     if (collections != c) {
       collections = c;
       printf("\nCollection %lu, %lu objects.\n", c, objs);
-      for(r = 0; r < exactRootsCOUNT; ++r) {
+      report(arena);
+      for (r = 0; r < exactRootsCOUNT; ++r) {
         if (exactRoots[r] != objNULL)
           die(HeaderFormatCheck(exactRoots[r]), "wrapper check");
       }
       if (collections == rampSwitch) {
+        int begin_ramp = !ramping
+          || /* Every other time, switch back immediately. */ (collections & 1);
+
         rampSwitch += rampSIZE;
         if (ramping) {
-          mps_ap_alloc_pattern_end(ap, ramp);
-          mps_ap_alloc_pattern_end(busy_ap, ramp);
+          die(mps_ap_alloc_pattern_end(ap, ramp), "pattern end (ap)");
+          die(mps_ap_alloc_pattern_end(busy_ap, ramp), "pattern end (busy_ap)");
+          ramping = 0;
           /* kill half of the roots */
           for(i = 0; i < exactRootsCOUNT; i += 2) {
             if (exactRoots[i] != objNULL) {
@@ -148,12 +188,12 @@ static void *test(void *arg, size_t s)
               exactRoots[i] = objNULL;
             }
           }
-          /* Every other time, switch back immediately. */
-          if (collections & 1) ramping = 0;
         }
-        if (!ramping) {
-          mps_ap_alloc_pattern_begin(ap, ramp);
-          mps_ap_alloc_pattern_begin(busy_ap, ramp);
+        if (begin_ramp) {
+          die(mps_ap_alloc_pattern_begin(ap, ramp),
+              "pattern rebegin (ap)");
+          die(mps_ap_alloc_pattern_begin(busy_ap, ramp),
+              "pattern rebegin (busy_ap)");
           ramping = 1;
         }
       }
@@ -187,6 +227,7 @@ static void *test(void *arg, size_t s)
       *(int*)busy_init = -1; /* check that the buffer is still there */
 
     if (objs % 1024 == 0) {
+      report(arena);
       putchar('.');
       fflush(stdout);
     }
@@ -218,6 +259,7 @@ int main(int argc, char **argv)
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), 3*testArenaSIZE),
       "arena_create\n");
+  mps_message_type_enable(arena, mps_message_type_gc());
   die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit");
   die(mps_thread_reg(&thread, arena), "thread_reg");
   mps_tramp(&r, test, arena, 0);
diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c
index 1ace33d35c7..96913c9c2ee 100644
--- a/mps/code/amcssth.c
+++ b/mps/code/amcssth.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .posix: This is Posix only.
  */
@@ -12,21 +13,18 @@
 #include "testlib.h"
 #include "mpscamc.h"
 #include "mpsavm.h"
-#include "mpstd.h"
-#ifdef MPS_OS_W3
-#include "mpsw3.h"
-#endif
-#include "mps.h"
 #include <stdlib.h>
 #include <string.h>
 #include <pthread.h>
 #include <time.h>
 
 
-/* These values have been tuned to cause one top-generation collection. */
+/* These values have been tuned in the hope of getting one dynamic collection. */
 #define testArenaSIZE     ((size_t)1000*1024)
+#define gen1SIZE          ((size_t)150)
+#define gen2SIZE          ((size_t)170)
 #define avLEN             3
-#define exactRootsCOUNT   200
+#define exactRootsCOUNT   180
 #define ambigRootsCOUNT   50
 #define genCOUNT          2
 #define collectionsCOUNT  37
@@ -36,7 +34,7 @@
 /* testChain -- generation parameters for the test */
 
 static mps_gen_param_s testChain[genCOUNT] = {
-  { 150, 0.85 }, { 170, 0.45 } };
+  { gen1SIZE, 0.85 }, { gen2SIZE, 0.45 } };
 
 
 /* objNULL needs to be odd so that it's ignored in exactRoots. */
@@ -54,6 +52,38 @@ mps_root_t exactRoot, ambigRoot;
 unsigned long objs = 0;
 
 
+/* report - report statistics from any terminated GCs */
+
+static void report(mps_arena_t arena)
+{
+  mps_message_t message;
+  static int nCollections = 0;
+    
+  while (mps_message_get(&message, arena, mps_message_type_gc())) {
+    size_t live, condemned, not_condemned;
+
+    live = mps_message_gc_live_size(arena, message);
+    condemned = mps_message_gc_condemned_size(arena, message);
+    not_condemned = mps_message_gc_not_condemned_size(arena, message);
+
+    printf("\nCollection %d finished:\n", ++nCollections);
+    printf("live %lu\n", (unsigned long)live);
+    printf("condemned %lu\n", (unsigned long)condemned);
+    printf("not_condemned %lu\n", (unsigned long)not_condemned);
+
+    mps_message_discard(arena, message);
+
+    if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024)
+      /* When condemned size is larger than could happen in a gen 2
+       * collection (discounting ramps, natch), guess that was a dynamic
+       * collection, and reset the commit limit, so it doesn't run out. */
+      die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
+  }
+}
+
+
+/* make -- create one new object */
+
 static mps_addr_t make(mps_ap_t ap)
 {
   size_t length = rnd() % (2*avLEN);
@@ -74,11 +104,14 @@ static mps_addr_t make(mps_ap_t ap)
 }
 
 
-static void test_stepper(mps_addr_t object, void *p, size_t s)
+/* test_stepper -- stepping function for walk */
+
+static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pol,
+                         void *p, size_t s)
 {
-  (*(unsigned long *)p)++;
+  testlib_unused(object); testlib_unused(fmt); testlib_unused(pol);
   testlib_unused(s);
-  testlib_unused(object);
+  (*(unsigned long *)p)++;
 }
 
 
@@ -97,7 +130,7 @@ static void init(void)
   for(i = 0; i < exactRootsCOUNT; ++i)
     exactRoots[i] = objNULL;
   for(i = 0; i < ambigRootsCOUNT; ++i)
-    ambigRoots[i] = (mps_addr_t)rnd();
+    ambigRoots[i] = rnd_addr();
 
   die(mps_root_create_table_masked(&exactRoot, arena,
                                    MPS_RANK_EXACT, (mps_rm_t)0,
@@ -171,10 +204,10 @@ static void *test(void *arg, size_t s)
 
   collections = 0;
   rampSwitch = rampSIZE;
-  mps_ap_alloc_pattern_begin(ap, ramp);
-  mps_ap_alloc_pattern_begin(busy_ap, ramp);
+  die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
+  die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
   ramping = 1;
-  while(collections < collectionsCOUNT) {
+  while (collections < collectionsCOUNT) {
     unsigned long c;
     size_t r;
 
@@ -182,23 +215,29 @@ static void *test(void *arg, size_t s)
 
     if (collections != c) {
       collections = c;
-      printf("\nCollection %lu, %lu objects.\n",
-             c, objs);
-      for(r = 0; r < exactRootsCOUNT; ++r)
-        cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]),
+      printf("\nCollection %lu started, %lu objects.\n", c, objs);
+      report(arena);
+
+      for (i = 0; i < exactRootsCOUNT; ++i)
+        cdie(exactRoots[i] == objNULL || dylan_check(exactRoots[i]),
              "all roots check");
+
       if (collections == collectionsCOUNT / 2) {
         unsigned long object_count = 0;
         mps_arena_park(arena);
-        mps_amc_apply(pool, test_stepper, &object_count, 0);
+        mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
         mps_arena_release(arena);
-        printf("mps_amc_apply stepped on %lu objects.\n", object_count);
+        printf("stepped on %lu objects.\n", object_count);
       }
       if (collections == rampSwitch) {
+        int begin_ramp = !ramping
+          || /* Every other time, switch back immediately. */ (collections & 1);
+
         rampSwitch += rampSIZE;
         if (ramping) {
-          mps_ap_alloc_pattern_end(ap, ramp);
-          mps_ap_alloc_pattern_end(busy_ap, ramp);
+          die(mps_ap_alloc_pattern_end(ap, ramp), "pattern end (ap)");
+          die(mps_ap_alloc_pattern_end(busy_ap, ramp), "pattern end (busy_ap)");
+          ramping = 0;
           /* kill half of the roots */
           for(i = 0; i < exactRootsCOUNT; i += 2) {
             if (exactRoots[i] != objNULL) {
@@ -206,12 +245,12 @@ static void *test(void *arg, size_t s)
               exactRoots[i] = objNULL;
             }
           }
-          /* Every other time, switch back immediately. */
-          if (collections & 1) ramping = 0;
         }
-        if (!ramping) {
-          mps_ap_alloc_pattern_begin(ap, ramp);
-          mps_ap_alloc_pattern_begin(busy_ap, ramp);
+        if (begin_ramp) {
+          die(mps_ap_alloc_pattern_begin(ap, ramp),
+              "pattern rebegin (ap)");
+          die(mps_ap_alloc_pattern_begin(busy_ap, ramp),
+              "pattern rebegin (busy_ap)");
           ramping = 1;
         }
       }
@@ -223,6 +262,7 @@ static void *test(void *arg, size_t s)
       *(int*)busy_init = -1; /* check that the buffer is still there */
 
     if (objs % 1024 == 0) {
+      report(arena);
       putchar('.');
       fflush(stdout);
     }
@@ -278,6 +318,7 @@ int main(int argc, char **argv)
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
       "arena_create");
+  mps_message_type_enable(arena, mps_message_type_gc());
   init();
   die(mps_thread_reg(&thread, arena), "thread_reg");
   pthread_create(&pthread1, NULL, fooey, (void *)&childIsFinished);
@@ -290,6 +331,7 @@ int main(int argc, char **argv)
   }
 
   finish();
+  report(arena);
   mps_arena_destroy(arena);
 
   fflush(stdout); /* synchronize */
diff --git a/mps/code/amsss.c b/mps/code/amsss.c
index 2008334248e..a650c65264e 100644
--- a/mps/code/amsss.c
+++ b/mps/code/amsss.c
@@ -2,11 +2,11 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .design: Adapted from amcss.c, but not counting collections, just
- * total size of objects allocated (because epoch doesn't increment
- * when AMS is collected).
- */
+ * total size of objects allocated (because epoch doesn't increment when
+ * AMS is collected).  */
 
 #include "fmtdy.h"
 #include "fmtdytst.h"
@@ -32,17 +32,20 @@
 /* objNULL needs to be odd so that it's ignored in exactRoots. */
 #define objNULL         ((mps_addr_t)0xDECEA5ED)
 #define testArenaSIZE   ((size_t)16<<20)
-#define initTestFREQ    6000
+#define initTestFREQ    3000
+#define splatTestFREQ   6000
 static mps_gen_param_s testChain[1] = { { 160, 0.90 } };
 
 
-static mps_pool_t pool;
+static mps_arena_t arena;
 static mps_ap_t ap;
 static mps_addr_t exactRoots[exactRootsCOUNT];
 static mps_addr_t ambigRoots[ambigRootsCOUNT];
 static size_t totalSize = 0;
 
 
+/* make -- object allocation and init */
+
 static mps_addr_t make(void)
 {
   size_t length = rnd() % 20, size = (length+2) * sizeof(mps_word_t);
@@ -51,10 +54,10 @@ static mps_addr_t make(void)
 
   do {
     MPS_RESERVE_BLOCK(res, p, ap, size);
-    if(res)
+    if (res)
       die(res, "MPS_RESERVE_BLOCK");
     res = dylan_init(p, size, exactRoots, exactRootsCOUNT);
-    if(res)
+    if (res)
       die(res, "dylan_init");
   } while(!mps_commit(ap, p, size));
 
@@ -63,49 +66,48 @@ static mps_addr_t make(void)
 }
 
 
-static void *test(void *arg, size_t s)
+/* test -- the actual stress test */
+
+static mps_pool_debug_option_s freecheckOptions =
+  { NULL, 0, (void *)"Dead", 4 };
+
+static void *test(void *arg, size_t haveAmbigous)
 {
-  mps_arena_t arena;
-  mps_fmt_t format;
-  mps_chain_t chain;
+  mps_pool_t pool;
   mps_root_t exactRoot, ambigRoot;
   size_t lastStep = 0, i, r;
   unsigned long objs;
   mps_ap_t busy_ap;
   mps_addr_t busy_init;
 
-  arena = (mps_arena_t)arg;
-  (void)s; /* unused */
-
-  die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create");
-  die(mps_chain_create(&chain, arena, 1, testChain), "chain_create");
-  die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain),
-      "pool_create(ams)");
+  pool = (mps_pool_t)arg;
 
   die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate");
   die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2");
 
   for(i = 0; i < exactRootsCOUNT; ++i)
     exactRoots[i] = objNULL;
-  for(i = 0; i < ambigRootsCOUNT; ++i)
-    ambigRoots[i] = (mps_addr_t)rnd();
+  if (haveAmbigous)
+    for(i = 0; i < ambigRootsCOUNT; ++i)
+      ambigRoots[i] = rnd_addr();
 
   die(mps_root_create_table_masked(&exactRoot, arena,
                                    MPS_RANK_EXACT, (mps_rm_t)0,
                                    &exactRoots[0], exactRootsCOUNT,
                                    (mps_word_t)1),
       "root_create_table(exact)");
-  die(mps_root_create_table(&ambigRoot, arena,
-                            MPS_RANK_AMBIG, (mps_rm_t)0,
-                            &ambigRoots[0], ambigRootsCOUNT),
-      "root_create_table(ambig)");
+  if (haveAmbigous)
+    die(mps_root_create_table(&ambigRoot, arena,
+                              MPS_RANK_AMBIG, (mps_rm_t)0,
+                              &ambigRoots[0], ambigRootsCOUNT),
+        "root_create_table(ambig)");
 
   /* create an ap, and leave it busy */
   die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
 
-  objs = 0;
+  objs = 0; totalSize = 0;
   while(totalSize < totalSizeMAX) {
-    if(totalSize > lastStep + totalSizeSTEP) {
+    if (totalSize > lastStep + totalSizeSTEP) {
       lastStep = totalSize;
       printf("\nSize %lu bytes, %lu objects.\n",
              (unsigned long)totalSize, objs);
@@ -116,12 +118,12 @@ static void *test(void *arg, size_t s)
     }
 
     r = (size_t)rnd();
-    if(r & 1) {
+    if (!haveAmbigous || (r & 1)) {
       i = (r >> 1) % exactRootsCOUNT;
-      if(exactRoots[i] != objNULL)
+      if (exactRoots[i] != objNULL)
         cdie(dylan_check(exactRoots[i]), "dying root check");
       exactRoots[i] = make();
-      if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
+      if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
         dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
                     exactRoots, exactRootsCOUNT);
     } else {
@@ -131,9 +133,12 @@ static void *test(void *arg, size_t s)
       ambigRoots[i] = (mps_addr_t)((char *)(ambigRoots[i/2]) + 1);
     }
 
-    if(rnd() % initTestFREQ == 0)
+    if (rnd() % initTestFREQ == 0)
       *(int*)busy_init = -1; /* check that the buffer is still there */
 
+    if (rnd() % splatTestFREQ == 0)
+      mps_pool_check_free_space(pool);
+
     ++objs;
     if (objs % 256 == 0) {
       printf(".");
@@ -145,10 +150,8 @@ static void *test(void *arg, size_t s)
   mps_ap_destroy(busy_ap);
   mps_ap_destroy(ap);
   mps_root_destroy(exactRoot);
-  mps_root_destroy(ambigRoot);
-  mps_pool_destroy(pool);
-  mps_chain_destroy(chain);
-  mps_fmt_destroy(format);
+  if (haveAmbigous)
+    mps_root_destroy(ambigRoot);
 
   return NULL;
 }
@@ -156,8 +159,10 @@ static void *test(void *arg, size_t s)
 
 int main(int argc, char **argv)
 {
-  mps_arena_t arena;
   mps_thr_t thread;
+  mps_fmt_t format;
+  mps_chain_t chain;
+  mps_pool_t pool;
   void *r;
 
   randomize(argc, argv);
@@ -165,7 +170,37 @@ int main(int argc, char **argv)
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
       "arena_create");
   die(mps_thread_reg(&thread, arena), "thread_reg");
-  mps_tramp(&r, test, arena, 0);
+  die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create");
+  die(mps_chain_create(&chain, arena, 1, testChain), "chain_create");
+
+  printf("\nAMS Debug\n");
+  die(mps_pool_create(&pool, arena, mps_class_ams_debug(), &freecheckOptions,
+                      format, chain, FALSE),
+      "pool_create(ams_debug,share)");
+  mps_tramp(&r, test, pool, 0);
+  mps_pool_destroy(pool);
+
+  printf("\nAMS Debug\n");
+  die(mps_pool_create(&pool, arena, mps_class_ams_debug(), &freecheckOptions,
+                      format, chain, TRUE),
+      "pool_create(ams_debug,ambig)");
+  mps_tramp(&r, test, pool, 1);
+  mps_pool_destroy(pool);
+
+  printf("\nAMS\n");
+  die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain, TRUE),
+      "pool_create(ams,ambig)");
+  mps_tramp(&r, test, pool, 1);
+  mps_pool_destroy(pool);
+
+  printf("\nAMS\n");
+  die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain, FALSE),
+      "pool_create(ams,share)");
+  mps_tramp(&r, test, pool, 0);
+  mps_pool_destroy(pool);
+
+  mps_chain_destroy(chain);
+  mps_fmt_destroy(format);
   mps_thread_dereg(thread);
   mps_arena_destroy(arena);
 
diff --git a/mps/code/amssshe.c b/mps/code/amssshe.c
index b1e0a0435e8..33197a6a281 100644
--- a/mps/code/amssshe.c
+++ b/mps/code/amssshe.c
@@ -55,7 +55,7 @@ static mps_addr_t make(void)
     res = dylan_init(userP, size, exactRoots, exactRootsCOUNT);
     if(res)
       die(res, "dylan_init");
-    ((int*)p)[0] = realTYPE;
+    ((int*)p)[0] = realHeader;
     ((int*)p)[1] = 0xED0ED;
   } while(!mps_commit(ap, p, size + headerSIZE));
 
@@ -80,8 +80,8 @@ static void *test(void *arg, size_t s)
 
   die(EnsureHeaderFormat(&format, arena), "make header format");
   die(mps_chain_create(&chain, arena, 1, testChain), "chain_create");
-  die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain),
-      "pool_create(ams)");
+  die(mps_pool_create(&pool, arena, mps_class_ams(), format, chain,
+                      TRUE), "pool_create(ams)");
 
   die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate");
   die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2");
diff --git a/mps/code/apss.c b/mps/code/apss.c
index f95123fbae2..9744a82368b 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 
@@ -21,6 +22,8 @@
 #define testLOOPS 10
 
 
+/* make -- allocate one object */
+
 static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 {
   mps_res_t res;
@@ -35,8 +38,10 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
 }
 
 
-static mps_res_t stress(mps_class_t class, mps_arena_t arena,
-                        size_t (*size)(int i), ...)
+/* stress -- create a pool of the requested type and allocate in it */
+
+static mps_res_t stress(mps_class_t class, size_t (*size)(int i),
+                        mps_arena_t arena, ...)
 {
   mps_res_t res = MPS_RES_OK;
   mps_pool_t pool;
@@ -46,7 +51,7 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
   int *ps[testSetSIZE];
   size_t ss[testSetSIZE];
 
-  va_start(arg, size);
+  va_start(arg, arena);
   res = mps_pool_create_v(&pool, arena, class, arg);
   va_end(arg);
   if (res != MPS_RES_OK)
@@ -107,6 +112,9 @@ allocFail:
 
 #define alignUp(w, a)       (((w) + (a) - 1) & ~((size_t)(a) - 1))
 
+
+/* randomSize8 -- produce sizes both latge and small, 8-byte aligned */
+
 static size_t randomSize8(int i)
 {
   size_t maxSize = 2 * 160 * 0x2000;
@@ -115,24 +123,32 @@ static size_t randomSize8(int i)
 }
 
 
-static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 };
+/* testInArena -- test all the pool classes in the given arena */
+
+static mps_pool_debug_option_s bothOptions =
+  { (void *)"postpost", 8, (void *)"DEAD", 4 };
+
+static mps_pool_debug_option_s fenceOptions =
+  { (void *)"\0XXX ''\"\"'' XXX\0", 16, NULL, 0 };
 
-static void testInArena(mps_arena_t arena)
+static void testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
 {
   mps_res_t res;
 
+  /* IWBN to test MVFFDebug, but the MPS doesn't support debugging APs, */
+  /* yet (MV Debug works here, because it fakes it through PoolAlloc). */
   printf("MVFF\n\n");
-  res = stress(mps_class_mvff(), arena, randomSize8,
+  res = stress(mps_class_mvff(), randomSize8, arena,
                (size_t)65536, (size_t)32, (size_t)4, TRUE, TRUE, TRUE);
   if (res == MPS_RES_COMMIT_LIMIT) return;
   die(res, "stress MVFF");
   printf("MV debug\n\n");
-  res = stress(mps_class_mv_debug(), arena, randomSize8,
-               &debugOptions, (size_t)65536, (size_t)32, (size_t)65536);
+  res = stress(mps_class_mv_debug(), randomSize8, arena,
+               options, (size_t)65536, (size_t)32, (size_t)65536);
   if (res == MPS_RES_COMMIT_LIMIT) return;
   die(res, "stress MV debug");
   printf("MV\n\n");
-  res = stress(mps_class_mv(), arena, randomSize8,
+  res = stress(mps_class_mv(), randomSize8, arena,
                (size_t)65536, (size_t)32, (size_t)65536);
   if (res == MPS_RES_COMMIT_LIMIT) return;
   die(res, "stress MV");
@@ -147,13 +163,13 @@ int main(int argc, char **argv)
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
       "mps_arena_create");
-  mps_arena_commit_limit_set(arena, testArenaSIZE);
-  testInArena(arena);
+  die(mps_arena_commit_limit_set(arena, testArenaSIZE), "commit limit");
+  testInArena(arena, &fenceOptions);
   mps_arena_destroy(arena);
 
   die(mps_arena_create(&arena, mps_arena_class_vmnz(), 2*testArenaSIZE),
       "mps_arena_create");
-  testInArena(arena);
+  testInArena(arena, &bothOptions);
   mps_arena_destroy(arena);
 
   fflush(stdout); /* synchronize */
diff --git a/mps/code/arena.c b/mps/code/arena.c
index 5fd42184566..a1699fa38e3 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -14,7 +14,7 @@ SRCID(arena, "$Id$");
 
 /* ArenaControlPool -- get the control pool */
 
-#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct)
+#define ArenaControlPool(arena) MV2Pool(&(arena)->controlPoolStruct)
 
 
 /* ArenaTrivDescribe -- produce trivial description of an arena */
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index cc38de55ae9..196d4275823 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -13,6 +13,7 @@
 
 #include "boot.h"
 #include "tract.h"
+#include "bt.h"
 #include "mpm.h"
 #include "mpsacl.h"
 
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 0599a71637f..5cac14e74d9 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -23,6 +23,7 @@
 
 #include "boot.h"
 #include "tract.h"
+#include "bt.h"
 #include "mpm.h"
 #include "mpsavm.h"
 
diff --git a/mps/code/arenavmx.c b/mps/code/arenavmx.c
deleted file mode 100644
index 0a08218a74f..00000000000
--- a/mps/code/arenavmx.c
+++ /dev/null
@@ -1,32 +0,0 @@
-/* impl.c.arenavmx: STUBS FOR ARENAVM
- *
- * $Id$
- * Copyright (c) 2001 Ravenbrook Limited.
- *
- * .purpose: This file is not properly part of the MPS.  It is a
- * convenience file for EP-Core who do _not_ wish to get a link error,
- * when they link to a VM arena function on a platform where it isn't
- * supported (see req.epcore.link.no-error).
- *
- * .stub: This file provides stub functions for the VM arena class
- * functions.  Calling any of them causes a run-time assertion.
- */
-
-
-#include "mpm.h"
-#include "mpsavm.h"
-
-SRCID(arenavmx, "$Id$");
-
-
-mps_arena_class_t mps_arena_class_vm(void)
-{
-  NOTREACHED;
-  return (mps_arena_class_t)NULL;
-}
-
-mps_arena_class_t mps_arena_class_vmnz(void)
-{
-  NOTREACHED;
-  return (mps_arena_class_t)NULL;
-}
diff --git a/mps/code/assert.c b/mps/code/assert.c
deleted file mode 100644
index 52b0071c9f7..00000000000
--- a/mps/code/assert.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/* impl.c.assert: ASSERTION IMPLEMENTATION
- *
- * $Id$
- * Copyright (c) 2001 Ravenbrook Limited.
- *
- * This source provides the AssertFail function which is
- * invoked by the assertion macros (see impl.h.assert).
- * It also provides for user-installed assertion failure handlers.
- */
-
-#include "check.h"
-#include "mpm.h"
-
-SRCID(assert, "$Id$");
-
-
-/* CheckLevel -- Control check level
- *
- * This controls the behaviour of Check methods unless MPS_HOT_RED
- * is defined, when it is effectively stuck at "CheckNONE".
- */
-
-unsigned CheckLevel = CheckSHALLOW;
-
-
-static void AssertLib(const char *cond, const char *id,
-                      const char *file, unsigned line)
-{
-  WriteF(mps_lib_stderr,
-         "\n"
-         "MPS ASSERTION FAILURE\n"
-         "\n"
-         "Id:        $S\n", id,
-         "File:      $S\n", file,
-         "Line:      $U\n", (WriteFU)line,
-         "Condition: $S\n", cond,
-         "\n",
-         NULL);
-
-  mps_lib_abort();
-}
-
-
-static AssertHandler handler = &AssertLib;
-
-
-AssertHandler AssertDefault(void)
-{
-  return &AssertLib;
-}
-
-
-AssertHandler AssertInstall(AssertHandler new)
-{
-  AssertHandler prev = handler;
-  handler = new;
-  return prev;
-}
-
-
-/* AssertFail -- fail an assertion
- *
- * This function is called when an ASSERT macro fails a test.  It
- * calls the installed assertion handler, if it is not NULL.  If
- * handler returns the progam continues.
- */
-void AssertFail1(const char *s)
-{
-  if (handler != NULL)
-    (*handler)(s, "", "", 0);
-}
diff --git a/mps/code/bt.c b/mps/code/bt.c
index 2d76ea806e1..8853ee582d9 100644
--- a/mps/code/bt.c
+++ b/mps/code/bt.c
@@ -12,9 +12,11 @@
  * .design: see design.mps.bt
  */
 
+#include "bt.h"
+#include "config.h"
+#include "check.h"
 #include "mpm.h"
 
-
 SRCID(bt, "$Id$");
 
 
@@ -999,3 +1001,18 @@ void BTCopyOffsetRange(BT fromBT, BT toBT,
   }
 }
 
+
+/* BTCountResRange -- count number of reset bits in a range */
+
+Count BTCountResRange(BT bt, Index base, Index limit)
+{
+  Count c = 0;
+  Index bit;
+
+  AVER(BTCheck(bt));
+  AVER(base < limit);
+
+  for (bit = base; bit < limit; ++bit)
+    if (!BTGet(bt, bit)) ++c;
+  return c;
+}
diff --git a/mps/code/bt.h b/mps/code/bt.h
new file mode 100644
index 00000000000..9d5c7edd9bc
--- /dev/null
+++ b/mps/code/bt.h
@@ -0,0 +1,75 @@
+/* impl.h.bt: Bit Table Interface
+ *
+ * $Id: bt.h,v 1.2 2002/02/01 13:52:04 pekka Exp $
+ * $HopeName: MMsrc!bt.h(trunk.2) $
+ * Copyright (C) 2002 Global Graphics Software.
+ *
+ * .source: design.mps.bt.  */
+
+#ifndef bt_h
+#define bt_h
+
+#include "mpmtypes.h"
+
+
+/* design.mps.bt.if.size */
+extern size_t (BTSize)(unsigned long length);
+#define BTSize(n) (((n) + MPS_WORD_WIDTH-1) / MPS_WORD_WIDTH * sizeof(Word))
+
+
+/* design.mps.bt.if.get */
+extern Bool (BTGet)(BT bt, Index index);
+#define BTGet(a, i) \
+  ((Bool)(((a)[((i) >> MPS_WORD_SHIFT)] \
+           >> ((i) & ~((Word)-1 << MPS_WORD_SHIFT))) \
+          & (Word)1))
+
+/* design.mps.bt.if.set */
+extern void (BTSet)(BT bt, Index index);
+#define BTSet(a, i) \
+  BEGIN \
+    (a)[((i)>>MPS_WORD_SHIFT)] |= (Word)1<<((i)&~((Word)-1<<MPS_WORD_SHIFT)); \
+  END
+
+/* design.mps.bt.if.res */
+extern void (BTRes)(BT bt, Index index);
+#define BTRes(a, i) \
+  BEGIN \
+    (a)[((i)>>MPS_WORD_SHIFT)] &= \
+      ~((Word)1 << ((i) & ~((Word)-1<<MPS_WORD_SHIFT))); \
+  END
+
+
+extern Res BTCreate(BT *btReturn, Arena arena, Count length);
+extern void BTDestroy(BT bt, Arena arena, Count length);
+
+extern void BTSetRange(BT bt, Index base, Index limit);
+extern Bool BTIsSetRange(BT bt, Index base, Index limit);
+extern void BTResRange(BT bt, Index base, Index limit);
+extern Bool BTIsResRange(BT bt, Index base, Index limit);
+
+extern Bool BTFindShortResRange(Index *baseReturn, Index *limitReturn,
+                                BT bt, Index searchBase, Index searchLimit,
+                                unsigned long length);
+extern Bool BTFindShortResRangeHigh(Index *baseReturn, Index *limitReturn,
+                                    BT bt, Index searchBase, Index searchLimit,
+                                    unsigned long length);
+extern Bool BTFindLongResRange(Index *baseReturn, Index *limitReturn,
+                               BT bt, Index searchBase, Index searchLimit,
+                               unsigned long length);
+extern Bool BTFindLongResRangeHigh(Index *baseReturn, Index *limitReturn,
+                                   BT bt, Index searchBase, Index searchLimit,
+                                   unsigned long length);
+
+extern Bool BTRangesSame(BT BTx, BT BTy, Index base, Index limit);
+
+extern void BTCopyInvertRange(BT fromBT, BT toBT, Index base, Index limit);
+extern void BTCopyRange(BT fromBT, BT toBT, Index base, Index limit);
+extern void BTCopyOffsetRange(BT fromBT, BT toBT,
+                              Index fromBase, Index fromLimit,
+                              Index toBase, Index toLimit);
+
+extern Count BTCountResRange(BT bt, Index base, Index limit);
+
+
+#endif /* bt_h */
diff --git a/mps/code/bttest.c b/mps/code/bttest.c
index 8d02b7ce6c7..a5fb1d66706 100644
--- a/mps/code/bttest.c
+++ b/mps/code/bttest.c
@@ -18,7 +18,6 @@ struct itimerspec; /* stop complaints from time.h */
 #endif
 #include <time.h>
 
-
 SRCID(bttest, "$Id$");
 
 
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 5d07d9bc233..d08542f3cd9 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -18,7 +18,6 @@
 #include "poolmfs.h"
 #include "mpm.h"
 
-
 SRCID(cbs, "$Id$");
 
 
diff --git a/mps/code/check.h b/mps/code/check.h
index 3a541164213..cd69b551b67 100644
--- a/mps/code/check.h
+++ b/mps/code/check.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .aver: This header defines a family of AVER and NOTREACHED macros.
  * These macros should be used to instrument and annotate code with
@@ -12,7 +13,7 @@
  * a comment.
  *
  * .disable: When assertions are disabled, AVER expands to something
- * which evaluates the condition but discards the result. Compilers
+ * which contains the condition but discards the result. Compilers
  * will throw the code away, but check its syntax.
  *
  * .trans.level-check: CheckLevel itself is not checked anywhere.
@@ -26,7 +27,7 @@
 #include "mpslib.h"
 
 
-/* CheckLevel -- Control check method behaviour; see impl.c.assert */
+/* CheckLevel -- Control check method behaviour */
 
 extern unsigned CheckLevel;
 
@@ -39,86 +40,73 @@ enum {
 
 /* AVER, AVERT -- MPM assertions
  *
- * AVER and AVERT are used to assert conditions within the MPM.
- * In white-hot varieties, all assertions compile away to nothing.
+ * AVER and AVERT are used to assert conditions in the code.
  */
 
-#if defined(MPS_HOT_WHITE)
+#if defined(CHECK_NONE)
 
 #define AVER(cond)                  DISCARD(cond)
 #define AVERT(type, val)            DISCARD(type ## Check(val))
 #define AVER_CRITICAL(cond)         DISCARD(cond)
 #define AVERT_CRITICAL(type, val)   DISCARD(type ## Check(val))
 
-#elif defined(MPS_HOT_RED)
+#elif defined(CHECK)
 
 #define AVER(cond)                  ASSERT(cond, #cond)
 #define AVERT(type, val)            ASSERT(type ## Check(val), \
-        "TypeCheck " #type ": " #val)
-#define AVER_CRITICAL(cond)         DISCARD(cond)
-#define AVERT_CRITICAL(type, val)   DISCARD(type ## Check(val))
-
-#elif defined(MPS_COOL)
-
-#define AVER(cond)                  ASSERT(cond, #cond)
-#define AVERT(type, val)            ASSERT(type ## Check(val), \
-        "TypeCheck " #type ": " #val)
-#define AVER_CRITICAL(cond)         ASSERT(cond, #cond)
-#define AVERT_CRITICAL(type, val)   ASSERT(type ## Check(val), \
-        "TypeCheck " #type ": " #val)
+                                           "TypeCheck " #type ": " #val)
+#define AVER_CRITICAL(cond) \
+  BEGIN \
+    if (CheckLevel != CheckNONE) ASSERT(cond, #cond); \
+  END
+#define AVERT_CRITICAL(type, val) \
+  BEGIN \
+    if (CheckLevel != CheckNONE) \
+      ASSERT(type ## Check(val), "TypeCheck " #type ": " #val); \
+  END
 
 #else
 
-#error "No heat defined."
+#error "No checking defined."
 
 #endif
 
 
-/* AssertHandler -- the assert handler */
-
-typedef void (*AssertHandler)(const char *cond, const char *id,
-                              const char *file, unsigned line);
-extern AssertHandler AssertInstall(AssertHandler handler);
-extern AssertHandler AssertDefault(void);
-
-
 /* internals for actually asserting */
 
-extern void AssertFail1(const char *s);
-
 #define ASSERT(cond, condstring) \
   BEGIN \
-    if(cond) NOOP; else \
-      AssertFail1(condstring "\n" __FILE__ "\n" STR(__LINE__)); \
+    if (cond) NOOP; else \
+      mps_lib_assert_fail(condstring "\n" __FILE__ "\n" STR(__LINE__)); \
   END
 
 
 /* NOTREACHED -- control should never reach this statement */
 
-#if defined(MPS_HOT_WHITE)
-
-#define NOTREACHED NOOP
-
-#else
+#if defined(CHECK)
 
 #define NOTREACHED \
   BEGIN \
-    AssertFail1("unreachable statement" "\n" __FILE__ "\n" STR(__LINE__)); \
+    mps_lib_assert_fail("unreachable code" "\n" __FILE__ "\n" STR(__LINE__)); \
   END
 
+#else
+
+#define NOTREACHED NOOP
+
 #endif
 
 
 /* CHECKT -- check type simply
  *
- * Must be thread safe.  See design.mps.interface.c.thread-safety
+ * Must be thread-safe.  See design.mps.interface.c.thread-safety
  * and design.mps.interface.c.check.space.
  */
 
 #define CHECKT(type, val)       ((val) != NULL && (val)->sig == type ## Sig)
 
 
-#if defined(MPS_HOT_WHITE)
+#if defined(CHECK_NONE)
 
 
 #define CHECKS(type, val) DISCARD(CHECKT(type, val))
@@ -129,26 +117,14 @@ extern void AssertFail1(const char *s);
 #define CHECKU_NOSIG(type, val) DISCARD((val) != NULL)
 
 
-#elif defined(MPS_HOT_RED)
-
-
-#define CHECKS(type, val)       ASSERT(CHECKT(type, val), \
-        "SigCheck " #type ": " #val)
-
-#define CHECKL(cond)       DISCARD(cond)
-#define CHECKD(type, val)  DISCARD(CHECKT(type, val))
-#define CHECKD_NOSIG(type, val) DISCARD((val) != NULL)
-#define CHECKU(type, val)  DISCARD(CHECKT(type, val))
-#define CHECKU_NOSIG(type, val) DISCARD((val) != NULL)
-
-
-#elif defined(MPS_COOL)
+#else
 
 
 /* CHECKS -- Check Signature */
 
 #define CHECKS(type, val)       ASSERT(CHECKT(type, val), \
-        "SigCheck " #type ": " #val)
+                                       "SigCheck " #type ": " #val)
+
 
 /* CHECKL -- Check Local Invariant
  *
@@ -243,10 +219,6 @@ extern void AssertFail1(const char *s);
   END
 
 
-#else
-
-#error "No heat defined."
-
 #endif
 
 
diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 9085317bd21..734586be6a7 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -99,15 +99,9 @@ ifdef TARGET
 ifeq ($(TARGET),mmsw.a)
 CFLAGSTARGET = -DCONFIG_PROD_EPCORE
 else
-ifeq ($(TARGET),epvmss)
-CFLAGSTARGET = -DCONFIG_PROD_EPCORE
-else
 ifeq ($(TARGET),replaysw)
 CFLAGSTARGET = -DCONFIG_PROD_EPCORE
 else
-ifeq ($(TARGET),epdss)
-CFLAGSTARGET = -DCONFIG_PROD_EPCORE
-else
 ifeq ($(TARGET),mmdw.a)
 CFLAGSTARGET = -DCONFIG_PROD_DYLAN
 else
@@ -120,8 +114,6 @@ endif
 endif
 endif
 endif
-endif
-endif
 
 # These flags are included in all compilations.
 CFLAGSCOMMON = $(PFMDEFS) $(CFLAGSTARGET) $(CFLAGSCOMPILER)
@@ -184,7 +176,7 @@ ARFLAGS=rc$(ARFLAGSPFM)
 # platforms.
 
 AMC = poolamc.c
-AMS = poolams.c
+AMS = poolams.c poolamsi.c
 AWL = poolawl.c
 LO = poollo.c
 SNC = poolsnc.c
@@ -200,16 +192,16 @@ EVENTPROC = eventcnv.c eventpro.c table.c
 MPMCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \
             tract.c walk.c reserv.c protocol.c pool.c poolabs.c \
             trace.c root.c seg.c format.c buffer.c ref.c bt.c ring.c \
-            shield.c ld.c event.c action.c sac.c message.c assert.c \
-            poolmrg.c poolmfs.c poolmv.c dbgpool.c \
+            shield.c ld.c event.c sac.c message.c \
+            poolmrg.c poolmfs.c poolmv.c dbgpool.c dbgpooli.c \
             boot.c meter.c splay.c cbs.c version.c
 MPM = $(MPMCOMMON) $(MPMPF)
 SWCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \
            tract.c walk.c reserv.c protocol.c pool.c poolabs.c \
            trace.c root.c seg.c format.c buffer.c ref.c bt.c ring.c \
-           shield.c ld.c event.c action.c sac.c message.c assert.c \
-           poolmrg.c poolmfs.c poolmv.c dbgpool.c \
-           poolepdl.c poolepvm.c poolams.c poolmvff.c \
+           shield.c ld.c event.c sac.c message.c \
+           poolmrg.c poolmfs.c poolmv.c dbgpool.c dbgpooli \
+           poolams.c poolamsi.c poolmvff.c \
            boot.c meter.c splay.c cbs.c version.c mpsioan.c
 SW = $(SWCOMMON) $(SWPF)
 
@@ -246,9 +238,6 @@ ifdef TARGET
 ifeq ($(TARGET),mmsw.a)
 SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d)
 else
-ifeq ($(TARGET),epvmss)
-SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d)
-else
 ifeq ($(TARGET),depend)
 SWDEP = $(SW:%.c=$(PFM)/$(VARIETY)/%.d)
 else
@@ -256,7 +245,6 @@ SWDEP =
 endif
 endif
 endif
-endif
 
 TESTLIBOBJ = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.o)
 TESTLIBDEP = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.d)
@@ -284,7 +272,7 @@ all: mpmss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
      abqtest cbstest btcv mv2test messtest steptest \
      eventcnv mps.a
 
-swall: mmsw.a epvmss replaysw epdss
+swall: mmsw.a replaysw
 
 # Runs the automatic tests that are built with CONFIG_PROD_MPS
 # These tests are run overnight (see design.buildsys.overnight).
@@ -295,11 +283,6 @@ testrun: mpmss apss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
          abqtest cbstest btcv messtest steptest
         $(^:%=date && $(PFM)/$(VARIETY)/% &&) true
 
-# Runs the automatic tests that are built with CONFIG_PROD_EPCORE
-testrunep: epvmss epdss
-        $(^:%=date && $(PFM)/$(VARIETY)/% &&) true
-
-
 # These convenience targets allow one to type "make foo" to build target
 # foo in selected varieties (or none, for the latter rule).
 #
@@ -307,7 +290,7 @@ testrunep: epvmss epdss
 
 mpmss sacss amcss amcssth amcsshe amsss amssshe segsmss awlut awlutth \
   awluthe mpsicv lockcov poolncv locv qs apss \
-  finalcv arenacv bttest teletest epvmss epdss \
+  finalcv arenacv bttest teletest \
   abqtest cbstest btcv mv2test \
   messtest steptest \
   eventcnv replay replaysw \
@@ -367,7 +350,7 @@ $(PFM)/$(VARIETY)/locv: $(PFM)/$(VARIETY)/locv.o \
         $(MPMOBJ) $(LOOBJ) $(TESTLIBOBJ)
 
 $(PFM)/$(VARIETY)/mpmss: $(PFM)/$(VARIETY)/mpmss.o \
-        $(MPMOBJ) $(TESTLIBOBJ)
+        $(MPMOBJ) $(MVFFOBJ) $(TESTLIBOBJ)
 
 $(PFM)/$(VARIETY)/apss: $(PFM)/$(VARIETY)/apss.o \
         $(MPMOBJ) $(MVFFOBJ) $(TESTLIBOBJ)
@@ -405,12 +388,6 @@ $(PFM)/$(VARIETY)/amssshe: $(PFM)/$(VARIETY)/amssshe.o \
 $(PFM)/$(VARIETY)/segsmss: $(PFM)/$(VARIETY)/segsmss.o \
         $(FMTDYTSTOBJ) $(MPMOBJ) $(AMSOBJ) $(TESTLIBOBJ)
 
-$(PFM)/$(VARIETY)/epvmss: $(PFM)/$(VARIETY)/epvmss.o \
-        $(FMTPSOBJ) $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ)
-
-$(PFM)/$(VARIETY)/epdss: $(PFM)/$(VARIETY)/epdss.o \
-        $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ)
-
 $(PFM)/$(VARIETY)/awlut: $(PFM)/$(VARIETY)/awlut.o \
         $(FMTDYTSTOBJ) $(MPMOBJ) $(LOOBJ) $(AWLOBJ) $(TESTLIBOBJ)
 
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 2cd7a14299e..37bed946003 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -21,7 +21,7 @@ all: mpmss.exe amcss.exe amsss.exe amssshe.exe segsmss.exe awlut.exe awluthe.exe
      locbwcss.exe locusss.exe \
      eventcnv.exe
 
-swall: mmsw.lib epvmss.exe replaysw.exe
+swall: mmsw.lib replaysw.exe
 
 
 # Convenience targets
@@ -31,7 +31,7 @@ swall: mmsw.lib epvmss.exe replaysw.exe
 
 mpmss.exe amcss.exe amcsshe.exe amsss.exe amssshe.exe segsmss.exe awlut.exe awluthe.exe dwstress.exe \
      mpsicv.exe lockutw3.exe lockcov.exe poolncv.exe locv.exe qs.exe apss.exe \
-     finalcv.exe arenacv.exe bttest.exe teletest.exe protcv.exe epvmss.exe \
+     finalcv.exe arenacv.exe bttest.exe teletest.exe protcv.exe \
      abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe steptest.exe \
      locbwcss.exe locusss.exe \
      replay.exe replaysw.exe eventcnv.exe \
@@ -162,10 +162,6 @@ $(PFM)\$(VARIETY)\locbwcss.exe: $(PFM)\$(VARIETY)\locbwcss.obj \
 $(PFM)\$(VARIETY)\dwstress.exe:  $(PFM)\$(VARIETY)\dwstress.obj \
         $(DWOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ)
 
-$(PFM)\$(VARIETY)\epvmss.exe: $(PFM)\$(VARIETY)\epvmss.obj \
-        $(PFM)\$(VARIETY)\fmtpstst.obj \
-        $(SWOBJ) $(TESTLIBOBJ) $(PLINTHOBJ) $(EVENTOBJ)
-
 $(PFM)\$(VARIETY)\awlut.exe:  $(PFM)\$(VARIETY)\awlut.obj \
         $(DWTESTOBJ) \
         $(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ) $(LOOBJ) $(AWLOBJ)
diff --git a/mps/code/config.h b/mps/code/config.h
index ad8ec6f5246..0062aa99a69 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -2,15 +2,13 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * PURPOSE
  *
  * This module translates from high-level symbols defined by the
  * external build system (gnumake, nmake, etc.) into specific sets
- * of features used by MPS modules.  For example, the build system
- * will defined one of the CONFIG_VAR_* symbols to indicate which
- * variety it is building, this file translates that into a certain
- * level of checking, and a certain level of telemetry.
+ * of features used by MPS modules.
  *
  * DESIGN
  *
@@ -21,65 +19,38 @@
 #define config_h
 
 
-/* Variety Configuration
- *
- * Convert CONFIG_VAR_* defined on compiler command line into
- * internal configuration parameters.  See design.mps.config.var
- * and design.mps.variety.macro.  Note that MPS_HOT is subclassed
- * into MPS_HOT_RED and MPS_HOT_WHITE; this distinction should
- * be rarely used.
- */
+/* Variety Configuration */
 
-#if defined(CONFIG_VAR_HI)      /* Hot, Internal; variety.hi */
-#define MPS_VARIETY_STRING      "hi"
-#define MPS_HOT
-#define MPS_HOT_RED
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_CI)    /* Cool, Internal; variety.ci */
-#define MPS_VARIETY_STRING      "ci"
-#define MPS_COOL
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_TI)    /* Telemetry, Internal; variety.ti */
-#define MPS_VARIETY_STRING      "ti"
-#define MPS_COOL
-#define EVENT
-#elif defined(CONFIG_VAR_HE)    /* Hot, External; variety.he */
-#define MPS_VARIETY_STRING      "he"
-#define MPS_HOT
-#define MPS_HOT_RED
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_CE)    /* Cool, External; variety.ce */
-#define MPS_VARIETY_STRING      "ce"
-#define MPS_COOL
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_WI)    /* White hot, Internal; variety.wi */
-#define MPS_VARIETY_STRING      "wi"
-#define MPS_HOT
-#define MPS_HOT_WHITE
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_WE)    /* White hot, External; variety.we */
-#define MPS_VARIETY_STRING      "we"
-#define MPS_HOT
-#define MPS_HOT_WHITE
-#define EVENT_NONE
-#elif defined(CONFIG_VAR_II)    /* Ice, Internal; variety.ii */
-#define MPS_VARIETY_STRING      "ii"
-#define MPS_HOT
-#define MPS_HOT_RED
+
+#if defined(CONFIG_ASSERT)
+#define CHECK
+#define MPS_ASSERT_STRING "asserted"
+#else
+#define CHECK_NONE
+#define MPS_ASSERT_STRING "nonasserted"
+#endif
+
+
+#if defined(CONFIG_LOG)
 #define EVENT
+#define MPS_LOG_STRING "logging"
 #else
-#error "No target variety configured."
+#define EVENT_NONE
+#define MPS_LOG_STRING "nonlogging"
 #endif
 
 
-#if defined(EVENT)
+#if defined(CONFIG_DEBUG)
 #define DIAGNOSTICS
-#elif defined(EVENT_NONE)
-#define DIAGNOSTICS_NONE
+#define MPS_DEBUG_STRING "debug"
 #else
-#error "Events not configured."
+#define DIAGNOSTICS_NONE
+#define MPS_DEBUG_STRING "nondebug"
 #endif
 
+#define MPS_VARIETY_STRING \
+  MPS_ASSERT_STRING "." MPS_LOG_STRING "." MPS_DEBUG_STRING
+
 
 /* Platform Configuration */
 
@@ -125,12 +96,11 @@
 #endif /* MPS_ARCH_PP */
 
 
-/* In white-hot versions, absolutely no checking is done.  This leads to
- * many spurious warnings because parameters are suddenly unused, etc.
- * We aren't interested in these.
+/* Non-checking varieties give many spurious warnings because parameters
+ * are suddenly unused, etc.  We aren't interested in these
  */
 
-#if defined(MPS_HOT_WHITE)
+#if defined(CHECK_NONE)
 
 /* "unreferenced formal parameter" */
 #pragma warning(disable: 4100)
@@ -138,7 +108,7 @@
 /* "unreferenced local function has been removed" */
 #pragma warning(disable: 4505)
 
-#endif /* MPS_HOT_WHITE */
+#endif /* CHECK_NONE */
 
 #endif /* MPS_BUILD_MV */
 
@@ -240,7 +210,7 @@
  * create a dependence on an external library.
  */
 
-#if defined(MPS_PF_W3I3MV) && defined(MPS_HOT)
+#if defined(MPS_PF_W3I3MV)
 /* MSVC on Intel inlines mem* when optimizing */
 #define mps_lib_memset memset
 #define mps_lib_memcpy memcpy
@@ -264,6 +234,7 @@
 #define THREAD_SINGLE
 #define PROTECTION_NONE
 #define DONGLE_NONE
+#define CHECK_DEFAULT CheckNONE /* CheckSHALLOW is too slow for SW */
 
 #elif defined(CONFIG_PROD_DYLAN)
 #define MPS_PROD_STRING         "dylan"
@@ -277,6 +248,7 @@
 #define THREAD_MULTI
 #define PROTECTION
 #define DONGLE_NONE
+#define CHECK_DEFAULT CheckSHALLOW
 
 #elif defined(CONFIG_PROD_CONFIGURA)
 #define MPS_PROD_STRING         "configura"
@@ -293,6 +265,7 @@
 #define THREAD_MULTI
 #define PROTECTION
 #define DONGLE_NONE
+#define CHECK_DEFAULT CheckSHALLOW
 
 #else
 #error "No target product configured."
diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c
index bbd4bd23e56..62672d6810f 100644
--- a/mps/code/dbgpool.c
+++ b/mps/code/dbgpool.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .source: design.mps.object-debug
  */
@@ -9,9 +10,7 @@
 #include "dbgpool.h"
 #include "poolmfs.h"
 #include "splay.h"
-#include "mpslib.h"
 #include "mpm.h"
-#include "mps.h"
 #include <stdarg.h>
 
 SRCID(dbgpool, "$Id$");
@@ -34,8 +33,7 @@ typedef tagStruct *Tag;
 
 /* tag init methods: copying the user-supplied data into the tag */
 
-#define TagInitMethodCheck(f) \
-  ((f) != NULL) /* that's the best we can do */
+#define TagInitMethodCheck(f) FUNCHECK(f)
 
 static void TagTrivInit(void* tag, va_list args)
 {
@@ -68,12 +66,16 @@ Bool PoolDebugMixinCheck(PoolDebugMixin debug)
 {
   /* Nothing to check about fenceTemplate */
   /* Nothing to check about fenceSize */
-  CHECKL(TagInitMethodCheck(debug->tagInit));
-  /* Nothing to check about tagSize */
-  CHECKD(Pool, debug->tagPool);
-  CHECKL(CHECKTYPE(Addr, void*)); /* tagPool relies on this */
-  /* Nothing to check about missingTags */
-  CHECKL(SplayTreeCheck(&debug->index));
+  /* Nothing to check about freeTemplate */
+  /* Nothing to check about freeSize */
+  if (debug->tagInit != NULL) {
+    CHECKL(TagInitMethodCheck(debug->tagInit));
+    /* Nothing to check about tagSize */
+    CHECKD(Pool, debug->tagPool);
+    CHECKL(CHECKTYPE(Addr, void*)); /* tagPool relies on this */
+    /* Nothing to check about missingTags */
+    CHECKL(SplayTreeCheck(&debug->index));
+  }
   UNUSED(debug); /* see impl.c.mpm.check.unused */
   return TRUE;
 }
@@ -102,6 +104,10 @@ static Bool PoolDebugOptionsCheck(PoolDebugOptions opt)
     CHECKL(opt->fenceTemplate != NULL);
     /* Nothing to check about fenceSize */
   }
+  if (opt->freeSize != 0) {
+    CHECKL(opt->freeTemplate != NULL);
+    /* Nothing to check about freeSize */
+  }
   return TRUE;
 }
 
@@ -150,7 +156,20 @@ static Res DebugPoolInit(Pool pool, va_list args)
     }
     debug->fenceTemplate = options->fenceTemplate;
   }
- 
+
+  /* free-checking init */
+  /* @@@@ This parses a user argument, options, so it should really */
+  /* go through the MPS interface.  The template needs to be copied */
+  /* into Addr memory, to avoid breaking design.mps.type.addr.use. */
+  debug->freeSize = options->freeSize;
+  if (debug->freeSize != 0) {
+    if (PoolAlignment(pool) % debug->freeSize != 0) {
+      res = ResPARAM;
+      goto alignFail;
+    }
+    debug->freeTemplate = options->freeTemplate;
+  }
+
   /* tag init */
   debug->tagInit = tagInit;
   if (debug->tagInit != NULL) {
@@ -195,7 +214,119 @@ static void DebugPoolFinish(Pool pool)
 }
 
 
-/* FenceAlloc -- allocation wrapper for fenceposts
+/* freeSplat -- splat free block with splat pattern
+ *
+ * If base is in a segment, the whole block has to be in it.
+ */
+
+static void freeSplat(PoolDebugMixin debug, Pool pool, Addr base, Addr limit)
+{
+  Addr p, next;
+  Size freeSize = debug->freeSize;
+  Arena arena;
+  Seg seg;
+  Bool inSeg;
+
+  AVER(base < limit);
+
+  /* If the block is in a segment, make sure any shield is up. */
+  arena = PoolArena(pool);
+  inSeg = SegOfAddr(&seg, arena, base);
+  if (inSeg) {
+    AVER(limit <= SegLimit(seg));
+    ShieldExpose(arena, seg);
+  }
+  /* Write as many copies of the template as fit in the block. */
+  for (p = base, next = AddrAdd(p, freeSize);
+       next <= limit && p < next /* watch out for overflow in next */;
+       p = next, next = AddrAdd(next, freeSize))
+    (void)AddrCopy(p, debug->freeTemplate, freeSize);
+  /* Fill the tail of the block with a partial copy of the template. */
+  if (next > limit || next < p)
+    (void)AddrCopy(p, debug->freeTemplate, AddrOffset(p, limit));
+  if (inSeg) {
+    ShieldCover(arena, seg);
+  }
+}
+
+
+/* freeCheck -- check free block for splat pattern */
+
+static Bool freeCheck(PoolDebugMixin debug, Pool pool, Addr base, Addr limit)
+{
+  Addr p, next;
+  Size freeSize = debug->freeSize;
+  Res res;
+  Arena arena;
+  Seg seg;
+  Bool inSeg;
+
+  AVER(base < limit);
+
+  /* If the block is in a segment, make sure any shield is up. */
+  arena = PoolArena(pool);
+  inSeg = SegOfAddr(&seg, arena, base);
+  if (inSeg) {
+    AVER(limit <= SegLimit(seg));
+    ShieldExpose(arena, seg);
+  }
+  /* Compare this to the AddrCopys in freeSplat. */
+  /* Check the complete copies of the template in the block. */
+  for (p = base, next = AddrAdd(p, freeSize);
+       next <= limit && p < next /* watch out for overflow in next */;
+       p = next, next = AddrAdd(next, freeSize))
+    if (AddrComp(p, debug->freeTemplate, freeSize) != 0) {
+      res = FALSE; goto done;
+    }
+  /* Check the partial copy of the template at the tail of the block. */
+  if (next > limit || next < p)
+    if (AddrComp(p, debug->freeTemplate, AddrOffset(p, limit)) != 0) {
+      res = FALSE; goto done;
+    }
+  res = TRUE;
+
+done:
+  if (inSeg) {
+    ShieldCover(arena, seg);
+  }
+  return res;
+}
+
+
+/* freeCheckAlloc -- allocation wrapper for free-checking */
+
+static Res freeCheckAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
+                          Size size, Bool withReservoir)
+{
+  Res res;
+  Addr new;
+
+  AVER(aReturn != NULL);
+
+  res = SuperclassOfPool(pool)->alloc(&new, pool, size, withReservoir);
+  if (res != ResOK)
+    return res;
+  if (debug->freeSize != 0)
+    ASSERT(freeCheck(debug, pool, new, AddrAdd(new, size)),
+           "free space corrupted on alloc");
+
+  *aReturn = new;
+  return res;
+}
+
+
+/* freeCheckFree -- freeing wrapper for free-checking */
+
+static void freeCheckFree(PoolDebugMixin debug,
+                          Pool pool, Addr old, Size size)
+{
+  if (debug->freeSize != 0)
+    freeSplat(debug, pool, old, AddrAdd(old, size));
+  SuperclassOfPool(pool)->free(pool, old, size);
+}
+
+
+/* fenceAlloc -- allocation wrapper for fenceposts
  *
  * Allocates an object, adding fenceposts on both sides.  Layout:
  *
@@ -211,7 +342,7 @@ static void DebugPoolFinish(Pool pool)
  * the template is larger).
  */
 
-static Res FenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
+static Res fenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
                       Size size, Bool withReservoir)
 {
   Res res;
@@ -219,37 +350,31 @@ static Res FenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
   Size alignedSize;
 
   AVER(aReturn != NULL);
-  AVERT(PoolDebugMixin, debug);
-  AVERT(Pool, pool);
-  AVER(size > 0);
-  AVERT(Bool, withReservoir);
 
   alignedSize = SizeAlignUp(size, PoolAlignment(pool));
-  res = SuperclassOfPool(pool)->alloc(&new, pool,
-                                      alignedSize + 2*debug->fenceSize,
-                                      withReservoir);
+  res = freeCheckAlloc(&new, debug, pool, alignedSize + 2*debug->fenceSize,
+                       withReservoir);
   if (res != ResOK)
     return res;
   clientNew = AddrAdd(new, debug->fenceSize);
   /* @@@@ shields? */
   /* start fencepost */
-  AddrCopy(new, debug->fenceTemplate, debug->fenceSize);
+  (void)AddrCopy(new, debug->fenceTemplate, debug->fenceSize);
   /* alignment slop */
-  AddrCopy(AddrAdd(clientNew, size),
-           debug->fenceTemplate, alignedSize - size);
+  (void)AddrCopy(AddrAdd(clientNew, size),
+                 debug->fenceTemplate, alignedSize - size);
   /* end fencepost */
-  AddrCopy(AddrAdd(clientNew, alignedSize),
-           debug->fenceTemplate, debug->fenceSize);
+  (void)AddrCopy(AddrAdd(clientNew, alignedSize),
+                 debug->fenceTemplate, debug->fenceSize);
 
   *aReturn = clientNew;
   return res;
 }
 
 
-/* FenceCheck -- check fences of an object */
+/* fenceCheck -- check fences of an object */
 
-static Bool FenceCheck(PoolDebugMixin debug, Pool pool,
-                       Addr obj, Size size)
+static Bool fenceCheck(PoolDebugMixin debug, Pool pool, Addr obj, Size size)
 {
   Size alignedSize;
 
@@ -258,7 +383,8 @@ static Bool FenceCheck(PoolDebugMixin debug, Pool pool,
   /* Can't check obj */
 
   alignedSize = SizeAlignUp(size, PoolAlignment(pool));
-  /* Compare this to the memcpy's in FenceAlloc */
+  /* @@@@ shields? */
+  /* Compare this to the AddrCopys in fenceAlloc */
   return (AddrComp(AddrSub(obj, debug->fenceSize), debug->fenceTemplate,
                    debug->fenceSize) == 0
           && AddrComp(AddrAdd(obj, size), debug->fenceTemplate,
@@ -268,38 +394,30 @@ static Bool FenceCheck(PoolDebugMixin debug, Pool pool,
 }
 
 
-/* FenceFree -- freeing wrapper for fenceposts */
+/* fenceFree -- freeing wrapper for fenceposts */
 
-static void FenceFree(PoolDebugMixin debug,
+static void fenceFree(PoolDebugMixin debug,
                       Pool pool, Addr old, Size size)
 {
   Size alignedSize;
 
-  AVERT(PoolDebugMixin, debug);
-  AVERT(Pool, pool);
-  /* Can't check old */
-  AVER(size > 0);
-
-  ASSERT(FenceCheck(debug, pool, old, size), "fencepost check on free");
+  ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free");
 
   alignedSize = SizeAlignUp(size, PoolAlignment(pool));
-  SuperclassOfPool(pool)->free(pool, AddrSub(old, debug->fenceSize),
-                               alignedSize + 2*debug->fenceSize);
+  freeCheckFree(debug, pool, AddrSub(old, debug->fenceSize),
+                alignedSize + 2*debug->fenceSize);
 }
 
 
-/* TagAlloc -- allocation wrapper for tagged pools */
+/* tagAlloc -- allocation wrapper for tagged pools */
 
-static Res TagAlloc(PoolDebugMixin debug,
+static Res tagAlloc(PoolDebugMixin debug,
                     Pool pool, Addr new, Size size, Bool withReservoir)
 {
   Tag tag;
   Res res;
 
-  AVERT(PoolDebugMixin, debug);
-  AVERT(Pool, pool);
-  AVER(size > 0);
-
+  UNUSED(pool);
   res = PoolAlloc((Addr*)&tag, debug->tagPool, debug->tagSize, FALSE);
   if (res != ResOK) {
     if (withReservoir) { /* design.mps.object-debug.out-of-space */
@@ -318,9 +436,9 @@ static Res TagAlloc(PoolDebugMixin debug,
 }
 
 
-/* TagFree -- deallocation wrapper for tagged pools */
+/* tagFree -- deallocation wrapper for tagged pools */
 
-static void TagFree(PoolDebugMixin debug, Pool pool, Addr old, Size size)
+static void tagFree(PoolDebugMixin debug, Pool pool, Addr old, Size size)
 {
   SplayNode node;
   Tag tag;
@@ -351,7 +469,7 @@ static void TagFree(PoolDebugMixin debug, Pool pool, Addr old, Size size)
  */
 
 static Res DebugPoolAlloc(Addr *aReturn,
-                           Pool pool, Size size, Bool withReservoir)
+                          Pool pool, Size size, Bool withReservoir)
 {
   Res res;
   Addr new;
@@ -365,19 +483,24 @@ static Res DebugPoolAlloc(Addr *aReturn,
   debug = DebugPoolDebugMixin(pool);
   AVER(debug != NULL);
   AVERT(PoolDebugMixin, debug);
-  res = FenceAlloc(&new, debug, pool, size, withReservoir);
+  if (debug->fenceSize != 0)
+    res = fenceAlloc(&new, debug, pool, size, withReservoir);
+  else
+    res = freeCheckAlloc(&new, debug, pool, size, withReservoir);
   if (res != ResOK)
     return res;
   /* Allocate object first, so it fits even when the tag doesn't. */
-  res = TagAlloc(debug, pool, new, size, withReservoir);
-  if (res != ResOK)
-    goto tagFail;
+  if (debug->tagInit != NULL) {
+    res = tagAlloc(debug, pool, new, size, withReservoir);
+    if (res != ResOK)
+      goto tagFail;
+  }
 
   *aReturn = new;
   return res;
 
 tagFail:
-  FenceFree(debug, pool, new, size);
+  fenceFree(debug, pool, new, size);
   return res;
 }
 
@@ -395,13 +518,18 @@ static void DebugPoolFree(Pool pool, Addr old, Size size)
   debug = DebugPoolDebugMixin(pool);
   AVER(debug != NULL);
   AVERT(PoolDebugMixin, debug);
-  FenceFree(debug, pool, old, size);
+
+  if (debug->fenceSize != 0)
+    fenceFree(debug, pool, old, size);
+  else
+    freeCheckFree(debug, pool, old, size);
   /* Free the object first, to get fences checked before tag. */
-  TagFree(debug, pool, old, size);
+  if (debug->tagInit != NULL)
+    tagFree(debug, pool, old, size);
 }
 
 
-/* TagWalk -- walk all object in the pool using tags */
+/* TagWalk -- walk all objects in the pool using tags */
 
 typedef void (*ObjectsStepMethod)(Addr addr, Size size, Format fmt,
                                   Pool pool, void *tagData, void *p);
@@ -434,21 +562,21 @@ static void TagWalk(Pool pool, ObjectsStepMethod step, void *p)
 }
 
 
-/* FenceCheckingStep -- step function for DebugPoolCheckFences */
+/* fenceCheckingStep -- step function for DebugPoolCheckFences */
 
-static void FenceCheckingStep(Addr addr, Size size, Format fmt,
+static void fenceCheckingStep(Addr addr, Size size, Format fmt,
                               Pool pool, void *tagData, void *p)
 {
   /* no need to check arguments checked in the caller */
   UNUSED(fmt); UNUSED(tagData);
-  ASSERT(FenceCheck((PoolDebugMixin)p, pool, addr, size),
+  ASSERT(fenceCheck((PoolDebugMixin)p, pool, addr, size),
          "fencepost check requested by client");
 }
 
 
 /* DebugPoolCheckFences -- check all the fenceposts in the pool */
 
-static void DebugPoolCheckFences(Pool pool)
+void DebugPoolCheckFences(Pool pool)
 {
   PoolDebugMixin debug;
 
@@ -458,37 +586,84 @@ static void DebugPoolCheckFences(Pool pool)
     return;
   AVERT(PoolDebugMixin, debug);
 
-  TagWalk(pool, FenceCheckingStep, (void *)debug);
+  if (debug->fenceSize != 0)
+    TagWalk(pool, fenceCheckingStep, (void *)debug);
 }
 
 
-/* PoolClassMixInDebug -- mix in the debug support for class init */
+/* DebugPoolFreeSplat -- if in a free-checking debug pool, splat free block */
 
-void PoolClassMixInDebug(PoolClass class)
+void DebugPoolFreeSplat(Pool pool, Addr base, Addr limit)
 {
-  /* Can't check class because it's not initialized yet */
-  class->init = DebugPoolInit;
-  class->finish = DebugPoolFinish;
-  class->alloc = DebugPoolAlloc;
-  class->free = DebugPoolFree;
+  PoolDebugMixin debug;
+
+  AVERT(Pool, pool);
+  AVER(PoolHasAddr(pool, base));
+  AVER(PoolHasAddr(pool, AddrSub(limit, 1)));
+
+  debug = DebugPoolDebugMixin(pool);
+  if (debug != NULL) {
+    AVERT(PoolDebugMixin, debug);
+    if (debug->freeSize != 0)
+      freeSplat(debug, pool, base, limit);
+  }
 }
 
 
-/* mps_pool_check_fenceposts -- check all the fenceposts in the pool */
+/* DebugPoolFreeCheck -- if in a free-checking debug pool, check free block */
 
-void mps_pool_check_fenceposts(mps_pool_t mps_pool)
+void DebugPoolFreeCheck(Pool pool, Addr base, Addr limit)
 {
-  Pool pool = (Pool)mps_pool;
-  Arena arena;
- 
-  /* CHECKT not AVERT, see design.mps.interface.c.check.space */
-  AVER(CHECKT(Pool, pool));
-  arena = PoolArena(pool);
+  PoolDebugMixin debug;
 
-  ArenaEnter(arena);
+  AVERT(Pool, pool);
+  AVER(PoolHasAddr(pool, base));
+  AVER(PoolHasAddr(pool, AddrSub(limit, 1)));
+
+  debug = DebugPoolDebugMixin(pool);
+  if (debug != NULL) {
+    AVERT(PoolDebugMixin, debug);
+    if (debug->freeSize != 0)
+      ASSERT(freeCheck(debug, pool, base, limit),
+             "free space corrupted on release");
+  }
+}
+
+
+/* freeCheckingStep -- step function for DebugPoolCheckFreeSpace */
+
+static void freeCheckingStep(Addr base, Addr limit, Pool pool, void *p)
+{
+  /* no need to check arguments checked in the caller */
+  ASSERT(freeCheck((PoolDebugMixin)p, pool, base, limit),
+         "free space corrupted on client check");
+}
+
+
+/* DebugPoolCheckFreeSpace -- check free space in the pool for overwrites */
+
+void DebugPoolCheckFreeSpace(Pool pool)
+{
+  PoolDebugMixin debug;
 
   AVERT(Pool, pool);
-  DebugPoolCheckFences(pool);
+  debug = DebugPoolDebugMixin(pool);
+  if (debug == NULL)
+    return;
+  AVERT(PoolDebugMixin, debug);
+
+  if (debug->freeSize != 0)
+    PoolFreeWalk(pool, freeCheckingStep, (void *)debug);
+}
+
+
+/* PoolClassMixInDebug -- mix in the debug support for class init */
 
-  ArenaLeave(arena);
+void PoolClassMixInDebug(PoolClass class)
+{
+  /* Can't check class because it's not initialized yet */
+  class->init = DebugPoolInit;
+  class->finish = DebugPoolFinish;
+  class->alloc = DebugPoolAlloc;
+  class->free = DebugPoolFree;
 }
diff --git a/mps/code/dbgpool.h b/mps/code/dbgpool.h
index 6632606787d..d78610504fb 100644
--- a/mps/code/dbgpool.h
+++ b/mps/code/dbgpool.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 #ifndef dbgpool_h
@@ -25,6 +26,8 @@ typedef void (*TagInitMethod)(void* tag, va_list args);
 typedef struct PoolDebugOptionsStruct {
   void* fenceTemplate;
   Size  fenceSize;
+  void* freeTemplate;
+  Size  freeSize;
   /* TagInitMethod tagInit; */
   /* Size  tagSize; */
 } PoolDebugOptionsStruct;
@@ -40,6 +43,8 @@ typedef struct PoolDebugMixinStruct {
   Sig sig;
   Addr fenceTemplate;
   Size fenceSize;
+  Addr freeTemplate;
+  Size freeSize;
   TagInitMethod tagInit;
   Size tagSize;
   Pool tagPool;
@@ -50,8 +55,13 @@ typedef struct PoolDebugMixinStruct {
 
 extern Bool PoolDebugMixinCheck(PoolDebugMixin dbg);
 
-
 extern void PoolClassMixInDebug(PoolClass class);
 
+extern void DebugPoolCheckFences(Pool pool);
+extern void DebugPoolCheckFreeSpace(Pool pool);
+
+extern void DebugPoolFreeSplat(Pool pool, Addr base, Addr limit);
+extern void DebugPoolFreeCheck(Pool pool, Addr base, Addr limit);
+
 
 #endif /* dbgpool_h */
diff --git a/mps/code/dbgpooli.c b/mps/code/dbgpooli.c
new file mode 100644
index 00000000000..b38a0ee837d
--- /dev/null
+++ b/mps/code/dbgpooli.c
@@ -0,0 +1,54 @@
+/* impl.c.dbgpooli: POOL DEBUG MIXIN C INTERFACE
+ *
+ * $Id: dbgpooli.c,v 1.3 2002/02/01 14:27:26 pekka Exp $
+ * $HopeName: MMsrc!dbgpooli.c(trunk.3) $
+ * Copyright (C) 2002 Global Graphics Software.
+ *
+ * .source: design.mps.object-debug
+ */
+
+#include "dbgpool.h"
+#include "mps.h"
+#include "mpm.h"
+
+SRCID(dbgpooli, "$Id: dbgpooli.c,v 1.3 2002/02/01 14:27:26 pekka Exp $");
+
+
+/* mps_pool_check_fenceposts -- check all the fenceposts in the pool */
+
+void mps_pool_check_fenceposts(mps_pool_t mps_pool)
+{
+  Pool pool = (Pool)mps_pool;
+  Arena arena;
+  
+  /* CHECKT not AVERT, see design.mps.interface.c.check.space */
+  AVER(CHECKT(Pool, pool));
+  arena = PoolArena(pool);
+
+  ArenaEnter(arena);
+
+  AVERT(Pool, pool);
+  DebugPoolCheckFences(pool);
+
+  ArenaLeave(arena);
+}
+
+
+/* mps_pool_check_free_space -- check free space in the pool for overwrites */
+
+void mps_pool_check_free_space(mps_pool_t mps_pool)
+{
+  Pool pool = (Pool)mps_pool;
+  Arena arena;
+  
+  /* CHECKT not AVERT, see design.mps.interface.c.check.space */
+  AVER(CHECKT(Pool, pool));
+  arena = PoolArena(pool);
+
+  ArenaEnter(arena);
+
+  AVERT(Pool, pool);
+  DebugPoolCheckFreeSpace(pool);
+
+  ArenaLeave(arena);
+}
diff --git a/mps/code/eventcnv.c b/mps/code/eventcnv.c
index e93030b2055..c7e6ffaa515 100644
--- a/mps/code/eventcnv.c
+++ b/mps/code/eventcnv.c
@@ -1,5 +1,4 @@
 /* impl.c.eventcnv: Simple event log converter
- * Copyright (c) 2001 Ravenbrook Limited.
  *
  * $Id$
  */
diff --git a/mps/code/eventgen.h b/mps/code/eventgen.h
index 3071a9efe43..ecfc946aabc 100644
--- a/mps/code/eventgen.h
+++ b/mps/code/eventgen.h
@@ -1,7 +1,6 @@
 /* impl.h.eventgen -- Automatic event header
  *
  * $Id$
- * $HopeName$
  * Copyright (c) 2001 Ravenbrook Limited.
  *
  * DO NOT EDIT THIS FILE!
diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index 1fa1a5cfd94..bc7537ec542 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * DESIGN
  *
@@ -32,7 +33,10 @@
 
 #define testArenaSIZE   ((size_t)16<<20)
 #define rootCOUNT 20
-#define churnFACTOR 30
+#define churnFACTOR 10
+#define finalizationRATE 6
+#define gcINTERVAL ((size_t)150 * 1024)
+#define collectionCOUNT 3
 #define slotSIZE (3*sizeof(mps_word_t))
 #define genCOUNT 2
 
@@ -65,17 +69,25 @@ static void churn(mps_ap_t ap)
   mps_addr_t p;
   mps_res_t e;
 
-  for(i = 0; i < churnFACTOR; ++i) {
+  for (i = 0; i < churnFACTOR; ++i) {
     do {
       MPS_RESERVE_BLOCK(e, p, ap, 4096);
       die(e, "MPS_RESERVE_BLOCK");
       die(dylan_init(p, 4096, root, 1), "dylan_init");
-    } while(!mps_commit(ap, p, 4096));
+    } while (!mps_commit(ap, p, 4096));
   }
   p = NULL;
 }
 
 
+enum {
+  rootSTATE,
+  deadSTATE,
+  finalizableSTATE,
+  finalizedSTATE
+};
+
+
 static void *test(void *arg, size_t s)
 {
   int i;                        /* index */
@@ -85,8 +97,12 @@ static void *test(void *arg, size_t s)
   mps_pool_t amc;
   mps_res_t e;
   mps_root_t mps_root[2];
+  int state[rootCOUNT];
   mps_arena_t arena;
   void *p = NULL;
+#ifdef CONFIG_PROD_EPCORE
+  size_t gcThreshold;
+#endif
   mps_message_t message;
 
   arena = (mps_arena_t)arg;
@@ -105,30 +121,48 @@ static void *test(void *arg, size_t s)
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
 
   /* design.mps.poolmrg.test.promise.ut.alloc */
-  for(i = 0; i < rootCOUNT; ++i) {
+  for (i = 0; i < rootCOUNT; ++i) {
     do {
       MPS_RESERVE_BLOCK(e, p, ap, slotSIZE);
       die(e, "MPS_RES_OK");
       die(dylan_init(p, slotSIZE, root, 1), "dylan_init");
-    } while(!mps_commit(ap, p, slotSIZE));
+    } while (!mps_commit(ap, p, slotSIZE));
     ((mps_word_t *)p)[2] = dylan_int(i);
     die(mps_finalize(arena, &p), "finalize\n");
-    root[i] = p;
+    root[i] = p; state[i] = rootSTATE;
   }
   p = NULL;
 
-  /* design.mps.poolmrg.test.promise.ut.drop */
-  for(i = 0; i < rootCOUNT; ++i) {
-    if (rnd() % 2 == 0)
-      root[i] = NULL;
-  }
-
   mps_message_type_enable(arena, mps_message_type_finalization());
 
+#ifdef CONFIG_PROD_EPCORE
+  gcThreshold = mps_arena_committed(arena) + gcINTERVAL;
+#endif
   /* design.mps.poolmrg.test.promise.ut.churn */
-  while(mps_collections(arena) < 3) {
+  while (mps_collections(arena) < collectionCOUNT) {
     churn(ap);
-    while(mps_message_poll(arena)) {
+    /* design.mps.poolmrg.test.promise.ut.drop */
+    for (i = 0; i < rootCOUNT; ++i) {
+      if (root[i] != NULL && state[i] == rootSTATE) {
+        if (rnd() % finalizationRATE == 0) {
+          /* definalize some of them */
+          if (rnd() % 2 == 0) {
+            die(mps_definalize(arena, &root[i]), "definalize\n");
+            state[i] = deadSTATE;
+          } else {
+            state[i] = finalizableSTATE;
+          }
+          root[i] = NULL;
+        }
+      }
+    }
+#ifdef CONFIG_PROD_EPCORE
+    if (mps_arena_committed(arena) > gcThreshold) {
+      die(mps_arena_collect(arena), "collect");
+      gcThreshold = mps_arena_committed(arena) + gcINTERVAL;
+    }
+#endif
+    while (mps_message_poll(arena)) {
       mps_word_t *obj;
       mps_word_t objind;
       mps_addr_t objaddr;
@@ -141,8 +175,12 @@ static void *test(void *arg, size_t s)
       objind = dylan_int_int(obj[2]);
       printf("Finalizing: object %lu at %p\n", objind, objaddr);
       /* design.mps.poolmrg.test.promise.ut.final.check */
-      cdie(root[objind] == NULL, "died");
-      root[objind] = objaddr;
+      cdie(root[objind] == NULL, "finalized live");
+      cdie(state[objind] == finalizableSTATE, "finalized dead");
+      state[objind] = finalizedSTATE;
+      /* sometimes resurrect */
+      if (rnd() % 2 == 0)
+        root[objind] = objaddr;
       mps_message_discard(arena, message);
     }
   }
diff --git a/mps/code/fmtdy.c b/mps/code/fmtdy.c
index 52d9d871f98..ce517aa24fd 100644
--- a/mps/code/fmtdy.c
+++ b/mps/code/fmtdy.c
@@ -1,7 +1,8 @@
 /* impl.c.fmtdy: DYLAN OBJECT FORMAT IMPLEMENTATION
  *
- *  $Id$
- *  Copyright (c) 2001 Ravenbrook Limited.
+ * $Id$
+ * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .readership: MPS developers, Dylan developers
  *
@@ -56,29 +57,14 @@
 #include <assert.h>
 #include <string.h>
 #include <stdlib.h>
-
-#ifdef MPS_PF_SUS8LC
-/* .hack.stderr: builder.lc (LCC) uses Sun's header files.  Sun's
- * assert.h is broken, as it assumes it can use stderr.  We have to
- * fix it by supplying stderr.
- */
-#include <stdio.h>
-#endif
+#include <limits.h>
 
 
 #define notreached()    assert(0)
 #define unused(param)   ((void)param)
 
-#ifdef MPS_BUILD_MV
 
-/* MSVC 2.0 generates a warning for unused(). */
 #ifdef _MSC_VER
-#if _MSC_VER < 1000
-#pragma warning(disable: 4705)
-#endif
-#else /* _MSC_VER */
-#error "Expected _MSC_VER to be defined for builder.mv"
-#endif /* _MSC_VER */
 
 /* MPS_END causes "constant conditional" warnings. */
 #pragma warning(disable: 4127)
@@ -87,11 +73,15 @@
 /* has been removed". */
 #pragma warning(disable: 4514)
 
-#endif /* MPS_BUILD_MV */
+#endif /* _MSC_VER */
 
 
 #define ALIGN           sizeof(mps_word_t)
 
+#define MPS_WORD_WIDTH (sizeof(mps_word_t) * CHAR_BIT)
+#define MPS_WORD_SHIFT (MPS_WORD_WIDTH == 64 ? 6 : 5)
+/* MPS_WORD_SHIFT is a bit hacky, but good enough for tests. */
+
 #ifdef FMTDY_COUNTING
 #define FMTDY_COUNT(x) x
 #define FMTDY_FL_LIMIT 16
@@ -198,7 +188,7 @@ int dylan_wrapper_check(mps_word_t *w)
   assert(ff == 2 || t == 0);
 
   /* The number of patterns is (fixed fields+31)/32. */
-  assert(ff != 2 || t == ((fl + MPS_WORD_WIDTH - 1) >> MPS_WORD_SHIFT));
+  assert(ff != 2 || t == ((fl + MPS_WORD_WIDTH - 1) / MPS_WORD_WIDTH));
 
   /* The patterns are random bits, so we can't check them.  However, */
   /* the left-over bits in the last pattern should be zero. */
@@ -361,12 +351,14 @@ static mps_res_t dylan_scan_pat(mps_ss_t mps_ss,
   return MPS_RES_OK;
 }
 
+
 #define NONWORD_LENGTH(_vt, _es) \
   ((_es) < MPS_WORD_SHIFT ? \
    ((_vt) + (1 << (MPS_WORD_SHIFT - (_es))) - 1) >> \
      (MPS_WORD_SHIFT - (_es)) : \
    (_vt) << ((_es) - MPS_WORD_SHIFT))
 
+
 extern mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io)
 {
   mps_addr_t *p;        /* cursor in object */
@@ -408,7 +400,8 @@ extern mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io)
     return MPS_RES_OK;
   }
 
-  mps_fix(mps_ss, p);           /* fix the wrapper */
+  res = mps_fix(mps_ss, p);     /* fix the wrapper */
+  if ( res != MPS_RES_OK ) return res;
   w = (mps_word_t *)p[0];       /* wrapper is header word */
   assert(dylan_wrapper_check(w));
 
@@ -563,7 +556,8 @@ extern mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io)
   /* object should not be forwarded (as there is no forwarding method) */
   assert((h & 3) == 0);
 
-  mps_fix(mps_ss, p);
+  res = mps_fix(mps_ss, p);
+  if ( res != MPS_RES_OK ) return res;
 
   /* w points to wrapper */
   w = (mps_word_t *)p[0];
@@ -688,7 +682,7 @@ static void dylan_copy(mps_addr_t old, mps_addr_t new)
   assert(dylan_wrapper_check(*(mps_word_t **)old));
   /* .improve.memcpy: Can do better here as we know that new and old
    * will be aligned (to MPS_PF_ALIGN) */
-  memcpy(new, old, length);
+  (void)memcpy(new, old, length);
 }
 
 static mps_addr_t dylan_isfwd(mps_addr_t object)
diff --git a/mps/code/fmthe.c b/mps/code/fmthe.c
index 69a1220dbab..ff4b787b60e 100644
--- a/mps/code/fmthe.c
+++ b/mps/code/fmthe.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * Uses impl.c.fmtdy for the actual Dylan format, and just adds
  * a thin layer to handle the object headers themselves.
@@ -15,17 +16,6 @@
 #include <string.h>
 #include <stdlib.h>
 
-#include "mpstd.h"
-#ifdef MPS_PF_SUS8LC
-/* .hack.stderr: builder.lc (LCC) uses Sun's header files.  Sun's
- * assert.h is broken, as it assumes it can use stderr.  We have to
- * fix it by supplying stderr.
- */
-#include <stdio.h>
-/* Better include ossu.h as well, in case we use other stuff from stdio.h. */
-#include "ossu.h"
-#endif
-
 #include "testlib.h"
 
 
@@ -99,10 +89,6 @@ static mps_addr_t dylan_header_skip(mps_addr_t object)
 {
   mps_addr_t *p;        /* cursor in object */
   int header;
-
-  p = (mps_addr_t *)object;
-  assert(p != NULL);
-
   header = *(int*)((char*)object - headerSIZE);
   switch(headerType(header)) {
   case realTYPE:
diff --git a/mps/code/fmthe.h b/mps/code/fmthe.h
index f4b5121a17d..f46e2444b5e 100644
--- a/mps/code/fmthe.h
+++ b/mps/code/fmthe.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 #ifndef fmthe_h
diff --git a/mps/code/format.c b/mps/code/format.c
index 3fbf0972a9b..d2235300288 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * DESIGN
  *
@@ -27,7 +28,8 @@ Bool FormatCheck(Format format)
   CHECKL(AlignCheck(format->alignment));
   /* @@@@ alignment should be less than maximum allowed */
   CHECKL(FUNCHECK(format->scan));
-  CHECKL(FUNCHECK(format->skip));
+  CHECKL(format->variety == FormatVarietyFixed
+         ? format->skip == NULL : FUNCHECK(format->skip));
   CHECKL(FUNCHECK(format->move));
   CHECKL(FUNCHECK(format->isMoved));
   /* Ignore unused copy field. */
@@ -82,13 +84,13 @@ Res FormatCreate(Format *formatReturn, Arena arena,
   format->isMoved = isMoved;
   format->copy = copy;
   format->pad = pad;
-  if(class == NULL) {
+  if (class == NULL) {
     format->class = &FormatDefaultClass;
   } else {
     AVER(variety == FormatVarietyB);
     format->class = class;
   }
-  if(headerSize != 0) {
+  if (headerSize != 0) {
     AVER(variety == FormatVarietyAutoHeader);
     format->headerSize = headerSize;
   } else {
@@ -108,6 +110,8 @@ Res FormatCreate(Format *formatReturn, Arena arena,
 }
 
 
+/* FormatDestroy -- destroy a format */
+
 void FormatDestroy(Format format)
 {
   AVERT(Format, format);
@@ -122,7 +126,10 @@ void FormatDestroy(Format format)
 }
 
 
-/* Must be thread safe.  See design.mps.interface.c.thread-safety. */
+/* FormatArena -- find the arena of a format
+ *
+ * Must be thread-safe.  See design.mps.interface.c.thread-safety. */
+
 Arena FormatArena(Format format)
 {
   /* Can't AVER format as that would not be thread-safe */
@@ -131,6 +138,8 @@ Arena FormatArena(Format format)
 }
 
 
+/* FormatDescribe -- describe a format */
+
 Res FormatDescribe(Format format, mps_lib_FILE *stream)
 {
   Res res;
@@ -148,7 +157,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream)
                "  pad $F\n", (WriteFF)format->pad,
                "} Format $P ($U)\n", (WriteFP)format, (WriteFU)format->serial,
                NULL);
-  if(res != ResOK) return res;
+  if (res != ResOK) return res;
 
   return ResOK;
 }
diff --git a/mps/code/gathconf.bat b/mps/code/gathconf.bat
deleted file mode 100644
index ceee789d71d..00000000000
--- a/mps/code/gathconf.bat
+++ /dev/null
@@ -1,37 +0,0 @@
-@rem impl.bat.gathconf: GATHERING A RELEASE FOR CONFIGURA
-@rem
-@rem $Id$
-@rem Copyright (c) 2001 Ravenbrook Limited.
-
-rmdir /s w3i3mv
-nmake /f w3i3mv.nmk VARIETY=we mps_conf.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=wi mps_conf.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=ce mps_conf.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=ci mps_conf.lib mpsplan.lib
-mkdir release
-mkdir release\include
-mkdir release\lib
-mkdir release\lib\w3i3
-mkdir release\lib\w3i3\release
-mkdir release\lib\w3i3\debug
-mkdir release\src
-copy mps.h release\include
-copy mpsavm.h release\include
-copy mpsacl.h release\include
-copy mpscamc.h release\include
-copy mpscams.h release\include
-copy mpsclo.h release\include
-copy mpscmv.h release\include
-copy mpscmvff.h release\include
-copy mpscsnc.h release\include
-copy mpsio.h release\include
-copy mpslib.h release\include
-copy mpstd.h release\include
-copy mpsw3.h release\include
-copy mpswin.h release\include
-copy w3i3mv\we\mps_conf.lib release\lib\w3i3\release
-copy w3i3mv\ce\mps_conf.lib release\lib\w3i3\debug
-copy w3i3mv\we\mpsplan.lib release\lib\w3i3\release
-copy w3i3mv\ce\mpsplan.lib release\lib\w3i3\debug
-copy mpsliban.c release\src
-copy mpsioan.c release\src
diff --git a/mps/code/global.c b/mps/code/global.c
index 1cda9b58d71..38a27080e84 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .sources: See design.mps.arena.  design.mps.thread-safety is relevant
  * to the functions ArenaEnter and ArenaLeave in this file.
@@ -20,13 +21,12 @@
  * functions should be in some other module, they just ended up here by
  * confusion over naming.  */
 
-#include "dongle.h"
+#include "bt.h"
 #include "poolmrg.h"
 #include "mps.h" /* finalization */
 #include "poolmv.h"
 #include "mpm.h"
 
-
 SRCID(global, "$Id$");
 
 
@@ -217,9 +217,6 @@ Res GlobalsInit(Globals arenaGlobals)
   /* so check static consistency here. */
   AVER(MPMCheck());
 
-  if (!DongleTestFull())
-    return ResFAIL;
-
   arenaClaimRingLock();
   /* Ensure static things are initialized. */
   if (!arenaRingInit) {
@@ -542,12 +539,6 @@ void ArenaPoll(Globals globals)
 
   AVERT(Globals, globals);
 
-  if (!DONGLE_TEST_QUICK()) {
-    /* Cripple it by deleting the control pool. */
-    GlobalsArena(globals)->poolReady = FALSE; /* suppress check */
-    PoolFinish(ArenaControlPool(GlobalsArena(globals)));
-    return;
-  }
   if (globals->clamped)
     return;
   size = globals->fillMutatorSize;
@@ -589,7 +580,7 @@ Res ArenaFinalize(Arena arena, Ref obj)
   Res res;
 
   AVERT(Arena, arena);
-  /* Could consider checking that Ref is valid. */
+  AVER(ArenaHasAddr(arena, (Addr)obj));
 
   if (!arena->isFinalPool) {
     Pool pool;
@@ -600,9 +591,27 @@ Res ArenaFinalize(Arena arena, Ref obj)
     arena->finalPool = pool;
     arena->isFinalPool = TRUE;
   }
-  AVER(arena->isFinalPool);
 
-  res = MRGRegister(arena->finalPool, (Ref)obj);
+  res = MRGRegister(arena->finalPool, obj);
+  return res;
+}
+
+
+/* ArenaDefinalize -- removes one finalization registration of an object
+ *
+ * See design.mps.finalize.  */
+
+Res ArenaDefinalize(Arena arena, Ref obj)
+{
+  Res res;
+
+  AVERT(Arena, arena);
+  AVER(ArenaHasAddr(arena, (Addr)obj));
+
+  if (!arena->isFinalPool) {
+    return ResFAIL;
+  }
+  res = MRGDeregister(arena->finalPool, obj);
   return res;
 }
 
diff --git a/mps/code/hqbuild/data/cv_alpha.txt b/mps/code/hqbuild/data/cv_alpha.txt
deleted file mode 100644
index cb5d08aa6c5..00000000000
--- a/mps/code/hqbuild/data/cv_alpha.txt
+++ /dev/null
@@ -1 +0,0 @@
-MSVCNT  5_0
diff --git a/mps/code/hqbuild/data/cv_x86.txt b/mps/code/hqbuild/data/cv_x86.txt
deleted file mode 100644
index 1feeab52711..00000000000
--- a/mps/code/hqbuild/data/cv_x86.txt
+++ /dev/null
@@ -1,3 +0,0 @@
-MSVCNT  5_0
-MSTOOLS Aug96US9
-MSMASM  6.11
diff --git a/mps/code/hqbuild/tools/hqbuild b/mps/code/hqbuild/tools/hqbuild
deleted file mode 100644
index 3101120869b..00000000000
--- a/mps/code/hqbuild/tools/hqbuild
+++ /dev/null
@@ -1,20 +0,0 @@
-#!/bin/sh
-# impl.sh.hqbuild
-#
-# $Id$
-# Copyright (c) 2001 Ravenbrook Limited.
-#
-# Build script for SWIG autobuild system.
-# The SWIG autobuild system expects to execute this file passing it
-# an argument.
-#
-# We specify that the argument will be the platform code to make life
-# easy for us
-
-case $# in
- 1) ;;
- *) echo 1>&2 'Wrong number of arguments to hqbuild.
-Exactly one argument expected'; exit 1;;
-esac
-
-gnumake -r -f "$1.gmk"
diff --git a/mps/code/hqbuild/tools/hqbuild.bat b/mps/code/hqbuild/tools/hqbuild.bat
deleted file mode 100644
index a0862a92fe8..00000000000
--- a/mps/code/hqbuild/tools/hqbuild.bat
+++ /dev/null
@@ -1,12 +0,0 @@
-@REM impl.bat.hqbuild: setup for SWIG autobuild system
-@REM $Id$
-@REM Copyright (c) 2001 Ravenbrook Limited.
-@REM Called by SWIG autobuild system
-@
-@REM we expect whatcom to have set MSVCNT and possibly MSMASM and MSTOOLS
-IF NOT %MSMASM%X == X SET PATH=%MSMASM%\bin;%PATH%
-SET PATH=%MSVCNT%\..\sharedide\bin\ide;%MSVCNT%\..\sharedide\bin;%MSVCNT%\bin;%PATH%
-SET INCLUDE=%MSVCNT%\include;%MSVCNT%\mfc\include;%INCLUDE%
-SET LIB=%MSVCNT%\lib;%MSVCNT%\mfc\lib;%LIB%
-@REM First argument is expected to be platform code, rest we pass on
-nmake /f %1.nmk %2 %3 %4 %5 %6 %7 %8 %9
diff --git a/mps/code/lo.h b/mps/code/lo.h
index 21ffbdaf108..2f50920d73a 100644
--- a/mps/code/lo.h
+++ b/mps/code/lo.h
@@ -1,4 +1,4 @@
-/*  impl.h.lo
+/*  impl.h.lo: LEAF OBJECT POOL CLASS INTERFACE
  *
  *                   LEAF OBJECT POOL CLASS
  *
@@ -29,7 +29,6 @@
  *
  *  Space and time performance will degrade when fragmentation
  *  increases.
- *
  */
 
 #ifndef lo_h
diff --git a/mps/code/locbwcss.c b/mps/code/locbwcss.c
new file mode 100644
index 00000000000..e5c267dff8f
--- /dev/null
+++ b/mps/code/locbwcss.c
@@ -0,0 +1,206 @@
+/* impl.c.locbwcss: LOCUS BACKWARDS COMPATIBILITY STRESS TEST
+ *
+ * $Id: locbwcss.c,v 1.4 2002/05/10 11:11:39 pekka Exp $
+ * $HopeName: MMsrc!locbwcss.c(trunk.4) $
+ * Copyright (c) 2001 Ravenbrook Limited.
+ */
+
+#include "mpscmvff.h"
+#include "mpslib.h"
+#include "mpsavm.h"
+#include "testlib.h"
+#include "mps.h"
+
+#include <stdlib.h>
+#include <stdarg.h>
+
+
+/* some constants */
+
+#define TRUE  1
+#define FALSE 0
+
+#define iterationCount 30          /* number of iterations */
+#define allocsPerIteration 8       /* number of allocs each iteration */
+#define chunkSize ((size_t)65536)  /* our allocation chunk size */
+
+#define testArenaSIZE \
+  ((size_t)(chunkSize * iterationCount * allocsPerIteration * 3))
+
+
+#define AddressOffset(b, l) \
+  ((size_t)((char *)(l) - (char *)(b)))
+
+
+/* PoolStat -- maintain data about contiguous allocations */ 
+
+typedef struct PoolStatStruct *PoolStat;
+
+typedef struct PoolStatStruct {
+  mps_pool_t pool;  /* the pool being measured */
+  size_t objSize;   /* size of each allocation */
+  mps_addr_t min;   /* lowest address lock allocated to the pool */
+  mps_addr_t max;   /* highest address lock allocated to the pool */
+  int ncCount;      /* count of non-contiguous allocations */
+  int aCount;       /* count of allocations */
+  int fCount;       /* count of frees */
+} PoolStatStruct;
+
+
+
+static mps_addr_t allocObject(mps_pool_t pool, size_t size)
+{
+  mps_addr_t addr;
+  die(mps_alloc(&addr, pool, size),
+      "Allocate Object");
+  return addr;
+}
+
+
+static void recordNewObjectStat(PoolStat stat, mps_addr_t obj)
+{
+  stat->aCount++;
+  if (obj < stat->min) {
+    if (AddressOffset(obj, stat->min) > stat->objSize) {
+      stat->ncCount++;
+    }
+    stat->min = obj;
+  } else if (obj > stat->max) {
+    if (AddressOffset(stat->max, obj) > stat->objSize) {
+      stat->ncCount++;
+    }
+    stat->max = obj;
+  }
+}
+
+static void recordFreedObjectStat(PoolStat stat)
+{
+  stat->fCount++;
+}
+
+
+static void poolStatInit(PoolStat stat, mps_pool_t pool, size_t objSize)
+{
+  mps_addr_t s1, s2, s3;
+
+  stat->pool = pool;
+  stat->objSize = objSize;
+  stat->ncCount = 0;
+  stat->aCount = 0;
+  stat->fCount = 0;
+
+  /* allocate 3 half-size sentinel objects, freeing the middle one */
+  /* to leave a bit of space for the control pool */
+  s1 = allocObject(pool, objSize / 2);
+  stat->min = s1;
+  stat->max = s1;
+  stat->aCount++;
+
+  s2 = allocObject(pool, objSize / 2);
+  recordNewObjectStat(stat, s2);
+  s3 = allocObject(pool, objSize / 2);
+  recordNewObjectStat(stat, s3);
+
+  mps_free(pool, s2, objSize / 2);  
+  recordFreedObjectStat(stat);
+
+}
+
+
+static void allocMultiple(PoolStat stat)
+{
+  mps_addr_t objects[allocsPerIteration];
+  int i;
+
+  /* allocate a few objects, and record stats for them */
+  for (i = 0; i < allocsPerIteration; i++) {
+    mps_addr_t obj = allocObject(stat->pool, stat->objSize);
+    recordNewObjectStat(stat, obj);
+    objects[i] = obj;
+  }
+
+  /* free one of the objects, to make the test more interesting */
+  i = rnd() % allocsPerIteration;
+  mps_free(stat->pool, objects[i], stat->objSize);  
+  recordFreedObjectStat(stat);
+
+}
+
+
+/* reportResults - print a report on a PoolStat */
+
+static void reportResults(PoolStat stat, char *name)
+{
+  printf("\nResults for ");
+  printf(name);
+  printf("\n");
+  printf("   Allocated  %lu objects\n", (unsigned long)stat->aCount);
+  printf("   Freed      %lu objects\n", (unsigned long)stat->fCount);
+  printf("   There were %lu non-contiguous allocations\n", 
+         (unsigned long)stat->ncCount);
+  printf("   Address range from %p to %p\n",
+         (void *)stat->min, (void *)stat->max);
+  printf("\n");
+}
+
+
+static void testInArena(mps_arena_t arena)
+{
+  mps_pool_t lopool, hipool;
+  PoolStatStruct lostruct;  /* stats about lopool */
+  PoolStatStruct histruct;  /* stats about lopool */
+  PoolStat lostat = &lostruct;
+  PoolStat histat = &histruct;
+  int i;
+
+  die(mps_pool_create(&hipool, arena, mps_class_mvff(), 
+                      chunkSize, chunkSize, 1024, 
+                      TRUE, TRUE, TRUE),
+      "Create HI MFFV");
+
+  die(mps_pool_create(&lopool, arena, mps_class_mvff(), 
+                      chunkSize, chunkSize, 1024, 
+                      FALSE, FALSE, TRUE),
+      "Create LO MFFV");
+
+  poolStatInit(lostat, lopool, chunkSize);
+  poolStatInit(histat, hipool, chunkSize);
+
+  /* iterate, allocating objects */
+  for (i=0; i<iterationCount; ++i) {
+    allocMultiple(lostat);
+    allocMultiple(histat);
+  }
+
+  /* report results */
+  reportResults(lostat, "the low MVFF pool");
+  reportResults(histat, "the high MVFF pool");
+  
+  if (lostat->max > histat->min) {
+    printf("\nFOUND PROBLEM - low range overlaps high\n");
+  } else if (lostat->ncCount != 0 || histat->ncCount != 0) {
+    printf("\nFOUND POSSIBLE PROBLEM - some non-contiguous allocations\n");
+  } else {
+    printf("\nNo problems detected.\n");
+  }
+
+  mps_pool_destroy(hipool);
+  mps_pool_destroy(lopool);
+}
+
+
+int main(int argc, char **argv)
+{
+  mps_arena_t arena;
+
+  randomize(argc, argv);
+
+  die(mps_arena_create(&arena, mps_arena_class_vmnz(), testArenaSIZE),
+      "mps_arena_create");
+
+  testInArena(arena);
+
+  mps_arena_destroy(arena);
+
+  return 0;
+}
diff --git a/mps/code/locus.c b/mps/code/locus.c
index fe8a97b4a31..106ef830288 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -15,7 +15,6 @@
 #include "mpstd.h"
 #include <float.h> /* for DBL_MAX */
 
-
 SRCID(locus, "$Id$");
 
 
@@ -45,7 +44,7 @@ SegPref SegPrefDefault(void)
 
 /* SegPrefExpress -- express a segment preference */
 
-Res SegPrefExpress(SegPref pref, SegPrefKind kind, void *p)
+void SegPrefExpress(SegPref pref, SegPrefKind kind, void *p)
 {
   AVERT(SegPref, pref);
   AVER(pref != &segPrefDefault);
@@ -82,13 +81,9 @@ Res SegPrefExpress(SegPref pref, SegPrefKind kind, void *p)
     /* See design.mps.pref. */
     break;
   }
-
-  return ResOK;
 }
 
 
-#if 1
-
 /* GenDescCheck -- check a GenDesc */
 
 static Bool GenDescCheck(GenDesc gen)
@@ -473,9 +468,6 @@ void LocusFinish(Arena arena)
 Bool LocusCheck(Arena arena)
 {
   /* Can't check arena, because this is part of ArenaCheck. */
-  GenDescCheck(&arena->topGen);
+  CHECKL(GenDescCheck(&arena->topGen));
   return TRUE;
 }
-
-
-#endif
diff --git a/mps/code/locusss.c b/mps/code/locusss.c
new file mode 100644
index 00000000000..eb61c980c0f
--- /dev/null
+++ b/mps/code/locusss.c
@@ -0,0 +1,248 @@
+/* impl.c.locusss: LOCUS STRESS TEST
+ *
+ * $Id: locusss.c,v 1.4 2002/05/10 11:00:15 pekka Exp $
+ * $HopeName: MMsrc!locusss.c(trunk.4) $
+ * Copyright (c) 2001 Ravenbrook Limited.
+ */
+
+#include "mpscmvff.h"
+#include "mpscmv.h"
+#include "mpslib.h"
+#include "mpsavm.h"
+#include "testlib.h"
+#include "mps.h"
+
+#include <stdlib.h>
+#include <stdarg.h>
+
+
+/* some constants */
+
+#define TRUE  1
+#define FALSE 0
+
+#define iterationCount 30          /* number of iterations */
+#define contigAllocs 8             /* number of allocs each iteration */
+#define chunkSize ((size_t)65536)  /* our allocation chunk size */
+
+#define smallArenaSize \
+  ((size_t)(chunkSize * iterationCount * contigAllocs * 2))
+
+
+#define AddressOffset(b, l) \
+  ((size_t)((char *)(l) - (char *)(b)))
+
+
+/* PoolStat -- maintain data about contiguous allocations */ 
+
+typedef struct PoolStatStruct *PoolStat;
+
+typedef struct PoolStatStruct {
+  mps_pool_t pool;  /* the pool being measured */
+  size_t objSize;   /* size of each allocation */
+  mps_addr_t min;   /* lowest address lock allocated to the pool */
+  mps_addr_t max;   /* highest address lock allocated to the pool */
+  int ncCount;      /* count of non-contiguous allocations */
+  int aCount;       /* count of allocations */
+  int fCount;       /* count of frees */
+} PoolStatStruct;
+
+
+
+static mps_addr_t allocObject(mps_pool_t pool, size_t size)
+{
+  mps_addr_t addr;
+  die(mps_alloc(&addr, pool, size),
+      "Allocate Object");
+  return addr;
+}
+
+static void recordNewObjectStat(PoolStat stat, mps_addr_t obj)
+{
+  stat->aCount++;
+  if (obj < stat->min) {
+    if (AddressOffset(obj, stat->min) > stat->objSize) {
+      stat->ncCount++;
+    }
+    stat->min = obj;
+  } else if (obj > stat->max) {
+    if (AddressOffset(stat->max, obj) > stat->objSize) {
+      stat->ncCount++;
+    }
+    stat->max = obj;
+  }
+}
+
+static void recordFreedObjectStat(PoolStat stat)
+{
+  stat->fCount++;
+}
+
+
+static void poolStatInit(PoolStat stat, mps_pool_t pool, size_t objSize)
+{
+  mps_addr_t s1, s2, s3;
+
+  stat->pool = pool;
+  stat->objSize = objSize;
+  stat->ncCount = 0;
+  stat->aCount = 0;
+  stat->fCount = 0;
+
+  /* allocate 3 half-size sentinel objects, freeing the middle one */
+  /* to leave a bit of space for the control pool */
+  s1 = allocObject(pool, objSize / 2);
+  stat->min = s1;
+  stat->max = s1;
+  stat->aCount++;
+
+  s2 = allocObject(pool, objSize / 2);
+  recordNewObjectStat(stat, s2);
+  s3 = allocObject(pool, objSize / 2);
+  recordNewObjectStat(stat, s3);
+
+  mps_free(pool, s2, objSize / 2);  
+  recordFreedObjectStat(stat);
+
+}
+
+
+static mps_res_t allocMultiple(PoolStat stat)
+{
+  mps_addr_t objects[contigAllocs];
+  int i;
+
+  /* allocate a few objects, and record stats for them */
+  for (i = 0; i < contigAllocs; i++) {
+    mps_addr_t obj;
+    mps_res_t res = mps_alloc(&obj, stat->pool, stat->objSize);
+    if (res != MPS_RES_OK)
+      return res;
+    recordNewObjectStat(stat, obj);
+    objects[i] = obj;
+  }
+
+  /* free one of the objects, to make the test more interesting */
+  i = rnd() % contigAllocs;
+  mps_free(stat->pool, objects[i], stat->objSize);  
+  recordFreedObjectStat(stat);
+
+  return MPS_RES_OK;
+}
+
+
+/* reportResults - print a report on a PoolStat */
+
+static void reportResults(PoolStat stat, char *name)
+{
+  printf("\nResults for ");
+  printf(name);
+  printf("\n");
+  printf("   Allocated  %lu objects\n", (unsigned long)stat->aCount);
+  printf("   Freed      %lu objects\n", (unsigned long)stat->fCount);
+  printf("   There were %lu non-contiguous allocations\n", 
+         (unsigned long)stat->ncCount);
+  printf("   Address range from %p to %p\n", stat->min, stat->max);
+  printf("\n");
+}
+
+
+static void testInArena(mps_arena_t arena, 
+                        mps_bool_t failcase, 
+                        mps_bool_t usefulFailcase)
+{
+  mps_pool_t lopool, hipool, temppool;
+  PoolStatStruct lostruct;  /* stats about lopool */
+  PoolStatStruct histruct;  /* stats about lopool */
+  PoolStatStruct tempstruct;  /* stats about temppool */
+  PoolStat lostat = &lostruct;
+  PoolStat histat = &histruct;
+  PoolStat tempstat = &tempstruct;
+  int i;
+
+  die(mps_pool_create(&hipool, arena, mps_class_mvff(), 
+                      chunkSize, chunkSize, 1024, 
+                      TRUE, TRUE, TRUE),
+      "Create HI MFFV");
+
+  die(mps_pool_create(&lopool, arena, mps_class_mvff(), 
+                      chunkSize, chunkSize, 1024, 
+                      FALSE, FALSE, TRUE),
+      "Create LO MFFV");
+
+  die(mps_pool_create(&temppool, arena, mps_class_mv(), 
+                      chunkSize, chunkSize, chunkSize),
+      "Create TEMP");
+
+  if(failcase) {
+    if(usefulFailcase) {
+      /* describe a useful failure case */
+    } else {
+      /* describe a misleading failure case */
+    }
+  }
+
+  poolStatInit(lostat, lopool, chunkSize);
+  poolStatInit(histat, hipool, chunkSize);
+  poolStatInit(tempstat, temppool, chunkSize);
+
+  /* iterate, allocating objects */
+  for (i=0; i<iterationCount; ++i) {
+    mps_res_t res;
+    res = allocMultiple(lostat);
+    if (res != MPS_RES_OK)
+      break;
+    res = allocMultiple(histat);
+    if (res != MPS_RES_OK)
+      break;
+    res = allocMultiple(tempstat);
+    if (res != MPS_RES_OK)
+      break;
+  }
+
+  /* report results */
+  reportResults(lostat, "the low MVFF pool");
+  reportResults(histat, "the high MVFF pool");
+  reportResults(tempstat, "the temp pool");
+  
+  mps_pool_destroy(hipool);
+  mps_pool_destroy(lopool);
+  mps_pool_destroy(temppool);
+
+}
+
+static void runArenaTest(size_t size, 
+                         mps_bool_t failcase, 
+                         mps_bool_t usefulFailcase)
+{
+  mps_arena_t arena;
+
+  die(mps_arena_create(&arena, mps_arena_class_vmnz(), size),
+      "mps_arena_create");
+
+  die(mps_arena_commit_limit_set(arena, size - chunkSize),
+      "mps_arena_commit_limit_set");
+
+  testInArena(arena, failcase, usefulFailcase);
+
+  mps_arena_destroy(arena);
+
+}
+
+
+int main(int argc, char **argv)
+{
+
+  randomize(argc, argv);
+
+  printf("\nRunning test with no information about peak usage.\n");
+  runArenaTest(smallArenaSize, FALSE, FALSE);
+  /*
+  printf("\nRunning test with useful information about peak usage.\n");
+  runArenaTest(smallArenaSize, TRUE, TRUE);
+  printf("\nRunning test with misleading information about peak usage.\n");
+  runArenaTest(smallArenaSize, TRUE, FALSE);
+  */
+
+  return 0;
+}
diff --git a/mps/code/makefile.jam b/mps/code/makefile.jam
new file mode 100644
index 00000000000..3a312cce850
--- /dev/null
+++ b/mps/code/makefile.jam
@@ -0,0 +1,291 @@
+#
+# Makefile for CORE RIP MPS subsystem
+#
+# $HopeName: SWmps!make:makefile.jam(trunk.11) $
+#
+
+# Variant details come before compilation rules
+
+RequiresVariant warning_level : high ;
+# RequiresVariant warnings_are_fatal ;
+
+
+# generic_MPS turns off SW-specific configuration; Non_generic_MPS
+# means SW.  We do it this way round so that SW is the default.  You
+# never want to build a generic_MPS variant of SW, only of MPS tests.
+ImplementsVariant generic_MPS ;
+
+
+# Determine which MPS platform code matches this target.
+local MPSOS ; local MPSPF ;
+switch $(TargetOS) {
+    case win_32 :
+        MPSOS = w3 ;
+        switch $(TargetArch) {
+            case pentium     : MPSPF = w3i3mv ;
+            case alpha       : MPSPF = w3almv ;
+            case ppc         : MPSPF = w3ppmv ;
+        }
+    case irix_5 :              MPSOS = i5 ; MPSPF = i5m2cc ;
+    case irix_6 :              MPSOS = ia ; MPSPF = iam4cc ;
+
+    case linux_2 :             MPSOS = li ; MPSPF = lii4gc ;
+
+    case solaris :             MPSOS = so ; MPSPF = sos8gc ;
+
+    case macos_8 :             MPSOS = s7 ; MPSPF = s7ppac ;
+    case macos_x :             MPSOS = xc ; MPSPF = xcppgc ;
+}
+if ! $(MPSPF) {
+    Error Cannot determine MPS platform for target $(TargetOS)-$(TargetArch) ;
+}
+
+
+# Set MPS configuration
+
+AddToVar Inherited Local : C-Defines : CONFIG_PF_$(MPSPF:U) ;
+
+AddToVar Inherited Local : C-Defines : CONFIG_PROD_EPCORE
+         : Variant Non_generic_MPS ;
+AddToVar Inherited Local : C-Defines : CONFIG_PROD_MPS
+         : Variant generic_MPS ;
+AddToVar Inherited Local : Suffix    : mps : Variant generic_MPS ;
+
+AddToVar Inherited Local : C-Defines : CONFIG_ASSERT : Build ASSERT ;
+AddToVar Inherited Local : C-Defines : CONFIG_DEBUG : Build DEBUG ;
+
+
+# Compilation rules
+
+
+    DependsOn all : mps ;
+
+#    C-IncludeExportDirectories
+#    : .. ;
+
+
+AddToVar Local : VariantMPSsources
+         : prmcan.c protsw.c ssan.c than.c
+           mpsioan.c poolepdl.c poolepvm.c
+         : Variant Non_generic_MPS ;
+
+switch $(MPSPF) {
+case w3i3mv :
+    AddToVar Local : VariantMPSsources
+             : lockw3.c prmci3w3.c proti3.c protw3.c spi3.c ssw3i3.c thw3i3.c
+               mpsiw3.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmw3.c ;
+case w3ppmv :
+    AddToVar Local : VariantMPSsources
+             : lockw3.c prmcan.c protw3.c span.c ssan.c than.c
+               mpsiw3.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmw3.c ;
+case w3almv :
+    AddToVar Local : VariantMPSsources
+             : lockw3.c prmcan.c protw3.c span.c ssan.c than.c
+               mpsiw3.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmw3.c ;
+case sos8gc :
+    AddToVar Local : VariantMPSsources
+             : lockan.c prmcan.c protso.c span.c sssus8.c than.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmso.c ;
+case iam4cc :
+    AddToVar Local : VariantMPSsources
+             : lockan.c prmcan.c protan.c span.c ssan.c than.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmi5.c ;
+case lii4gc :
+    AddToVar Local : VariantMPSsources
+             : lockli.c prmci3li.c protli.c protlii3.c proti3.c pthrdext.c
+               span.c sslii3.c thlii4.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmli.c ;
+    AddToVar Local Inherited : C-Defines : _REENTRANT : Variant generic_MPS ;
+case s7ppac :
+    AddToVar Local : VariantMPSsources
+             : lockan.c prmcan.c protan.c span.c ssan.c than.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vman.c ;
+case xcppgc :
+    AddToVar Local : VariantMPSsources
+             : lockan.c prmcan.c protan.c span.c ssan.c than.c
+             : Variant generic_MPS ;
+    AddToVar Local : VariantMPSsources : vmxc.c ;
+case * :
+    Error Undefined MPS platform ;
+}
+
+    Library mps :
+        $(VariantMPSsources)
+        arena.c
+        arenacl.c
+        arenavm.c
+        boot.c
+        bt.c
+        buffer.c
+        cbs.c
+        dbgpool.c
+        dbgpooli.c
+        event.c
+        format.c
+        global.c
+        ld.c
+        locus.c
+        message.c
+        meter.c
+        mpm.c
+        mpsi.c
+        pool.c
+        poolabs.c
+        poolamc.c
+        poolams.c
+        poolamsi.c
+        poolawl.c
+        poollo.c
+        poolmfs.c
+        poolmrg.c
+        poolmv.c
+        poolmvff.c
+        poolsnc.c
+        protocol.c
+        ref.c
+        reserv.c
+        ring.c
+        root.c
+        sac.c
+        seg.c
+        shield.c
+        splay.c
+        trace.c
+        tract.c
+        version.c
+        walk.c
+    ;
+
+
+    # Auxiliary tools
+
+    AddToVar Local : VariantPlinthSources : mpsioan.c : Variant generic_MPS ;
+    Library plinth :
+        $(VariantPlinthSources)
+        mpsliban.c
+    ;
+
+    Executable eventcnv : eventcnv.c eventpro.c table.c ;
+
+    Executable replay
+        : replay.c eventrep.c eventpro.c table.c mpsliban.c fmtpstst.c ;
+    C-LinkWithLibraries replay : mps testlib ;
+
+
+    # Test files
+
+    # testrun is the target for building and running all tests.
+    FloatingDepends testrun ;
+    # testrun1 is an intermediate target required by a bug in GenericTarget.
+    DependsOn testrun : testrun1 ;
+    local testTarget ; MakeGristed testTarget : testrun : $(CurrentPath) ;
+    local testTarget1 ; MakeGristed testTarget1 : testrun1 : $(CurrentPath) ;
+    NOTFILE $(testTarget) $(testTarget1) ;
+    ALWAYS $(testTarget) $(testTarget1) ;
+
+rule TestExecutable {
+    # TestExecutable executable : additional_sources : variant_for_testrun ;
+    Executable $(1) : $(1).c $(2).c ;
+    if $(MPSPF) in sos8gc {
+      # We'd like to do
+      #   C-Exec-Linker_Libraries on $(1) += -lm ;
+      # but for some reason, it doesn't work.  As long as there's nothing
+      # in this file after the TestExecutables, this AddToVar is harmless.
+      AddToVar Local : C-Exec-Linker_Libraries : -lm ;
+    }
+    C-LinkWithLibraries $(1) :
+        mps
+        plinth
+        testlib
+    ;
+    # Parse the variant by using AddToVar.
+    AddToVar Local : runTest : yes : Variant $(3) ;
+    if $(runTest) = yes {
+      GenericTarget testrun1 : $(1:S=$(C-Exec-Suffix)) :
+          # There must be a space after $>, or GenericTarget won't replace it.
+          echo ...TESTING $> ...$(NewLine)
+          $> ;
+    }
+    ReplaceVar Local : runTest : : Variant $(3) ;
+}
+
+    Library testlib :
+        testlib.c
+    ;
+
+    TestExecutable abqtest : : mv2_broken ;
+    TestExecutable amcss : fmtdy fmtdytst : generic_MPS ;
+    TestExecutable amcsshe : fmthe : generic_MPS ;
+    TestExecutable amcssth : fmtdy fmtdytst : pthreads ;
+    TestExecutable amsss : fmtdy fmtdytst : generic_MPS ;
+    TestExecutable apss ;
+    TestExecutable arenacv ;
+    TestExecutable btcv ;
+    TestExecutable bttest : : interactive_test ;
+    TestExecutable cbstest ;
+    TestExecutable epdss : : Non_generic_MPS ;
+    TestExecutable epvmss : fmtpstst : Non_generic_MPS ;
+    TestExecutable finalcv : fmtdy fmtdytst ;
+    TestExecutable locbwcss ;
+    TestExecutable lockcov ;
+    TestExecutable lockutw3 : : Windows ;
+    TestExecutable locusss ;
+    TestExecutable locv ;
+    TestExecutable messtest ;
+    TestExecutable mpmss ;
+    TestExecutable mpsicv : fmtdy fmtdytst ;
+    TestExecutable mv2test : poolmv2 abq : mv2_broken ;
+    TestExecutable poolncv : pooln ;
+    TestExecutable qs : : generic_MPS ;
+    TestExecutable sacss ;
+    TestExecutable segsmss : fmtdy fmtdytst : generic_MPS ;
+    TestExecutable teletest : : interactive_test ;
+
+
+# $Log: make:makefile.jam,v $
+# Revision 1.11  2002/05/21  13:22:47  pekka
+# Remove assert.c (change.mps.epcore.chub.160200)
+#
+# Revision 1.10  2002/05/09  17:50:03  pekka
+# Add testrun
+#
+# Revision 1.9  2002/02/15  19:14:04  pekka
+# Remove .s file on Solaris
+#
+# Revision 1.8  2002/02/12  14:45:00  pekka
+# [Bug #24034]
+# On Solaris, you have add -lm
+#
+# Revision 1.7  2002/02/07  17:13:52  pekka
+# [Bug #24034]
+# clean up
+#
+# Revision 1.6  2002/01/09  17:11:45  pekka
+# Add poolamsi.c
+#
+# Revision 1.5  2002/01/04  17:25:06  pekka
+# Add dbgpooli.c
+#
+# Revision 1.4  2002/01/02  19:50:04  pekka
+# Clarify comment on generic_MPS; add some more tests
+#
+# Revision 1.3  2001/12/21  14:34:43  pekka
+# Add missing Linux stuff
+#
+# Revision 1.2  2001/12/18  21:08:32  pekka
+# Warnings can't be fatal yet
+#
+# Revision 1.1  2001/12/18  21:03:44  pekka
+# new unit
+# New makefile for building MPS with Jam Doughtnut
+#
diff --git a/mps/code/message.c b/mps/code/message.c
index 8390a124b79..3c5213c1491 100644
--- a/mps/code/message.c
+++ b/mps/code/message.c
@@ -14,6 +14,7 @@
  * "real work" goes on in the modules that provide the actual messages.
  */
 
+#include "bt.h"
 #include "mpm.h"
 
 SRCID(message, "$Id$");
diff --git a/mps/code/misc.h b/mps/code/misc.h
index d8ecff44f36..a1be7ba180a 100644
--- a/mps/code/misc.h
+++ b/mps/code/misc.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
  *
  * Small general things which are useful for C but aren't part of the
  * memory manager itself.  The only reason that this file exists is
@@ -22,25 +23,6 @@ enum {
 };
 
 
-/* offsetof -- offset of field within structure
- *
- * .hack.offsetof: On platform.sus8lc the offsetof macro is not defined
- * (because LCC does not bother fixing up SunOS's broken header files).
- * We define it here using normal C constructs.  This hack is only
- * required on platform.sus8lc and no other platforms.  See
- * change.mps.tracer2.170226
- */
-
-#ifdef MPS_PF_SUS8LC
-#ifdef offsetof
-#error "offsetof was unexpectedly already defined on platform SUS8LC"
-#else
-#define offsetof(type, field) ((size_t)(((char *)&((type *)0)->field) \
-                              - (char *)0))
-#endif /* offsetof */
-#endif /* MPS_PF_SUS8LC */
-
-
 /* SrcId -- source identification
  *
  * Every C source file should start with a SRCID declaration to
@@ -157,11 +139,15 @@ typedef const struct SrcIdStruct {
  * Given a pointer to a field of a structure this returns a pointer to
  * the main structure.  PARENT(foo_t, x, foo->x) == foo.
  *
- * This macro is thread-safe.  design.mps.misc.parent.thread-safe
+ * This macro is thread-safe, see design.mps.misc.parent.thread-safe.
+ *
+ * That intermediate (void *) is required to stop some compilers complaining
+ * about alignment of 'type *' being greater than that of 'char *'.  Which
+ * is true, but not a bug, since p really is a pointer into a 'type' struct.
  */
 
 #define PARENT(type, field, p) \
-  ((type *)((char *)(p) - offsetof(type, field)))
+  ((type *)(void *)((char *)(p) - offsetof(type, field)))
 
 
 /* Bit Sets -- sets of integers in [0,N-1].
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index bfdc8dad29e..9bfc426a8d8 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -8,16 +8,27 @@
  *
  * .sources: design.mps.writef */
 
+#include "check.h"
 #include "mpm.h"
 #include <stdarg.h>
 /* Get some floating constants for WriteDouble */
 #include <float.h>
 #include <limits.h>
 
-
 SRCID(mpm, "$Id$");
 
 
+#if defined(CHECK)
+
+
+/* CheckLevel -- Control check level 
+ *
+ * This controls the behaviour of Check methods (see impl.h.check).
+ */
+
+unsigned CheckLevel = CHECK_DEFAULT;
+
+
 /* MPMCheck -- test MPM assumptions */
 
 Bool MPMCheck(void)
@@ -112,6 +123,9 @@ Bool AlignCheck(Align align)
 }
 
 
+#endif /* defined(CHECK) */
+
+
 /* WordIsAligned -- test whether a word is aligned */
 
 Bool (WordIsAligned)(Word word, Align align)
@@ -446,7 +460,8 @@ Res WriteF(mps_lib_FILE *stream, ...)
 
           case 'F': {                   /* function */
             WriteFF f = va_arg(args, WriteFF);
-            Byte *b = (Byte *)&f;
+            WriteFF *fp = &f; /* dodge to placate splint */
+            Byte *b = *((Byte **)&fp);
             for(i=0; i < sizeof(WriteFF); i++) {
               res = WriteWord(stream, (Word)(b[i]), 16,
                               (CHAR_BIT + 3) / 4);
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index ecf16e2975c..ff9541eecaa 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .trans.bufferinit: The Buffer data structure has an Init field and
  * an Init method, there's a name clash.  We resolve this by calling the
@@ -156,61 +157,6 @@ extern size_t StringLength(const char *s);
 extern char *MPSVersion(void);
 
 
-/* Bit Table Interface -- see design.mps.bt.if.* for doc */
-
-/* design.mps.bt.if.size */
-extern size_t (BTSize)(unsigned long length);
-#define BTSize(n) (((n) + MPS_WORD_WIDTH-1) / MPS_WORD_WIDTH * sizeof(Word))
-
-
-/* design.mps.bt.if.get */
-extern Bool (BTGet)(BT bt, Index index);
-#define BTGet(a, i) \
-  ((Bool)(((a)[((i) >> MPS_WORD_SHIFT)] \
-           >> ((i) & ~((Word)-1 << MPS_WORD_SHIFT))) \
-          & (Word)1))
-
-/* design.mps.bt.if.set */
-extern void (BTSet)(BT bt, Index index);
-#define BTSet(a, i) \
-  BEGIN \
-    (a)[((i)>>MPS_WORD_SHIFT)] |= (Word)1<<((i)&~((Word)-1<<MPS_WORD_SHIFT)); \
-  END
-
-/* design.mps.bt.if.res */
-extern void (BTRes)(BT bt, Index index);
-#define BTRes(a, i) \
-  BEGIN \
-    (a)[((i)>>MPS_WORD_SHIFT)] &= \
-      ~((Word)1 << ((i) & ~((Word)-1<<MPS_WORD_SHIFT))); \
-  END
-
-extern Res BTCreate(BT *btReturn, Arena arena, Count length);
-extern void BTDestroy(BT bt, Arena arena, Count length);
-extern void BTSetRange(BT bt, Index base, Index limit);
-extern Bool BTIsSetRange(BT bt, Index base, Index limit);
-extern void BTResRange(BT bt, Index base, Index limit);
-extern Bool BTIsResRange(BT bt, Index base, Index limit);
-extern Bool BTFindShortResRange(Index *baseReturn, Index *limitReturn,
-                                BT bt, Index searchBase, Index searchLimit,
-                                unsigned long length);
-extern Bool BTFindShortResRangeHigh(Index *baseReturn, Index *limitReturn,
-                                    BT bt, Index searchBase, Index searchLimit,
-                                    unsigned long length);
-extern Bool BTFindLongResRange(Index *baseReturn, Index *limitReturn,
-                               BT bt, Index searchBase, Index searchLimit,
-                               unsigned long length);
-extern Bool BTFindLongResRangeHigh(Index *baseReturn, Index *limitReturn,
-                                   BT bt, Index searchBase, Index searchLimit,
-                                   unsigned long length);
-extern Bool BTRangesSame(BT BTx, BT BTy, Index base, Index limit);
-extern void BTCopyInvertRange(BT fromBT, BT toBT, Index base, Index limit);
-extern void BTCopyRange(BT fromBT, BT toBT, Index base, Index limit);
-extern void BTCopyOffsetRange(BT fromBT, BT toBT,
-                              Index fromBase, Index fromLimit,
-                              Index toBase, Index toLimit);
-
-
 /* Pool Interface -- see impl.c.pool */
 
 extern Res PoolInit(Pool pool, Arena arena, PoolClass class, ...);
@@ -253,6 +199,7 @@ extern void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO);
 extern void PoolReclaim(Pool pool, Trace trace, Seg seg);
 extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
                      void *v, unsigned long s);
+extern void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p);
 extern Res PoolTrivInit(Pool pool, va_list arg);
 extern void PoolTrivFinish(Pool pool);
 extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size,
@@ -300,6 +247,7 @@ extern Res PoolTrivFramePop(Pool pool, Buffer buf, AllocFrame frame);
 extern void PoolNoFramePopPending(Pool pool, Buffer buf, AllocFrame frame);
 extern void PoolNoWalk(Pool pool, Seg seg, FormattedObjectsStepMethod step,
                        void *p, unsigned long s);
+extern void PoolNoFreeWalk(Pool pool, FreeBlockStepMethod f, void *p);
 extern PoolDebugMixin PoolNoDebugMixin(Pool pool);
 extern BufferClass PoolNoBufferClass(void);
 
@@ -584,6 +532,7 @@ extern Size ArenaAvail(Arena arena);
 extern Res ArenaExtend(Arena, Addr base, Size size);
 
 extern Res ArenaFinalize(Arena arena, Ref obj);
+extern Res ArenaDefinalize(Arena arena, Ref obj);
 
 extern Bool ArenaIsReservedAddr(Arena arena, Addr addr);
 
@@ -611,7 +560,7 @@ extern Res ArenaNoExtend(Arena arena, Addr base, Size size);
 
 extern Bool SegPrefCheck(SegPref pref);
 extern SegPref SegPrefDefault(void);
-extern Res SegPrefExpress(SegPref pref, SegPrefKind kind, void *p);
+extern void SegPrefExpress(SegPref pref, SegPrefKind kind, void *p);
 
 extern void LocusInit(Arena arena);
 extern void LocusFinish(Arena arena);
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 3394e283f70..3bf764e8ccd 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -2,9 +2,11 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 #include "mpscmv.h"
+#include "mpscmvff.h"
 #include "mpslib.h"
 #include "mpsavm.h"
 #include "testlib.h"
@@ -23,8 +25,10 @@ extern mps_class_t PoolClassMFS(void);
 #define testLOOPS 10
 
 
-static mps_res_t stress(mps_class_t class, mps_arena_t arena,
-                        size_t (*size)(int i), ...)
+/* stress -- create a pool of the requested type and allocate in it */
+
+static mps_res_t stress(mps_class_t class, size_t (*size)(int i),
+                        mps_arena_t arena, ...)
 {
   mps_res_t res;
   mps_pool_t pool;
@@ -33,7 +37,7 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
   int *ps[testSetSIZE];
   size_t ss[testSetSIZE];
 
-  va_start(arg, size);
+  va_start(arg, arena);
   res = mps_pool_create_v(&pool, arena, class, arg);
   va_end(arg);
   if (res != MPS_RES_OK)
@@ -87,6 +91,10 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
 
 #define max(a, b) (((a) > (b)) ? (a) : (b))
 
+#define alignUp(w, a) (((w) + (a) - 1) & ~((size_t)(a) - 1))
+
+
+/* randomSize -- produce sizes both latge and small */
 
 static size_t randomSize(int i)
 {
@@ -98,6 +106,18 @@ static size_t randomSize(int i)
 }
 
 
+/* randomSize8 -- produce sizes both latge and small, 8-byte aligned */
+
+static size_t randomSize8(int i)
+{
+  size_t maxSize = 2 * 160 * 0x2000;
+  /* Reduce by a factor of 2 every 10 cycles.  Total allocation about 40 MB. */
+  return alignUp(rnd() % max((maxSize >> (i / 10)), 2) + 1, 8);
+}
+
+
+/* fixedSize -- produce always the same size */
+
 static size_t fixedSizeSize = 0;
 
 static size_t fixedSize(int i)
@@ -107,23 +127,35 @@ static size_t fixedSize(int i)
 }
 
 
-static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 };
+/* testInArena -- test all the pool classes in the given arena */
+
+static mps_pool_debug_option_s bothOptions =
+  { (void *)"postpost", 8, (void *)"DEAD", 4 };
+
+static mps_pool_debug_option_s fenceOptions =
+  { (void *)"\0XXX ''\"\"'' XXX\0", 16, NULL, 0 };
 
-static int testInArena(mps_arena_t arena)
+static int testInArena(mps_arena_t arena, mps_pool_debug_option_s *options)
 {
+  /* IWBN to test MVFFDebug, but the MPS doesn't support debugging */
+  /* cross-segment allocation (possibly MVFF ought not to). */
+  printf("MVFF\n");
+  die(stress(mps_class_mvff(), randomSize8, arena,
+             (size_t)65536, (size_t)32, (size_t)4, TRUE, TRUE, TRUE),
+      "stress MVFF");
   printf("MV debug\n");
-  die(stress(mps_class_mv_debug(), arena, randomSize,
-             &debugOptions, (size_t)65536, (size_t)32, (size_t)65536),
+  die(stress(mps_class_mv_debug(), randomSize, arena,
+             options, (size_t)65536, (size_t)32, (size_t)65536),
       "stress MV debug");
 
   printf("MFS\n");
   fixedSizeSize = 13;
   die(stress(PoolClassMFS(),
-             arena, fixedSize, (size_t)100000, fixedSizeSize),
+             fixedSize, arena, (size_t)100000, fixedSizeSize),
       "stress MFS");
 
   printf("MV\n");
-  die(stress(mps_class_mv(), arena, randomSize,
+  die(stress(mps_class_mv(), randomSize, arena,
              (size_t)65536, (size_t)32, (size_t)65536),
       "stress MV");
 
@@ -139,12 +171,12 @@ int main(int argc, char **argv)
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
       "mps_arena_create");
-  testInArena(arena);
+  testInArena(arena, &bothOptions);
   mps_arena_destroy(arena);
 
   die(mps_arena_create(&arena, mps_arena_class_vm(), smallArenaSIZE),
       "mps_arena_create");
-  testInArena(arena);
+  testInArena(arena, &fenceOptions);
   mps_arena_destroy(arena);
 
   fflush(stdout); /* synchronize */
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 6c7a50642e5..ab03c57d704 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
  *
  * .design: This header file crosses module boundaries.  The relevant
  * design a module's structures should be found in that module's design
@@ -71,6 +72,7 @@ typedef struct PoolClassStruct {
   PoolFramePopMethod framePop;  /* pop an allocation frame */
   PoolFramePopPendingMethod framePopPending;  /* notify pending pop */
   PoolWalkMethod walk;          /* walk over a segment */
+  PoolFreeWalkMethod freewalk;  /* walk over free blocks */
   PoolBufferClassMethod bufferClass; /* default BufferClass of pool */
   PoolDescribeMethod describe;  /* describe the contents of the pool */
   PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 5263163688e..28dafbcd9b5 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2001 Global Graphics Software.
  *
  * .design: design.mps.type
  *
@@ -137,8 +138,12 @@ typedef Res (*TraceFixMethod)(ScanState ss, Ref *refIO);
 /* Heap Walker */
 
 /* This type is used by the PoolClass method Walk */
-typedef void (*FormattedObjectsStepMethod)(Addr, Format, Pool,
-                                           void *, Size);
+typedef void (*FormattedObjectsStepMethod)(Addr obj, Format fmt, Pool pool,
+                                           void *v, unsigned long s);
+
+/* This type is used by the PoolClass method Walk */
+typedef void (*FreeBlockStepMethod)(Addr base, Addr limit, Pool pool, void *p);
+
 
 /* Seg*Method -- see design.mps.seg */
 
@@ -212,7 +217,8 @@ typedef void (*PoolFramePopPendingMethod)(Pool pool, Buffer buf,
                                           AllocFrame frame);
 typedef void (*PoolWalkMethod)(Pool pool, Seg seg,
                                FormattedObjectsStepMethod f,
-                               void *p, unsigned long s);
+                               void *v, unsigned long s);
+typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockStepMethod f, void *p);
 typedef BufferClass (*PoolBufferClassMethod)(void);
 typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream);
 typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool);
@@ -294,10 +300,11 @@ typedef Res (*RootScanRegMethod)(ScanState ss, Thread thread, void *p, size_t s)
 
 /* Format varieties */
 enum {
- FormatVarietyA = 1,
- FormatVarietyB,
- FormatVarietyAutoHeader,
- FormatVarietyLIMIT
+  FormatVarietyA = 1,
+  FormatVarietyB,
+  FormatVarietyAutoHeader,
+  FormatVarietyFixed,
+  FormatVarietyLIMIT
 };
 
 
diff --git a/mps/code/mps.h b/mps/code/mps.h
index eb7812143c3..10849aa63f5 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .readership: customers, MPS developers.
  * .sources: design.mps.interface.c.
@@ -10,7 +11,6 @@
 #ifndef mps_h
 #define mps_h
 
-#include "mpstd.h"              /* detect platform */
 #include <stddef.h>
 #include <stdarg.h>
 #include <limits.h>
@@ -39,7 +39,7 @@ typedef struct mps_frame_s
 
 /* Concrete Types */
 
-typedef MPS_T_WORD mps_word_t;  /* machine word (target dep.) */
+typedef unsigned long mps_word_t; /* pointer-sized word */
 typedef int mps_bool_t;         /* boolean (int) */
 typedef int mps_res_t;          /* result code (int) */
 typedef unsigned mps_shift_t;   /* shift amount (unsigned int) */
@@ -133,11 +133,13 @@ typedef struct mps_sac_s {
 } mps_sac_s;
 
 /* .sacc: Keep in sync with impl.h.sac. */
-typedef struct mps_sac_classes_s {
+typedef struct mps_sac_class_s {
   size_t mps_block_size;
   size_t mps_cached_count;
   unsigned mps_frequency;
-} mps_sac_classes_s;
+} mps_sac_class_s;
+
+#define mps_sac_classes_s mps_sac_class_s
 
 
 /* Location Dependency */
@@ -210,6 +212,15 @@ typedef struct mps_fmt_auto_header_s {
 } mps_fmt_auto_header_s;
 
 
+typedef struct mps_fmt_fixed_s {
+  mps_align_t     align;
+  mps_fmt_scan_t  scan;
+  mps_fmt_fwd_t   fwd;
+  mps_fmt_isfwd_t isfwd;
+  mps_fmt_pad_t   pad;
+} mps_fmt_fixed_s;
+
+
 /* Internal Definitions */
 
 #define MPS_BEGIN       do {
@@ -222,15 +233,6 @@ typedef struct mps_fmt_auto_header_s {
  */
 
 
-/* Assertion Handling */
-
-typedef void (*mps_assert_t)(const char *, const char *, const char *,
-                             unsigned);
-
-extern mps_assert_t mps_assert_install(mps_assert_t);
-extern mps_assert_t mps_assert_default(void);
-
-
 /* arenas */
 
 extern void mps_arena_clamp(mps_arena_t);
@@ -278,6 +280,8 @@ extern mps_res_t mps_fmt_create_B(mps_fmt_t *, mps_arena_t,
                                   mps_fmt_B_s *);
 extern mps_res_t mps_fmt_create_auto_header(mps_fmt_t *, mps_arena_t,
                                             mps_fmt_auto_header_s *);
+extern mps_res_t mps_fmt_create_fixed(mps_fmt_t *, mps_arena_t,
+                                      mps_fmt_fixed_s *);
 extern void mps_fmt_destroy(mps_fmt_t);
 
 
@@ -481,22 +485,8 @@ extern mps_res_t mps_stack_scan_ambig(mps_ss_t, mps_thr_t,
 /* Protection Trampoline and Thread Registration */
 
 typedef void *(*mps_tramp_t)(void *, size_t);
-
 extern void (mps_tramp)(void **, mps_tramp_t, void *, size_t);
 
-#ifndef mps_tramp /* If a platform-specific version hasn't been defined */
-
-#define mps_tramp(r_o, f, p, s) \
-  MPS_BEGIN \
-    void **_r_o = (r_o); \
-    mps_tramp_t _f = (f); \
-    void *_p = (p); \
-    size_t _s = (s); \
-    *_r_o = (*_f)(_p, _s); \
-  MPS_END
-
-#endif
-
 extern mps_res_t mps_thread_reg(mps_thr_t *, mps_arena_t);
 extern void mps_thread_dereg(mps_thr_t);
 
@@ -542,7 +532,7 @@ extern size_t mps_message_gc_not_condemned_size(mps_arena_t,
 /* Finalization */
 
 extern mps_res_t mps_finalize(mps_arena_t, mps_addr_t *);
-extern void mps_definalize(mps_arena_t, mps_addr_t *);
+extern mps_res_t mps_definalize(mps_arena_t, mps_addr_t *);
 
 
 /* Telemetry */
@@ -573,15 +563,18 @@ extern void mps_arena_roots_walk(mps_arena_t,
                                  void *, size_t);
 
 
-/* Fenceposting */
+/* Allocation debug options */
 
 
 typedef struct mps_pool_debug_option_s {
   void* fence_template;
   size_t fence_size;
+  void*  free_template;
+  size_t free_size;
 } mps_pool_debug_option_s;
 
 extern void mps_pool_check_fenceposts(mps_pool_t);
+extern void mps_pool_check_free_space(mps_pool_t);
 
 
 /* Scanner Support */
@@ -598,7 +591,8 @@ extern mps_res_t mps_fix(mps_ss_t, mps_addr_t *);
     {
 
 #define MPS_FIX1(ss, ref) \
-  (_mps_wt = 1uL<<((mps_word_t)(ref)>>_mps_w0&(MPS_WORD_WIDTH-1)), \
+  (_mps_wt = 1uL << ((mps_word_t)(ref) >> _mps_w0 \
+                     & (sizeof(mps_word_t) * CHAR_BIT - 1)), \
    _mps_w2 |= _mps_wt, \
    _mps_w1 & _mps_wt)
 
diff --git a/mps/code/mpscams.h b/mps/code/mpscams.h
index 1d881c00497..82eb3f210cf 100644
--- a/mps/code/mpscams.h
+++ b/mps/code/mpscams.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
 #ifndef mpscams_h
@@ -10,5 +11,6 @@
 #include "mps.h"
 
 extern mps_class_t mps_class_ams(void);
+extern mps_class_t mps_class_ams_debug(void);
 
 #endif /* mpscams_h */
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index 09bac2ef6aa..5f338acf9ac 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .purpose: This code bridges between the MPS interface to C,
  * impl.h.mps, and the internal MPM interfaces, as defined by
@@ -186,18 +187,6 @@ mps_rank_t mps_rank_weak(void)
 }
 
 
-mps_assert_t mps_assert_install(mps_assert_t handler)
-{
-  AVER(handler != NULL);
-  return AssertInstall(handler);
-}
-
-mps_assert_t mps_assert_default(void)
-{
-  return AssertDefault();
-}
-
-
 mps_res_t mps_arena_extend(mps_arena_t mps_arena,
                            mps_addr_t base, size_t size)
 {
@@ -442,6 +431,7 @@ void mps_space_destroy(mps_space_t mps_space)
 }
 #endif
 
+
 /* mps_arena_has_addr -- is this address managed by this arena? */
 
 mps_bool_t mps_arena_has_addr(mps_arena_t mps_arena, mps_addr_t p)
@@ -554,7 +544,7 @@ mps_res_t mps_fmt_create_auto_header(mps_fmt_t *mps_fmt_o,
                      (FormatSkipMethod)mps_fmt->skip,
                      (FormatMoveMethod)mps_fmt->fwd,
                      (FormatIsMovedMethod)mps_fmt->isfwd,
-                     (FormatCopyMethod)NULL,
+                     NULL,
                      (FormatPadMethod)mps_fmt->pad,
                      NULL,
                      (Size)mps_fmt->mps_headerSize);
@@ -567,6 +557,41 @@ mps_res_t mps_fmt_create_auto_header(mps_fmt_t *mps_fmt_o,
 }
 
 
+/* mps_fmt_create_fixed -- create an object format of variant fixed */
+
+mps_res_t mps_fmt_create_fixed(mps_fmt_t *mps_fmt_o,
+                               mps_arena_t mps_arena,
+                               mps_fmt_fixed_s *mps_fmt_fixed)
+{
+  Arena arena = (Arena)mps_arena;
+  Format format;
+  Res res;
+
+  ArenaEnter(arena);
+
+  AVER(mps_fmt_fixed != NULL);
+
+  res = FormatCreate(&format,
+                     arena,
+                     (Align)mps_fmt_fixed->align,
+                     FormatVarietyFixed,
+                     (FormatScanMethod)mps_fmt_fixed->scan,
+                     NULL,
+                     (FormatMoveMethod)mps_fmt_fixed->fwd,
+                     (FormatIsMovedMethod)mps_fmt_fixed->isfwd,
+                     NULL,
+                     (FormatPadMethod)mps_fmt_fixed->pad,
+                     NULL,
+                     (Size)0);
+
+  ArenaLeave(arena);
+
+  if (res != ResOK) return res;
+  *mps_fmt_o = (mps_fmt_t)format;
+  return MPS_RES_OK;
+}
+
+
 /* mps_fmt_destroy -- destroy a format object */
 
 void mps_fmt_destroy(mps_fmt_t mps_fmt)
@@ -1462,7 +1487,7 @@ mps_word_t mps_collections(mps_arena_t mps_arena)
 }
 
 
-/* mps_finalize -- register for finalize */
+/* mps_finalize -- register for finalization */
 
 mps_res_t mps_finalize(mps_arena_t mps_arena, mps_addr_t *refref)
 {
@@ -1479,11 +1504,22 @@ mps_res_t mps_finalize(mps_arena_t mps_arena, mps_addr_t *refref)
   return res;
 }
 
-void mps_definalize(mps_arena_t arena, mps_addr_t *refref)
+
+/* mps_definalize -- deregister for finalization */
+
+mps_res_t mps_definalize(mps_arena_t mps_arena, mps_addr_t *refref)
 {
-  /* Not yet implemented */
-  UNUSED(arena); UNUSED(refref);
-  NOTREACHED;
+  Res res;
+  Addr object;
+  Arena arena = (Arena)mps_arena;
+
+  ArenaEnter(arena);
+
+  object = (Addr)ArenaPeek(arena, (Addr)refref);
+  res = ArenaDefinalize(arena, object);
+
+  ArenaLeave(arena);
+  return res;
 }
 
 
diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c
index b22f845bf92..c6e765a2751 100644
--- a/mps/code/mpsicv.c
+++ b/mps/code/mpsicv.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  */
 
 #include "testlib.h"
@@ -10,11 +11,13 @@
 #include "mpscmv.h"
 #include "fmtdy.h"
 #include "fmtdytst.h"
-#include "mpstd.h"
-#ifdef MPS_OS_W3
-#include "mpsw3.h"
-#endif
 #include "mps.h"
+#if !defined(CONFIG_PROD_EPCORE)
+#  include "mpstd.h"
+#  ifdef MPS_OS_W3
+#    include "mpsw3.h"
+#  endif
+#endif
 #include <stdlib.h>
 #include <stdarg.h>
 #include <math.h>
@@ -229,12 +232,12 @@ static void arena_commit_test(mps_arena_t arena)
   die(mps_pool_create(&pool, arena, mps_class_mv(), 0x1000, 1024, 16384),
       "commit pool create");
   limit = mps_arena_commit_limit(arena);
-  mps_arena_commit_limit_set(arena, committed);
+  die(mps_arena_commit_limit_set(arena, committed), "commit_limit_set before");
   do {
     res = mps_alloc(&p, pool, FILLER_OBJECT_SIZE);
   } while (res == MPS_RES_OK);
   die_expect(res, MPS_RES_COMMIT_LIMIT, "Commit limit allocation");
-  mps_arena_commit_limit_set(arena, limit);
+  die(mps_arena_commit_limit_set(arena, limit), "commit_limit_set after");
   res = mps_alloc(&p, pool, FILLER_OBJECT_SIZE);
   die_expect(res, MPS_RES_OK, "Allocation failed after raising commit_limit");
   mps_pool_destroy(pool);
@@ -280,6 +283,8 @@ static void *test(void *arg, size_t s)
   mps_addr_t obj;
   mps_ld_s ld;
   mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp();
+  size_t rampCount = 0;
+  mps_res_t res;
 
   arena = (mps_arena_t)arg;
   testlib_unused(s);
@@ -358,9 +363,20 @@ static void *test(void *arg, size_t s)
 
     if (rnd() % patternFREQ == 0)
       switch(rnd() % 4) {
-      case 0: case 1: mps_ap_alloc_pattern_begin(ap, ramp); break;
-      case 2: mps_ap_alloc_pattern_end(ap, ramp); break;
-      case 3: mps_ap_alloc_pattern_reset(ap); break;
+      case 0: case 1: {
+        die(mps_ap_alloc_pattern_begin(ap, ramp), "alloc_pattern_begin");
+        ++rampCount;
+        } break;
+      case 2: {
+        res = mps_ap_alloc_pattern_end(ap, ramp);
+        cdie(rampCount > 0 ? res == MPS_RES_OK : res == MPS_RES_FAIL,
+             "alloc_pattern_end");
+        if (rampCount > 0) --rampCount;
+        } break;
+      case 3: {
+        die(mps_ap_alloc_pattern_reset(ap), "alloc_pattern_reset");
+        rampCount = 0;
+        } break;
       }
 
     if (rnd() & 1)
@@ -377,7 +393,7 @@ static void *test(void *arg, size_t s)
   reservoir_test(arena);
   alignmentTest(arena);
 
-  mps_arena_collect(arena);
+  die(mps_arena_collect(arena), "collect");
 
   mps_free(mv, alloced_obj, 32);
   alloc_v_test(mv);
@@ -402,26 +418,31 @@ int main(int argc, char **argv)
 {
   mps_arena_t arena;
   mps_thr_t thread;
+#if !defined(CONFIG_PROD_EPCORE) && !defined(CONFIG_PF_XCPPGC)
   mps_root_t reg_root;
+#endif
   void *r;
   void *marker = &marker;
 
   randomize(argc, argv);
 
-  (void)mps_assert_install(mps_assert_default());
   die(mps_arena_create(&arena, mps_arena_class_vm(), TEST_ARENA_SIZE),
       "arena_create");
   die(mps_thread_reg(&thread, arena), "thread_reg");
 
+#if !defined(CONFIG_PROD_EPCORE) && !defined(CONFIG_PF_XCPPGC)
   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");
+#endif
 
   (mps_tramp)(&r, test, arena, 0);  /* non-inlined trampoline */
   mps_tramp(&r, test, arena, 0);
+#if !defined(CONFIG_PROD_EPCORE) && !defined(CONFIG_PF_XCPPGC)
   mps_root_destroy(reg_root);
+#endif 
   mps_thread_dereg(thread);
   mps_arena_destroy(arena);
 
diff --git a/mps/code/mpsiw3.c b/mps/code/mpsiw3.c
index b4b78638e92..f1992eecfd9 100644
--- a/mps/code/mpsiw3.c
+++ b/mps/code/mpsiw3.c
@@ -1,4 +1,4 @@
-/* impl.c.mpsint:
+/* impl.c.mpsiw3: WIN32 MEMORY POOL SYSTEM INTERFACE LAYER EXTRAS
  *
  *       WIN32 MEMORY POOL SYSTEM INTERFACE LAYER EXTRAS
  *
@@ -12,9 +12,10 @@
 
 #include "mpswin.h"
 
-SRCID(mpsint, "$Id$");
+SRCID(mpsiw3, "$Id$");
 
-/* This is defined in protnt.c */
+
+/* This is defined in protw3.c */
 extern LONG ProtSEHfilter(LPEXCEPTION_POINTERS info);
 
 LONG mps_SEH_filter(LPEXCEPTION_POINTERS info,
diff --git a/mps/code/mpslib.h b/mps/code/mpslib.h
index 99c89c59ed7..204d080edd2 100644
--- a/mps/code/mpslib.h
+++ b/mps/code/mpslib.h
@@ -29,9 +29,7 @@ extern mps_lib_FILE *mps_lib_get_stdout(void);
 extern int mps_lib_fputc(int, mps_lib_FILE *);
 extern int mps_lib_fputs(const char *, mps_lib_FILE *);
 
-
-extern void mps_lib_abort(void);
-
+extern void mps_lib_assert_fail(const char *);
 
 extern void *(mps_lib_memset)(void *, int, size_t);
 extern void *(mps_lib_memcpy)(void *, const void *, size_t);
diff --git a/mps/code/mpsliban.c b/mps/code/mpsliban.c
index 5b5c16fbcec..8777d342a67 100644
--- a/mps/code/mpsliban.c
+++ b/mps/code/mpsliban.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .purpose: The purpose of this code is
  *   1. to connect the MPS Library Interface to the ANSI C libraries,
@@ -78,8 +79,11 @@ int mps_lib_fputs(const char *s, mps_lib_FILE *stream)
 }
 
 
-void mps_lib_abort(void)
+void mps_lib_assert_fail(const char *message)
 {
+  fflush(stdout); /* synchronize */
+  fprintf(stderr, "\nMPS ASSERTION FAILURE: %s\n", message);
+  fflush(stderr); /* make sure the message is output */
   abort();
 }
 
diff --git a/mps/code/mpstd.h b/mps/code/mpstd.h
index 62edfcdfa8d..68c98ec7556 100644
--- a/mps/code/mpstd.h
+++ b/mps/code/mpstd.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
  *
  * Detect the target platform using predefined preprocessor symbols
  * defined by the build environment.  The symbols are derived from the
@@ -24,8 +25,9 @@
  * them.  Alignment from testing.
  */
 
-#if defined(__sgi) && defined(__unix) && defined(__mips) \
-    && defined(_SYSTYPE_SVR4) && (_MIPS_FPSET == 16)
+#if defined(CONFIG_PF_I5M2CC) \
+    || defined(__sgi) && defined(__unix) && defined(__mips) \
+       && defined(_SYSTYPE_SVR4) && (_MIPS_FPSET == 16)
 #define MPS_PF_I5M2CC
 #define MPS_PF_STRING   "i5m2cc"
 #define MPS_OS_I5
@@ -38,8 +40,9 @@
 
 /* See above.  Alignment from testing. */
 
-#elif defined(__sgi) && defined(__unix) && defined(__mips) \
-      && defined(_SYSTYPE_SVR4) && defined(_ABIN32)
+#elif defined(CONFIG_PF_IAM4CC) \
+      || defined(__sgi) && defined(__unix) && defined(__mips) \
+         && defined(_SYSTYPE_SVR4) && defined(_ABIN32)
 #define MPS_PF_IAM4CC
 #define MPS_PF_STRING   "iam4cc"
 #define MPS_OS_IA
@@ -52,7 +55,8 @@
 
 /* winnt.h from MS VC 2.0 */
 
-#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_ALPHA)
+#elif defined(CONFIG_PF_W3ALMV) \
+      || defined(_MSC_VER) && defined(_WIN32) && defined(_M_ALPHA)
 #define MPS_PF_W3ALMV
 #define MPS_PF_STRING   "w3almv"
 #define MPS_OS_W3
@@ -65,7 +69,8 @@
 
 /* winnt.h from MS VC 2.0 */
 
-#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_PPC)
+#elif defined(CONFIG_PF_W3PPMV) \
+      || defined(_MSC_VER) && defined(_WIN32) && defined(_M_PPC)
 #define MPS_PF_W3PPMV
 #define MPS_PF_STRING   "w3ppmv"
 #define MPS_OS_W3
@@ -83,7 +88,8 @@
  * VC malloc is 16!
  */
 
-#elif defined(_MSC_VER) && defined(_WIN32) && defined(_M_IX86)
+#elif defined(CONFIG_PF_W3I3MV) \
+      || defined(_MSC_VER) && defined(_WIN32) && defined(_M_IX86)
 #define MPS_PF_W3I3MV
 #define MPS_PF_STRING   "w3i3mv"
 #define MPS_OS_W3
@@ -98,7 +104,8 @@
  * a way to determine the OS -- we assume MacOS 7.
  */
 
-#elif defined(__MWERKS__) && __MC68K__ == 1
+#elif defined(CONFIG_PF_S760MW) \
+      || (defined(__MWERKS__) && __MC68K__ == 1)
 #define MPS_PF_S760MW
 #define MPS_PF_STRING   "s760mw"
 #define MPS_OS_S7
@@ -113,7 +120,8 @@
  * a way to determine the OS -- we assume MacOS 7.
  */
 
-#elif defined(__MWERKS__) && __POWERPC__ == 1
+#elif defined(CONFIG_PF_S7PPMW) \
+      || defined(__MWERKS__) && __POWERPC__ == 1
 #define MPS_PF_S7PPMW
 #define MPS_PF_STRING   "s7ppmw"
 #define MPS_OS_S7
@@ -130,7 +138,8 @@
  * which lets us determine the system version.
  */
 
-#elif defined(m68k) && (defined (applec) || defined(__SC__))
+#elif defined(CONFIG_PF_S760AC) \
+      || defined(m68k) && (defined (applec) || defined(__SC__))
 #define MPS_PF_S760AC
 #define MPS_PF_STRING   "s760ac"
 #define MPS_OS_S7
@@ -147,7 +156,8 @@
  * which lets us determine the system version.
  */
 
-#elif defined(__PPCC__) || (defined(__MRC__) && defined(__POWERPC))
+#elif defined(CONFIG_PF_S7PPAC) \
+      || defined(__PPCC__) || (defined(__MRC__) && defined(__POWERPC))
 #define MPS_PF_S7PPAC
 #define MPS_PF_STRING   "s7ppac"
 #define MPS_OS_S7
@@ -163,7 +173,9 @@
  * ools/Preprocessor/Preprocessor.[ef].html>
  */
 
-#elif defined(__APPLE__) && defined(__ppc__) && defined(__MACH__) && defined(__GNUC__)
+#elif defined(CONFIG_PF_XCPPGC) \
+      || defined(__APPLE__) && defined(__ppc__) && defined(__MACH__) \
+         && defined(__GNUC__)
 #define MPS_PF_XCPPGC
 #define MPS_PF_STRING   "xcppgc"
 #define MPS_OS_XC
@@ -176,8 +188,9 @@
 
 /* GCC 2.5.8, gcc -E -dM, (__SVR4 indicates Solaris) */
 
-#elif defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \
-      && !defined(__svr4__)
+#elif defined(CONFIG_PF_SUS8GC) \
+      || defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \
+         && !defined(__svr4__)
 #define MPS_PF_SUS8GC
 #define MPS_PF_STRING   "sus8gc"
 #define MPS_OS_SU
@@ -190,8 +203,9 @@
 
 /* LCC 3.4 (ish), man page */
 
-#elif defined(sun) && defined(sparc) && defined(__LCC__) \
-      && !defined(__svr4__)
+#elif defined(CONFIG_PF_SUS8LC) \
+      || defined(sun) && defined(sparc) && defined(__LCC__) \
+         && !defined(__svr4__)
 #define MPS_PF_SUS8LC
 #define MPS_PF_STRING   "sus8lc"
 #define MPS_OS_SU
@@ -204,8 +218,9 @@
 
 /* GCC 2.5.8, gcc -E -dM */
 
-#elif defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \
-      && defined(__svr4__)
+#elif defined(CONFIG_PF_SOS8GC) \
+      || defined(__sun__) && defined(__sparc__) && defined(__GNUC__) \
+         && defined(__svr4__)
 #define MPS_PF_SOS8GC
 #define MPS_PF_STRING   "sos8gc"
 #define MPS_OS_SO
@@ -221,9 +236,9 @@
  * macros for that.
  */
 
-#elif defined(__sun) && defined(__SUNPRO_C) && defined(__SVR4) \
-      && defined(__sparc)
-
+#elif defined(CONFIG_PF_SOS9SC) \
+      || defined(__sun) && defined(__SUNPRO_C) && defined(__SVR4) \
+         && defined(__sparc)
 #define MPS_PF_SOS9SC
 #define MPS_PF_STRING   "sos9sc"
 #define MPS_OS_SO
@@ -236,7 +251,8 @@
 
 /* GCC 2.6.3, gcc -E -dM */
 
-#elif defined(__osf__) && defined(__alpha__) && defined(__GNUC__)
+#elif defined(CONFIG_PF_O1ALGC) \
+      || defined(__osf__) && defined(__alpha__) && defined(__GNUC__)
 #define MPS_PF_O1ALGC
 #define MPS_PF_STRING   "o1algc"
 #define MPS_OS_O1
@@ -250,7 +266,8 @@
 
 /* From the cc(1) man page */
 
-#elif defined(__osf__) && defined(__alpha) && defined(__DECC)
+#elif defined(CONFIG_PF_O1ALCC) \
+      || defined(__osf__) && defined(__alpha) && defined(__DECC)
 #define MPS_PF_O1ALCC
 #define MPS_PF_STRING   "o1alcc"
 #define MPS_OS_O1
@@ -267,7 +284,8 @@
  * all 4.
  */
 
-#elif defined(__linux__) && defined(__i386__) && defined(__GNUC__)
+#elif defined(CONFIG_PF_LII4GC) \
+      || defined(__linux__) && defined(__i386__) && defined(__GNUC__)
 #define MPS_PF_LII4GC
 #define MPS_PF_STRING   "lii4gc"
 #define MPS_OS_LI
@@ -280,7 +298,8 @@
 
 /* GCC 2.7.2, gcc -E -dM */
 
-#elif defined(__linux__) && defined(__PPC__) && defined(__GNUC__)
+#elif defined(CONFIG_PF_LIPPGC) \
+      || defined(__linux__) && defined(__PPC__) && defined(__GNUC__)
 #define MPS_PF_LIPPGC
 #define MPS_PF_STRING   "lippgc"
 #define MPS_OS_LI
@@ -294,7 +313,8 @@
 /* GCC 2.95.3, gcc -E -dM
  */
 
-#elif defined(__FreeBSD__) && defined (__i386__) && defined (__GNUC__)
+#elif defined(CONFIG_PF_FRI4GC) \
+      || defined(__FreeBSD__) && defined (__i386__) && defined (__GNUC__)
 #define MPS_PF_FRI4GC
 #define MPS_PF_STRING   "fri4gc"
 #define MPS_OS_FR
diff --git a/mps/code/mpsw3.h b/mps/code/mpsw3.h
index 57c9f58619e..cd62dd8a8c6 100644
--- a/mps/code/mpsw3.h
+++ b/mps/code/mpsw3.h
@@ -11,15 +11,13 @@
 #define mpsw3_h
 
 #include "mps.h"               /* needed for mps_tramp_t */
-#include "mpswin.h"            /* needed for SEH filter */
+#include <windows.h>           /* needed for SEH filter */
 
 
 extern LONG mps_SEH_filter(LPEXCEPTION_POINTERS, void **, size_t *);
 extern void mps_SEH_handler(void *, size_t);
 
 
-#undef mps_tramp /* Override generic version */
-
 #define mps_tramp(r_o, f, p, s) \
   MPS_BEGIN \
     void **_r_o = (r_o); \
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 71f32977824..c9de434b10e 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
  *
  * DESIGN
  *
@@ -51,10 +52,13 @@ Bool PoolClassCheck(PoolClass class)
   CHECKL(FUNCHECK(class->free));
   CHECKL(FUNCHECK(class->bufferFill));
   CHECKL(FUNCHECK(class->bufferEmpty));
+  CHECKL(FUNCHECK(class->access));
   CHECKL(FUNCHECK(class->whiten));
   CHECKL(FUNCHECK(class->grey));
+  CHECKL(FUNCHECK(class->blacken));
   CHECKL(FUNCHECK(class->scan));
   CHECKL(FUNCHECK(class->fix));
+  CHECKL(FUNCHECK(class->fixEmergency));
   CHECKL(FUNCHECK(class->reclaim));
   CHECKL(FUNCHECK(class->rampBegin));
   CHECKL(FUNCHECK(class->rampEnd));
@@ -62,7 +66,10 @@ Bool PoolClassCheck(PoolClass class)
   CHECKL(FUNCHECK(class->framePop));
   CHECKL(FUNCHECK(class->framePopPending));
   CHECKL(FUNCHECK(class->walk));
+  CHECKL(FUNCHECK(class->freewalk));
+  CHECKL(FUNCHECK(class->bufferClass));
   CHECKL(FUNCHECK(class->describe));
+  CHECKL(FUNCHECK(class->debugMixin));
   CHECKS(PoolClass, class);
   return TRUE;
 }
@@ -452,7 +459,7 @@ void PoolReclaim(Pool pool, Trace trace, Seg seg)
 }
 
 
-/* PoolWalk -- walk objects in this pool */
+/* PoolWalk -- walk objects in this segment */
 
 void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
               void *p, Size s)
@@ -466,6 +473,21 @@ void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
 }
 
 
+/* PoolFreeWalk -- walk free blocks in this pool
+ *
+ * PoolFreeWalk is not required to find all free blocks.
+ */
+
+void PoolFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
+{
+  AVERT(Pool, pool);
+  AVER(FUNCHECK(f));
+  /* p is arbitrary, hence can't be checked. */
+
+  (*pool->class->freewalk)(pool, f, p);
+}
+
+
 /* PoolDescribe -- describe a pool */
 
 Res PoolDescribe(Pool pool, mps_lib_FILE *stream)
diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c
index 86fd76ddf31..eaab36f4d12 100644
--- a/mps/code/poolabs.c
+++ b/mps/code/poolabs.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * PURPOSE
  *
@@ -141,6 +142,7 @@ DEFINE_CLASS(AbstractPoolClass, class)
   class->framePop = PoolNoFramePop;
   class->framePopPending = PoolNoFramePopPending;
   class->walk = PoolNoWalk;
+  class->freewalk = PoolNoFreeWalk;
   class->bufferClass = PoolNoBufferClass;
   class->describe = PoolTrivDescribe;
   class->debugMixin = PoolNoDebugMixin;
@@ -620,6 +622,18 @@ void PoolNoWalk(Pool pool, Seg seg,
 }
 
 
+void PoolNoFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
+{
+  AVERT(Pool, pool);
+  AVER(FUNCHECK(f));
+  /* p is arbitrary, hence can't be checked */
+  UNUSED(p);
+
+  /* FreeWalk doesn't have be perfect, so just pretend you didn't find any. */
+  NOOP;
+}
+
+
 BufferClass PoolNoBufferClass(void)
 {
   NOTREACHED;
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 417d5cb455f..66a515b258b 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -2,12 +2,14 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .sources: design.mps.poolamc.
  */
 
 #include "mpscamc.h"
 #include "chain.h"
+#include "bt.h"
 #include "mpm.h"
 
 SRCID(poolamc, "$Id$");
@@ -1694,14 +1696,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
   arena = PoolArena(pool);
   AVERT(Arena, arena);
 
-  if (!amcSegHasNailboard(seg)) {
-    /* We didn't keep a mark table, so preserve everything. */
-    /* We can't do anything about preservedInPlaceCount. */
-    trace->preservedInPlaceSize += SegSize(seg);
-    goto adjustColour;
-  }
-
-  /* see design.mps.poolamc.Nailboard.limitations for improvements */
+  /* see design.mps.poolamc.nailboard.limitations for improvements */
   headerSize = format->headerSize;
   ShieldExpose(arena, seg);
   p = AddrAdd(SegBase(seg), headerSize);
@@ -1715,7 +1710,11 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
     Size length;
     q = (*format->skip)(p);
     length = AddrOffset(p, q);
-    if (!amcNailGetMark(seg, p)) {
+    if (amcSegHasNailboard(seg)
+        ? !amcNailGetMark(seg, p)
+        /* If there's no mark table, retain all that hasn't been forwarded.  In
+         * this case, preservedInPlace* become somewhat overstated. */
+        : (*format->isMoved)(p) != NULL) {
       (*format->pad)(AddrSub(p, headerSize), length);
       bytesReclaimed += length;
     } else {
@@ -1729,7 +1728,6 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
   AVER(p == limit);
   ShieldCover(arena, seg);
 
-adjustColour:
   SegSetNailed(seg, TraceSetDel(SegNailed(seg), trace));
   SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
   if (SegNailed(seg) == TraceSetEMPTY && amcSegHasNailboard(seg)) {
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index 5d38a0b475f..990043ecc0d 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -2,6 +2,8 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
+ *
  *
  * .design: See design.mps.poolams.
  *
@@ -13,8 +15,8 @@
  * (as opposed to being constructed by the caller).
  */
 
-#include "mpscams.h"
 #include "poolams.h"
+#include "dbgpool.h"
 #include "mpm.h"
 #include <stdarg.h>
 
@@ -25,6 +27,21 @@ SRCID(poolams, "$Id$");
 #define AMSSegSig       ((Sig)0x519A3559) /* SIGnature AMS SeG */
 
 
+/* AMSDebugStruct -- structure for a debug subclass */
+
+typedef struct AMSDebugStruct {
+  AMSStruct amsStruct;         /* AMS structure */
+  PoolDebugMixinStruct debug;  /* debug mixin */
+} AMSDebugStruct;
+
+typedef struct AMSDebugStruct *AMSDebug;
+
+
+#define AMS2AMSDebug(ams)  PARENT(AMSDebugStruct, amsStruct, ams)
+#define AMSDebug2AMS(amsd) (&((amsd)->amsStruct))
+
+
+
 /* AMSSegCheck -- check an AMS segment */
 
 Bool AMSSegCheck(AMSSeg amsseg)
@@ -34,18 +51,26 @@ Bool AMSSegCheck(AMSSeg amsseg)
   CHECKL(GCSegCheck(&amsseg->gcSegStruct));
   CHECKU(AMS, amsseg->ams);
   CHECKL(AMS2Pool(amsseg->ams) == SegPool(seg));
-  CHECKL(RingCheck(&amsseg->segRing));
+  CHECKD_NOSIG(Ring, &amsseg->segRing);
 
   CHECKL(amsseg->grains == AMSGrains(amsseg->ams, SegSize(seg)));
   CHECKL(amsseg->grains > 0);
   CHECKL(amsseg->grains >= amsseg->free + amsseg->newAlloc);
 
-  if (SegWhite(seg) != TraceSetEMPTY)
+  CHECKL(BoolCheck(amsseg->allocTableInUse));
+  if (!amsseg->allocTableInUse)
+    CHECKL(amsseg->firstFree <= amsseg->grains);
+  CHECKL(amsseg->allocTable != NULL);
+
+  if (SegWhite(seg) != TraceSetEMPTY) {
     /* design.mps.poolams.colour.single */
     CHECKL(TraceSetIsSingle(SegWhite(seg)));
+    CHECKL(amsseg->colourTablesInUse);
+  }
 
   CHECKL(BoolCheck(amsseg->marksChanged));
-  CHECKL(amsseg->allocTable != NULL);
+  CHECKL(BoolCheck(amsseg->ambiguousFixes));
+  CHECKL(BoolCheck(amsseg->colourTablesInUse));
   CHECKL(amsseg->nongreyTable != NULL);
   CHECKL(amsseg->nonwhiteTable != NULL);
 
@@ -53,9 +78,69 @@ Bool AMSSegCheck(AMSSeg amsseg)
 }
 
 
+/* AMSSegFreeWalk -- walk the free space in a segment */
+
+void AMSSegFreeWalk(AMSSeg amsseg, FreeBlockStepMethod f, void *p)
+{
+  Pool pool;
+  Seg seg;
+
+  AVERT(AMSSeg, amsseg);
+  pool = SegPool(AMSSeg2Seg(amsseg));
+  seg = AMSSeg2Seg(amsseg);
+
+  if (amsseg->free == 0)
+    return;
+  if (amsseg->allocTableInUse) {
+    Index base, limit, next;
+
+    next = 0;
+    while (next < amsseg->grains) {
+      Bool found = BTFindLongResRange(&base, &limit, amsseg->allocTable,
+                                      next, amsseg->grains, 1);
+      if (!found) break;
+      (*f)(AMS_INDEX_ADDR(seg, base), AMS_INDEX_ADDR(seg, limit), pool, p);
+      next = limit + 1;
+    }
+  } else {
+    if ( amsseg->firstFree < amsseg->grains )
+      (*f)(AMS_INDEX_ADDR(seg, amsseg->firstFree), SegLimit(seg), pool, p);
+  }
+}
+
+
+/* AMSSegFreeCheck -- check the free space in a segment */
+
+static void amsFreeBlockCheckStep(Addr base, Addr limit, Pool pool, void *p)
+{
+  UNUSED(p);
+  DebugPoolFreeCheck(pool, base, limit);
+}
+
+void AMSSegFreeCheck(AMSSeg amsseg)
+{
+  Pool pool;
+  PoolDebugMixin debug;
+
+  AVERT(AMSSeg, amsseg);
+
+  if (amsseg->free == 0)
+    return;
+
+  /* If it's not a debug class, don't bother walking. */
+  pool = SegPool(AMSSeg2Seg(amsseg));
+  AVERT(Pool, pool);
+  debug = ((pool)->class->debugMixin)(pool);
+  if (debug == NULL)
+    return;
+
+  AMSSegFreeWalk(amsseg, amsFreeBlockCheckStep, NULL);
+}
+
+
 /* amsCreateTables -- create the tables for an AMS seg */
 
-static Res amsCreateTables(BT *allocReturn,
+static Res amsCreateTables(AMS ams, BT *allocReturn,
                            BT *nongreyReturn, BT *nonwhiteReturn,
                            Arena arena, Count length)
 {
@@ -74,9 +159,13 @@ static Res amsCreateTables(BT *allocReturn,
   res = BTCreate(&nongreyTable, arena, length);
   if (res != ResOK)
     goto failGrey;
-  res = BTCreate(&nonwhiteTable, arena, length);
-  if (res != ResOK)
-    goto failWhite;
+  if (ams->shareAllocTable)
+    nonwhiteTable = allocTable;
+  else {
+    res = BTCreate(&nonwhiteTable, arena, length);
+    if (res != ResOK)
+      goto failWhite;
+  }
 
   *allocReturn = allocTable;
   *nongreyReturn = nongreyTable;
@@ -94,7 +183,7 @@ failAlloc:
 
 /* amsDestroyTables -- destroy the tables for an AMS seg */
 
-static void amsDestroyTables(BT allocTable,
+static void amsDestroyTables(AMS ams, BT allocTable,
                              BT nongreyTable, BT nonwhiteTable,
                              Arena arena, Count length)
 {
@@ -104,7 +193,8 @@ static void amsDestroyTables(BT allocTable,
   AVERT(Arena, arena);
   AVER(length > 0);
 
-  BTDestroy(nonwhiteTable, arena, length);
+  if (!ams->shareAllocTable)
+    BTDestroy(nonwhiteTable, arena, length);
   BTDestroy(nongreyTable, arena, length);
   BTDestroy(allocTable, arena, length);
 }
@@ -142,7 +232,7 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size,
   amsseg->marksChanged = FALSE; /* design.mps.poolams.marked.unused */
   amsseg->ambiguousFixes = FALSE;
 
-  res = amsCreateTables(&amsseg->allocTable,
+  res = amsCreateTables(ams, &amsseg->allocTable,
                         &amsseg->nongreyTable, &amsseg->nonwhiteTable,
                         arena, amsseg->grains);
   if (res != ResOK)
@@ -189,7 +279,7 @@ static void AMSSegFinish(Seg seg)
   AVER(SegBuffer(seg) == NULL);
 
   /* keep the destructions in step with AMSSegInit failure cases */
-  amsDestroyTables(amsseg->allocTable, amsseg->nongreyTable,
+  amsDestroyTables(ams, amsseg->allocTable, amsseg->nongreyTable,
                    amsseg->nonwhiteTable, arena, amsseg->grains);
 
   RingRemove(&amsseg->segRing);
@@ -259,7 +349,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
   AVER(!amssegHi->marksChanged);
 
   /* .alloc-early  */
-  res = amsCreateTables(&allocTable, &nongreyTable, &nonwhiteTable,
+  res = amsCreateTables(ams, &allocTable, &nongreyTable, &nonwhiteTable,
                         arena, allGrains);
   if (res != ResOK)
     goto failCreateTables;
@@ -283,9 +373,10 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
     amsseg->table = (table); \
   END
 
-  MERGE_TABLES(nonwhiteTable, BTSetRange);
-  MERGE_TABLES(nongreyTable, BTSetRange);
   MERGE_TABLES(allocTable, BTResRange);
+  MERGE_TABLES(nongreyTable, BTSetRange);
+  if (!ams->shareAllocTable)
+    MERGE_TABLES(nonwhiteTable, BTSetRange);
 
   amsseg->grains = allGrains;
   amsseg->free = amsseg->free + amssegHi->free;
@@ -300,7 +391,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
   return ResOK;
 
 failSuper:
-  amsDestroyTables(allocTable, nongreyTable, nonwhiteTable,
+  amsDestroyTables(ams, allocTable, nongreyTable, nonwhiteTable,
                    arena, allGrains);
 failCreateTables:
   AVERT(AMSSeg, amsseg);
@@ -346,11 +437,11 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
   }
 
   /* .alloc-early */
-  res = amsCreateTables(&allocTableLo, &nongreyTableLo, &nonwhiteTableLo,
+  res = amsCreateTables(ams, &allocTableLo, &nongreyTableLo, &nonwhiteTableLo,
                         arena, loGrains);
   if (res != ResOK)
     goto failCreateTablesLo;
-  res = amsCreateTables(&allocTableHi, &nongreyTableHi, &nonwhiteTableHi,
+  res = amsCreateTables(ams, &allocTableHi, &nongreyTableHi, &nonwhiteTableHi,
                         arena, hiGrains);
   if (res != ResOK)
     goto failCreateTablesHi;
@@ -403,10 +494,10 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
   return ResOK;
 
 failSuper:
-  amsDestroyTables(allocTableHi, nongreyTableHi, nonwhiteTableHi,
+  amsDestroyTables(ams, allocTableHi, nongreyTableHi, nonwhiteTableHi,
                    arena, hiGrains);
 failCreateTablesHi:
-  amsDestroyTables(allocTableLo, nongreyTableLo, nonwhiteTableLo,
+  amsDestroyTables(ams, allocTableLo, nongreyTableLo, nonwhiteTableLo,
                    arena, loGrains);
 failCreateTablesLo:
   AVERT(AMSSeg, amsseg);
@@ -481,11 +572,11 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
 
     if (AMS_ALLOCED(seg, i)) {
       if (amsseg->colourTablesInUse) {
-        if (AMSIsInvalidColor(seg, i))
+        if (AMS_IS_INVALID_COLOUR(seg, i))
           c = '!';
-        else if (AMSIsWhite(seg, i))
+        else if (AMS_IS_WHITE(seg, i))
           c = '-';
-        else if (AMSIsGrey(seg, i))
+        else if (AMS_IS_GREY(seg, i))
           c = '+';
         else /* must be black */
           c = '*';
@@ -599,14 +690,15 @@ static Res AMSSegCreate(Seg *segReturn, Pool pool, Size size,
     if (res != ResOK)
       goto failSeg;
   }
-  PoolGenUpdateZones(&ams->pgen, seg);
 
+  PoolGenUpdateZones(&ams->pgen, seg);
   /* see design.mps.seg.field.rankset */
   if (rankSet != RankSetEMPTY) {
     SegSetRankAndSummary(seg, rankSet, RefSetUNIV);
   } else {
     SegSetRankAndSummary(seg, rankSet, RefSetEMPTY);
   }
+  DebugPoolFreeSplat(pool, SegBase(seg), SegLimit(seg));
 
   AVERT(AMSSeg, Seg2AMSSeg(seg));
 
@@ -629,14 +721,12 @@ static void AMSSegsDestroy(AMS ams)
   RING_FOR(node, ring, next) {
     Seg seg = SegOfPoolRing(node);
     AVER(Seg2AMSSeg(seg)->ams == ams);
+    AMSSegFreeCheck(Seg2AMSSeg(seg));
     SegFree(seg);
   }
 }
 
 
-static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure);
-
-
 /* AMSInit -- the pool class initialization method
  *
  *  Takes one additional argument: the format of the objects
@@ -647,12 +737,16 @@ static Res AMSInit(Pool pool, va_list args)
   Res res;
   Format format;
   Chain chain;
+  Bool supportAmbiguous;
 
   AVERT(Pool, pool);
 
   format = va_arg(args, Format);
   chain = va_arg(args, Chain);
-  res = AMSInitInternal(Pool2AMS(pool), format, chain);
+  supportAmbiguous = va_arg(args, Bool);
+  /* .ambiguous.noshare: If the pool is required to support ambiguous */
+  /* references, the alloc and white tables cannot be shared. */
+  res = AMSInitInternal(Pool2AMS(pool), format, chain, !supportAmbiguous);
   if (res == ResOK) {
     EVENT_PPP(PoolInitAMS, pool, PoolArena(pool), format);
   }
@@ -662,7 +756,7 @@ static Res AMSInit(Pool pool, va_list args)
 
 /* AMSInitInternal -- initialize an AMS pool, given the format and the chain */
 
-Res AMSInitInternal(AMS ams, Format format, Chain chain)
+Res AMSInitInternal(AMS ams, Format format, Chain chain, Bool shareAllocTable)
 {
   Pool pool;
   Res res;
@@ -684,10 +778,11 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain)
   if (res != ResOK)
     return res;
 
+  ams->shareAllocTable = shareAllocTable;
+
   RingInit(&ams->segRing);
 
-  /* The next five might be overridden by a subclass. */
-  ams->iterate = AMSIterate; /* should be done using a format variant */
+  /* The next four might be overridden by a subclass. */
   ams->segSize = AMSSegSizePolicy;
   ams->allocRing = AMSPoolRing;
   ams->segsDestroy = AMSSegsDestroy;
@@ -725,8 +820,7 @@ void AMSFinish(Pool pool)
 /* amsSegAlloc -- try to allocate an area in the given segment
  *
  * Tries to find an area of at least the given size.  If successful,
- * makes that area black, if necessary, and returns its base and limit
- * grain indices.
+ * returns its base and limit grain indices.
  */
 static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn,
                         Seg seg, Size size)
@@ -766,6 +860,9 @@ static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn,
     amsseg->firstFree = limit;
   }
 
+  /* We don't place buffers on white segments, so no need to adjust colour. */
+  AVER(!amsseg->colourTablesInUse);
+
   amsseg->free -= limit - base;
   amsseg->newAlloc += limit - base;
   *baseReturn = base;
@@ -779,15 +876,16 @@ static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn,
  * Iterates over the segments looking for space.  See
  * design.mps.poolams.fill.
  */
-Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
-                  Pool pool, Buffer buffer, Size size,
-                  Bool withReservoirPermit)
+static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
+                         Pool pool, Buffer buffer, Size size,
+                         Bool withReservoirPermit)
 {
   Res res;
   AMS ams;
   Seg seg;
   Ring node, ring, nextNode;    /* for iterating over the segments */
   Index base, limit;
+  Addr baseAddr, limitAddr;
   RankSet rankSet;
   Bool b;                       /* the return value of amsSegAlloc */
   SegPrefStruct segPrefStruct;
@@ -816,7 +914,9 @@ Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
     if (amsseg->free >= AMSGrains(ams, size)) {
       seg = AMSSeg2Seg(amsseg);
 
-      if (SegRankSet(seg) == rankSet && SegBuffer(seg) == NULL) {
+      if (SegRankSet(seg) == rankSet && SegBuffer(seg) == NULL
+          /* Can't use a white or grey segment, see d.m.p.fill.colour. */
+          && SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY) {
         b = amsSegAlloc(&base, &limit, seg, size);
         if (b)
           goto found;
@@ -824,7 +924,7 @@ Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
     }
   }
 
-  /* no segment has enough room; make a new segment */
+  /* No suitable segment found; make a new one. */
   segPrefStruct = *SegPrefDefault();
   SegPrefExpress(&segPrefStruct, SegPrefCollected, NULL);
   res = AMSSegCreate(&seg, pool, size, &segPrefStruct, rankSet,
@@ -835,13 +935,13 @@ Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
 
 found:
   AVER(b);
-  allocatedSize = AddrOffset(AMS_INDEX_ADDR(seg, base),
-                             AMS_INDEX_ADDR(seg, limit));
+  baseAddr = AMS_INDEX_ADDR(seg, base); limitAddr = AMS_INDEX_ADDR(seg, limit);
+  DebugPoolFreeCheck(pool, baseAddr, limitAddr);
+  allocatedSize = AddrOffset(baseAddr, limitAddr);
   ams->pgen.totalSize += allocatedSize;
   ams->pgen.newSize += allocatedSize;
 
-  *baseReturn = AMS_INDEX_ADDR(seg, base);
-  *limitReturn = AMS_INDEX_ADDR(seg, limit);
+  *baseReturn = baseAddr; *limitReturn = limitAddr;
   return ResOK;
 }
 
@@ -851,7 +951,7 @@ found:
  * Frees the unused part of the buffer.  The colour of the area doesn't
  * need to be changed.  See design.mps.poolams.empty.
  */
-void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
+static void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
 {
   AMS ams;
   Index initIndex, limitIndex;
@@ -876,6 +976,9 @@ void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
   if (init == limit)
     return;
 
+  /* Tripped allocations might have scribbled on it, need to splat again. */
+  DebugPoolFreeSplat(pool, init, limit);
+
   initIndex = AMS_ADDR_INDEX(seg, init);
   limitIndex = AMS_ADDR_INDEX(seg, limit);
 
@@ -896,6 +999,10 @@ void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
       BTResRange(amsseg->allocTable, initIndex, limitIndex);
     }
   }
+
+  if (amsseg->colourTablesInUse)
+    AMS_RANGE_WHITEN(seg, initIndex, limitIndex);
+
   amsseg->free += limitIndex - initIndex;
   /* The unused portion of the buffer must be new, since it's not condemned. */
   AVER(amsseg->newAlloc >= limitIndex - initIndex);
@@ -907,8 +1014,6 @@ void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
 
 
 /* amsRangeCondemn -- Condemn a part of an AMS segment
- *
- * I.e., alloc -> white, free -> black.
  * Allow calling it with base = limit, to simplify the callers.
  */
 static void amsRangeCondemn(Seg seg, Index base, Index limit)
@@ -919,25 +1024,14 @@ static void amsRangeCondemn(Seg seg, Index base, Index limit)
     AVER(base < limit);
     AVER(limit <= amsseg->grains);
 
-    if (amsseg->allocTableInUse) {
-      BTSetRange(amsseg->nongreyTable, base, limit);
-      BTCopyInvertRange(amsseg->allocTable, amsseg->nonwhiteTable,
-                        base, limit);
-    } else {
-      if (base < amsseg->firstFree) {
-        AMSRangeWhiten(seg, base, amsseg->firstFree);
-      }
-      if (amsseg->firstFree < limit) {
-        AMSRangeBlacken(seg, amsseg->firstFree, limit);
-      }
-    }
+    AMS_RANGE_WHITEN(seg, base, limit);
   }
 }
 
 
-/* AMSWhiten -- the pool class segment condemning method */
+/* AMSCondemn -- the pool class segment condemning method */
 
-Res AMSWhiten(Pool pool, Trace trace, Seg seg)
+static Res AMSCondemn(Pool pool, Trace trace, Seg seg)
 {
   AMS ams;
   AMSSeg amsseg;
@@ -959,6 +1053,28 @@ Res AMSWhiten(Pool pool, Trace trace, Seg seg)
   AVER(!amsseg->colourTablesInUse);
 
   amsseg->colourTablesInUse = TRUE;
+
+  /* Init allocTable, if necessary. */
+  if (!amsseg->allocTableInUse) {
+    if (0 < amsseg->firstFree)
+      BTSetRange(amsseg->allocTable, 0, amsseg->firstFree);
+    if (amsseg->firstFree < amsseg->grains)
+      BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains);
+  }
+
+  /* Start using allocTable as the white table, if so configured. */
+  if (ams->shareAllocTable) {
+    if (amsseg->allocTableInUse) {
+      /* During the collection, it can't use allocTable for AMS_ALLOCED, so */
+      /* make it use firstFree. */
+      amsseg->allocTableInUse = FALSE;
+      /* Could find a better value for firstFree, but probably not worth it. */
+      amsseg->firstFree = amsseg->grains;
+    }
+  } else { /* Otherwise, use it as alloc table. */
+    amsseg->allocTableInUse = TRUE;
+  }
+
   buffer = SegBuffer(seg);
   if (buffer != NULL) { /* design.mps.poolams.condemn.buffer */
     Index scanLimitIndex, limitIndex;
@@ -967,7 +1083,7 @@ Res AMSWhiten(Pool pool, Trace trace, Seg seg)
 
     amsRangeCondemn(seg, 0, scanLimitIndex);
     if (scanLimitIndex < limitIndex)
-      AMSRangeBlacken(seg, scanLimitIndex, limitIndex);
+      AMS_RANGE_BLACKEN(seg, scanLimitIndex, limitIndex);
     amsRangeCondemn(seg, limitIndex, amsseg->grains);
     /* We didn't condemn the buffer, subtract it from the count. */
     uncondemned = limitIndex - scanLimitIndex;
@@ -989,14 +1105,26 @@ Res AMSWhiten(Pool pool, Trace trace, Seg seg)
 }
 
 
+/* AMSObjectFunction is the type of the method that an */
+/* amsIterate applies to each object in a segment. */
+typedef Res (*AMSObjectFunction)(
+  /* the segment */              Seg seg,
+  /* the object grain index */   Index i,
+  /* the address of the object */Addr p,
+  /*  "   "   after the object */Addr next,
+  /* the iteration closure */    void *closure);
+
+#define AMSObjectFunctionCheck(f) \
+  ((f) != NULL) /* that's the best we can do */
+
 
-/* AMSIterate -- applies a function to each object in a segment
+/* amsIterate -- applies a function to each object in a segment
  *
- * AMSIterate(seg, f, closure) applies f to all the
- * objects in the segment.  It skips the buffer, if any (from
- * BufferScanLimit to BufferLimit).
- */
-static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure)
+ * amsIterate(seg, f, closure) applies f to all the objects in the
+ * segment.  It skips the buffer, if any (from BufferScanLimit to
+ * BufferLimit).  */
+
+static Res amsIterate(Seg seg, AMSObjectFunction f, void *closure)
 {
   Res res;
   AMS ams;
@@ -1019,13 +1147,17 @@ static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure)
   AVERT(Format, format);
   alignment = PoolAlignment(AMS2Pool(ams));
 
+  /* If we're using the alloc table as a white table, we can't use it to */
+  /* determine where there are objects. */
+  AVER(!(ams->shareAllocTable && amsseg->colourTablesInUse));
+
   p = SegBase(seg);
   limit = SegLimit(seg);
   buffer = SegBuffer(seg);
 
   while (p < limit) { /* loop over the objects in the segment */
     if (buffer != NULL
-       && p == BufferScanLimit(buffer) && p != BufferLimit(buffer)) {
+        && p == BufferScanLimit(buffer) && p != BufferLimit(buffer)) {
       /* skip buffer */
       next = BufferLimit(buffer);
       AVER(AddrIsAligned(next, alignment));
@@ -1036,10 +1168,26 @@ static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure)
 
       i = AMS_ADDR_INDEX(seg, p);
       if (!AMS_ALLOCED(seg, i)) { /* no object here */
-        next = AddrAdd(p, alignment); /* @@@@ this could be improved */
+        if (amsseg->allocTableInUse) {
+          Index dummy, nextIndex;
+          Bool more;
+
+          /* Find out how large the free block is. */
+          more = BTFindLongResRange(&dummy, &nextIndex, amsseg->allocTable,
+                                    i, amsseg->grains, 1);
+          AVER(more && dummy == i);
+          next = AMS_INDEX_ADDR(seg, nextIndex);
+        } else {
+          /* If there's no allocTable, this is the free block at the end. */
+          next = limit;
+        }
       } else { /* there is an object here */
-        next = (*format->skip)(AddrAdd(p, format->headerSize));
-        next = AddrSub(next, format->headerSize);
+        if (format->skip != NULL) {
+            next = (*format->skip)(AddrAdd(p, format->headerSize));
+            next = AddrSub(next, format->headerSize);
+        } else {
+          next = AddrAdd(p, alignment);
+        }
         AVER(AddrIsAligned(next, alignment));
         res = (*f)(seg, i, p, next, closure);
         if (res != ResOK)
@@ -1056,8 +1204,7 @@ static Res AMSIterate(Seg seg, AMSObjectFunction f, void *closure)
 
 /* amsScanObject -- scan a single object
  *
- * This is the object function passed to AMSIterate by AMSScan.
- */
+ * This is the object function passed to amsIterate by AMSScan.  */
 
 struct amsScanClosureStruct {
   ScanState ss;
@@ -1074,12 +1221,12 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
   Res res;
 
   amsseg = Seg2AMSSeg(seg);
-  /* seg & amsseg have already been checked, in AMSIterate. */
+  /* seg & amsseg have already been checked, in amsIterate. */
   AVER(i < amsseg->grains);
   AVER(p != 0);
   AVER(p < next);
   AVER(clos != NULL);
-  closure = clos;
+  closure = (amsScanClosure)clos;
   AVERT(ScanState, closure->ss);
   AVER(BoolCheck(closure->scanAllObjects));
 
@@ -1087,7 +1234,7 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
   AVERT(Format, format);
 
   /* @@@@ This isn't quite right for multiple traces. */
-  if (closure->scanAllObjects || AMSIsGrey(seg, i)) {
+  if (closure->scanAllObjects || AMS_IS_GREY(seg, i)) {
     res = (*format->scan)(closure->ss,
                           AddrAdd(p, format->headerSize),
                           AddrAdd(next, format->headerSize));
@@ -1096,10 +1243,10 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos)
     closure->ss->scannedSize += AddrOffset(p, next);
     if (!closure->scanAllObjects) {
       Index j = AMS_ADDR_INDEX(seg, next);
-      AVER(!AMSIsInvalidColor(seg, i));
-      AMSGreyBlacken(seg, i);
+      AVER(!AMS_IS_INVALID_COLOUR(seg, i));
+      AMS_GREY_BLACKEN(seg, i);
       if (i+1 < j)
-        AMSRangeWhiteBlacken(seg, i+1, j);
+        AMS_RANGE_WHITE_BLACKEN(seg, i+1, j);
     }
   }
 
@@ -1141,7 +1288,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
   /* @@@@ This isn't quite right for multiple traces. */
   if (closureStruct.scanAllObjects) {
     /* The whole seg (except the buffer) is grey for some trace. */
-    res = (ams->iterate)(seg, amsScanObject, &closureStruct);
+    res = amsIterate(seg, amsScanObject, &closureStruct);
     if (res != ResOK) {
       *totalReturn = FALSE;
       return res;
@@ -1157,7 +1304,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
       amsseg->marksChanged = FALSE; /* design.mps.poolams.marked.scan */
       /* design.mps.poolams.ambiguous.middle */
       if (amsseg->ambiguousFixes) {
-        res = (ams->iterate)(seg, amsScanObject, &closureStruct);
+        res = amsIterate(seg, amsScanObject, &closureStruct);
         if (res != ResOK) {
           /* design.mps.poolams.marked.scan.fail */
           amsseg->marksChanged = TRUE;
@@ -1170,13 +1317,17 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
 
         while(j < amsseg->grains
               && AMSFindGrey(&i, &j, seg, j, amsseg->grains)) {
-            Addr clientP, clientNext;
-          AVER(!AMSIsInvalidColor(seg, i));
+          Addr clientP, clientNext;
+          AVER(!AMS_IS_INVALID_COLOUR(seg, i));
           p = AMS_INDEX_ADDR(seg, i);
           clientP = AddrAdd(p, format->headerSize);
-          clientNext = (*format->skip)(clientP);
-          next = AddrSub(clientNext, format->headerSize);
-          AVER(AddrIsAligned(next, alignment));
+          if (format->skip != NULL) {
+            clientNext = (*format->skip)(clientP);
+            next = AddrSub(clientNext, format->headerSize);
+          } else {
+            clientNext = AddrAdd(clientP, alignment);
+            next = AddrAdd(p, alignment);
+          }
           j = AMS_ADDR_INDEX(seg, next);
           res = (*format->scan)(ss, clientP, clientNext);
           if (res != ResOK) {
@@ -1185,10 +1336,13 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
             *totalReturn = FALSE;
             return res;
           }
+          /* Check that there haven't been any ambiguous fixes during the */
+          /* scan, because AMSFindGrey won't work otherwise. */
+          AVER_CRITICAL(!amsseg->ambiguousFixes);
           ss->scannedSize += AddrOffset(p, next);
-          AMSGreyBlacken(seg, i);
+          AMS_GREY_BLACKEN(seg, i);
           if (i+1 < j)
-            AMSRangeWhiteBlacken(seg, i+1, j);
+            AMS_RANGE_WHITE_BLACKEN(seg, i+1, j);
         }
       }
     } while(amsseg->marksChanged);
@@ -1201,7 +1355,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg)
 
 /* AMSFix -- the pool class fixing method */
 
-Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
+static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
 {
   AMSSeg amsseg;
   Index i;                      /* the index of the fixed grain */
@@ -1238,12 +1392,16 @@ Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   }
 
   i = AMS_ADDR_INDEX(seg, base);
-  AVER_CRITICAL(!AMSIsInvalidColor(seg, i));
+  AVER_CRITICAL(!AMS_IS_INVALID_COLOUR(seg, i));
 
   ss->wasMarked = TRUE;
 
   switch (ss->rank) {
   case RankAMBIG:
+    if (Pool2AMS(pool)->shareAllocTable)
+      /* In this state, the pool doesn't support ambiguous references (see */
+      /* .ambiguous.noshare), so this is not a reference. */
+      break;
     /* not a real pointer if not aligned or not allocated */
     if (!AddrIsAligned(base, PoolAlignment(pool))
        || !AMS_ALLOCED(seg, i)) {
@@ -1256,7 +1414,7 @@ Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
   case RankWEAK:
     AVER_CRITICAL(AddrIsAligned(base, PoolAlignment(pool)));
     AVER_CRITICAL(AMS_ALLOCED(seg, i));
-    if (AMSIsWhite(seg, i)) {
+    if (AMS_IS_WHITE(seg, i)) {
       ss->wasMarked = FALSE;
       if (ss->rank == RankWEAK) { /* then splat the reference */
         *refIO = (Ref)0;
@@ -1272,9 +1430,9 @@ Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
           next = AddrSub(clientNext, format->headerSize);
           /* Part of the object might be grey, because of ambiguous */
           /* fixes, but that's OK, because scan will ignore that. */
-          AMSRangeWhiteBlacken(seg, i, AMS_ADDR_INDEX(seg, next));
+          AMS_RANGE_WHITE_BLACKEN(seg, i, AMS_ADDR_INDEX(seg, next));
         } else { /* turn it grey */
-          AMSWhiteGreyen(seg, i);
+          AMS_WHITE_GREYEN(seg, i);
           SegSetGrey(seg, TraceSetUnion(SegGrey(seg), ss->traces));
           /* mark it for scanning - design.mps.poolams.marked.fix */
           amsseg->marksChanged = TRUE;
@@ -1294,7 +1452,7 @@ Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
  *
  * Turn all grey objects black.
  */
-void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg)
+static void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg)
 {
   AMS ams;
 
@@ -1304,7 +1462,7 @@ void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg)
   AVERT(TraceSet, traceSet);
   AVERT(Seg, seg);
 
-  /* If it's white for any trace, remove the greyness from tables. */
+  /* If it's white for any of these traces, remove the greyness from tables. */
   if (TraceSetInter(traceSet, SegWhite(seg)) != TraceSetEMPTY) {
     AMSSeg amsseg = Seg2AMSSeg(seg);
     AVERT(AMSSeg, amsseg);
@@ -1318,61 +1476,64 @@ void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg)
 
 /* AMSReclaim -- the pool class reclamation method */
 
-void AMSReclaim(Pool pool, Trace trace, Seg seg)
+static void AMSReclaim(Pool pool, Trace trace, Seg seg)
 {
   AMS ams;
   AMSSeg amsseg;
-  Format format;
-  Align alignment;
-  Count reclaimed = 0;
-  Index i, j = 0;
-  Addr p, next;
+  Count nowFree, grains;
+  Size reclaimedSize;
+  PoolDebugMixin debug;
 
   AVERT(Pool, pool);
   ams = Pool2AMS(pool);
   AVERT(AMS, ams);
+  AVERT(Trace, trace);
   AVERT(Seg, seg);
 
   amsseg = Seg2AMSSeg(seg);
   /* It's a white seg, so it must have colour tables. */
   AVER(amsseg->colourTablesInUse);
   AVER(!amsseg->marksChanged); /* there must be nothing grey */
-  format = pool->format;
-  AVERT(Format, format);
-  alignment = PoolAlignment(AMS2Pool(ams));
+  grains = amsseg->grains;
 
-  /* Start using allocTable */
-  if (!amsseg->allocTableInUse) {
-    amsseg->allocTableInUse = TRUE;
-    if (0 < amsseg->firstFree)
-      BTSetRange(amsseg->allocTable, 0, amsseg->firstFree);
-    if (amsseg->firstFree < amsseg->grains)
-      BTResRange(amsseg->allocTable, amsseg->firstFree, amsseg->grains);
+  /* Loop over all white blocks and splat them, if it's a debug class. */
+  debug = ((pool)->class->debugMixin)(pool);
+  if (debug != NULL) {
+    Index i, j = 0;
+
+    while(j < grains && AMS_FIND_WHITE_RANGE(&i, &j, seg, j, grains)) {
+      AVER(!AMS_IS_INVALID_COLOUR(seg, i));
+      DebugPoolFreeSplat(pool, AMS_INDEX_ADDR(seg, i), AMS_INDEX_ADDR(seg, j));
+      ++j; /* we know next grain is not white */
+    }
   }
 
-  /* Loop over all white objects and free them */
-  while(j < amsseg->grains
-        && AMSFindWhite(&i, &j, seg, j, amsseg->grains)) {
-    Addr clientP, clientNext;
-    AVER(!AMSIsInvalidColor(seg, i));
-    p = AMS_INDEX_ADDR(seg, i);
-    clientP = AddrAdd(p, format->headerSize);
-    clientNext = (*format->skip)(clientP);
-    next = AddrSub(clientNext, format->headerSize);
-    AVER(AddrIsAligned(next, alignment));
-    j = AMS_ADDR_INDEX(seg, next);
-    BTResRange(amsseg->allocTable, i, j);
-    reclaimed += j - i;
+  nowFree = BTCountResRange(amsseg->nonwhiteTable, 0, grains);
+
+  /* If the free space is all after firstFree, keep on using firstFree. */
+  /* It could have a more complicated condition, but not worth the trouble. */
+  if (!amsseg->allocTableInUse && amsseg->firstFree + nowFree == grains) {
+    AVER(amsseg->firstFree == grains
+         || BTIsResRange(amsseg->nonwhiteTable,
+                         amsseg->firstFree, grains));
+  } else {
+    if (ams->shareAllocTable) {
+      /* Stop using allocTable as the white table. */
+      amsseg->allocTableInUse = TRUE;
+    } else {
+      AVER(amsseg->allocTableInUse);
+      BTCopyRange(amsseg->nonwhiteTable, amsseg->allocTable, 0, grains);
+    }
   }
 
-  amsseg->free += reclaimed;
-  trace->reclaimSize += reclaimed << ams->grainShift;
-  ams->pgen.totalSize -= reclaimed << ams->grainShift;
+  reclaimedSize = (nowFree - amsseg->free) << ams->grainShift;
+  amsseg->free = nowFree;
+  trace->reclaimSize += reclaimedSize;
+  ams->pgen.totalSize -= reclaimedSize;
   /* preservedInPlaceCount is updated on fix */
-  trace->preservedInPlaceSize +=
-    (amsseg->grains - amsseg->free) << ams->grainShift;
+  trace->preservedInPlaceSize += (grains - amsseg->free) << ams->grainShift;
 
-  if (amsseg->free == amsseg->grains && SegBuffer(seg) == NULL) {
+  if (amsseg->free == grains && SegBuffer(seg) == NULL) {
     /* No survivors */
     SegFree(seg);
   } else {
@@ -1382,6 +1543,24 @@ void AMSReclaim(Pool pool, Trace trace, Seg seg)
 }
 
 
+/* AMSFreeWalk -- free block walking method of the pool class */
+
+static void AMSFreeWalk(Pool pool, FreeBlockStepMethod f, void *p)
+{
+  AMS ams;
+  Ring node, ring, nextNode;    /* for iterating over the segments */
+
+  AVERT(Pool, pool);
+  ams = Pool2AMS(pool);
+  AVERT(AMS, ams);
+
+  ring = &ams->segRing;
+  RING_FOR(node, ring, nextNode) {
+    AMSSegFreeWalk(RING_ELT(AMSSeg, segRing, node), f, p);
+  }
+}
+
+
 /* AMSDescribe -- the pool class description method
  *
  * Iterates over the segments, describing all of them.
@@ -1441,41 +1620,60 @@ DEFINE_CLASS(AMSPoolClass, this)
   this->bufferClass = RankBufClassGet;
   this->bufferFill = AMSBufferFill;
   this->bufferEmpty = AMSBufferEmpty;
-  this->whiten = AMSWhiten;
+  this->whiten = AMSCondemn;
   this->blacken = AMSBlacken;
   this->scan = AMSScan;
   this->fix = AMSFix;
   this->fixEmergency = AMSFix;
   this->reclaim = AMSReclaim;
+  this->freewalk = AMSFreeWalk;
   this->describe = AMSDescribe;
 }
 
 
+/* AMSDebugMixin - find debug mixin in class AMSDebug */
+
+static PoolDebugMixin AMSDebugMixin(Pool pool)
+{
+  AMS ams;
+
+  AVERT(Pool, pool);
+  ams = Pool2AMS(pool);
+  AVERT(AMS, ams);
+  /* Can't check AMSDebug, because this is called during init */
+  return &(AMS2AMSDebug(ams)->debug);
+}
+
+
+/* AMSDebugPoolClass -- the class definition for the debug version */
+
+DEFINE_POOL_CLASS(AMSDebugPoolClass, this)
+{
+  INHERIT_CLASS(this, AMSPoolClass);
+  PoolClassMixInDebug(this);
+  this->name = "AMSDBG";
+  this->size = sizeof(AMSDebugStruct);
+  this->debugMixin = AMSDebugMixin;
+}
+
+
 /* AMSCheck -- the check method for an AMS */
 
 Bool AMSCheck(AMS ams)
 {
   CHECKS(AMS, ams);
-  CHECKD(Pool, AMS2Pool(ams));
+  CHECKL(PoolCheck(AMS2Pool(ams)));
   CHECKL(IsSubclassPoly(AMS2Pool(ams)->class, AMSPoolClassGet()));
   CHECKL(PoolAlignment(AMS2Pool(ams)) == ((Size)1 << ams->grainShift));
   CHECKL(PoolAlignment(AMS2Pool(ams)) == AMS2Pool(ams)->format->alignment);
   CHECKD(Chain, ams->chain);
   CHECKD(PoolGen, &ams->pgen);
   CHECKL(SizeIsAligned(ams->size, ArenaAlign(PoolArena(AMS2Pool(ams)))));
-  CHECKL(ams->iterate != NULL);
+  CHECKL(FUNCHECK(ams->segSize));
   CHECKL(RingCheck(&ams->segRing));
-  CHECKL(ams->allocRing != NULL);
-  CHECKL(ams->segsDestroy != NULL);
-  CHECKL(ams->segClass != NULL);
+  CHECKL(FUNCHECK(ams->allocRing));
+  CHECKL(FUNCHECK(ams->segsDestroy));
+  CHECKL(FUNCHECK(ams->segClass));
 
   return TRUE;
 }
-
-
-/* mps_class_ams -- return the pool class descriptor to the client */
-
-mps_class_t mps_class_ams(void)
-{
-  return (mps_class_t)AMSPoolClassGet();
-}
diff --git a/mps/code/poolams.h b/mps/code/poolams.h
index 498cc50b04e..7153953e08f 100644
--- a/mps/code/poolams.h
+++ b/mps/code/poolams.h
@@ -2,14 +2,17 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
- * .purpose: Internal interface to AMS functionality.
- */
+ * .purpose: Internal interface to AMS functionality.  */
 
 #ifndef poolams_h
 #define poolams_h
 
-#include "mpm.h"
+#include "mpmtypes.h"
+#include "mpmst.h"
+#include "ring.h"
+#include "bt.h"
 #include <stdarg.h>
 
 
@@ -32,19 +35,6 @@ typedef void (*AMSSegsDestroyFunction)(AMS ams);
 typedef Res (*AMSSegSizePolicyFunction)(Size *sizeReturn,
                                         Pool pool, Size size,
                                         RankSet rankSet);
-/* AMSObjectFunction is the type of the method that an */
-/* AMSIterateFunction applies to each object in a segment. */
-typedef Res (*AMSObjectFunction)(
-  /* the segment */              Seg seg,
-  /* the object grain index */   Index i,
-  /* the address of the object */Addr p,
-  /*  "   "   after the object */Addr next,
-  /* the iteration closure */    void *closure);
-
-#define AMSObjectFunctionCheck(f) \
-  ((f) != NULL) /* that's the best we can do */
-
-typedef Res (*AMSIterateFunction)(Seg seg, AMSObjectFunction f, void *closure);
 
 
 typedef struct AMSStruct {
@@ -53,12 +43,12 @@ typedef struct AMSStruct {
   Chain chain;                 /* chain used by this pool */
   PoolGenStruct pgen;          /* generation representing the pool */
   Size size;                   /* total segment size of the pool */
-  AMSIterateFunction iterate;  /* iterator function */
   AMSSegSizePolicyFunction segSize; /* SegSize policy */
   RingStruct segRing;          /* ring of segments in the pool */
   AMSRingFunction allocRing;   /* fn to get the ring to allocate from */
   AMSSegsDestroyFunction segsDestroy;
   AMSSegClassFunction segClass;/* fn to get the class for segments */
+  Bool shareAllocTable;        /* the alloc table is also used as white table */
   Sig sig;                     /* design.mps.pool.outer-structure.sig */
 } AMSStruct;
 
@@ -70,15 +60,15 @@ typedef struct AMSSegStruct {
   Count grains;          /* number of grains */
   Count free;            /* number of free grains */
   Count newAlloc;        /* number of grains allocated since last GC */
-  Bool allocTableInUse;  /* whether we use allocTable */
+  Bool allocTableInUse;  /* allocTable is used */
   Index firstFree;       /* 1st free grain, if allocTable is not used */
   BT allocTable;         /* set if grain is allocated */
   /* design.mps.poolams.colour.single */
-  Bool marksChanged;     /* has been marked since last scan */
-  Bool ambiguousFixes;   /* has been ambiguously marked since last scan */
-  Bool colourTablesInUse;/* whether we use the colour tables */
-  BT nongreyTable;       /* set if grain not grey */
+  Bool marksChanged;     /* seg has been marked since last scan */
+  Bool ambiguousFixes;   /* seg has been ambiguously marked since last scan */
+  Bool colourTablesInUse;/* the colour tables are in use */
   BT nonwhiteTable;      /* set if grain not white */
+  BT nongreyTable;       /* set if not first grain of grey object */
   Sig sig;
 } AMSSegStruct;
 
@@ -110,59 +100,62 @@ typedef struct AMSSegStruct {
 
 /* colour ops */
 
-#define AMSIsWhite(seg, index) \
+#define AMS_IS_WHITE(seg, index) \
   (!BTGet(Seg2AMSSeg(seg)->nonwhiteTable, index))
 
-#define AMSIsGrey(seg, index) \
+#define AMS_IS_GREY(seg, index) \
   (!BTGet(Seg2AMSSeg(seg)->nongreyTable, index))
 
-#define AMSIsBlack(seg, index) \
-  (!AMSIsGrey(seg, index) && !AMSIsWhite(seg, index))
+#define AMS_IS_BLACK(seg, index) \
+  (!AMS_IS_GREY(seg, index) && !AMS_IS_WHITE(seg, index))
 
-#define AMSIsInvalidColor(seg, index) \
-  (AMSIsGrey(seg, index) && AMSIsWhite(seg, index))
+#define AMS_IS_INVALID_COLOUR(seg, index) \
+  (AMS_IS_GREY(seg, index) && AMS_IS_WHITE(seg, index))
 
-#define AMSGreyBlacken(seg, index) \
+#define AMS_WHITE_GREYEN(seg, index) \
   BEGIN \
-    BTSet(Seg2AMSSeg(seg)->nongreyTable, index); \
+    BTSet(Seg2AMSSeg(seg)->nonwhiteTable, index); \
+    BTRes(Seg2AMSSeg(seg)->nongreyTable, index); \
   END
 
-#define AMSWhiteGreyen(seg, index) \
+#define AMS_GREY_BLACKEN(seg, index) \
   BEGIN \
-    BTSet(Seg2AMSSeg(seg)->nonwhiteTable, index); \
-    BTRes(Seg2AMSSeg(seg)->nongreyTable, index); \
+    BTSet(Seg2AMSSeg(seg)->nongreyTable, index); \
   END
 
-#define AMSWhiteBlacken(seg, index) \
+#define AMS_WHITE_BLACKEN(seg, index) \
   BEGIN \
     BTSet(Seg2AMSSeg(seg)->nonwhiteTable, index); \
   END
 
-#define AMSRangeWhiteBlacken(seg, base, limit) \
+#define AMS_RANGE_WHITE_BLACKEN(seg, base, limit) \
   BEGIN \
     BTSetRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \
   END
 
-#define AMSRangeWhiten(seg, base, limit) \
+#define AMS_RANGE_BLACKEN(seg, base, limit) \
   BEGIN \
-    BTResRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \
+    BTSetRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \
     BTSetRange(Seg2AMSSeg(seg)->nongreyTable, base, limit); \
   END
 
-#define AMSRangeBlacken(seg, base, limit) \
+#define AMS_RANGE_WHITEN(seg, base, limit) \
   BEGIN \
-    BTSetRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \
+    BTResRange(Seg2AMSSeg(seg)->nonwhiteTable, base, limit); \
     BTSetRange(Seg2AMSSeg(seg)->nongreyTable, base, limit); \
   END
 
 #define AMSFindGrey(pos, dummy, seg, base, limit) \
   BTFindShortResRange(pos, dummy, Seg2AMSSeg(seg)->nongreyTable, \
-                      base, limit, 1) \
+                      base, limit, 1)
 
 #define AMSFindWhite(pos, dummy, seg, base, limit) \
   BTFindShortResRange(pos, dummy, Seg2AMSSeg(seg)->nonwhiteTable, \
-                      base, limit, 1) \
+                      base, limit, 1)
 
+#define AMS_FIND_WHITE_RANGE(baseOut, limitOut, seg, base, limit) \
+  BTFindLongResRange(baseOut, limitOut, Seg2AMSSeg(seg)->nonwhiteTable, \
+                     base, limit, 1)
 
 #define AMS_ALLOCED(seg, index) \
   (Seg2AMSSeg(seg)->allocTableInUse \
@@ -172,25 +165,19 @@ typedef struct AMSSegStruct {
 
 /* the rest */
 
-extern Res AMSInitInternal(AMS ams, Format format, Chain chain);
+extern Res AMSInitInternal(AMS ams, Format format, Chain chain,
+                           Bool shareAllocTable);
 extern void AMSFinish(Pool pool);
 extern Bool AMSCheck(AMS ams);
 
-extern Res AMSBufferInit(Pool pool, Buffer buffer, va_list args);
-extern Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
-                         Pool pool, Buffer buffer, Size size,
-                         Bool withReservoirPermit);
-extern void AMSBufferEmpty(Pool pool, Buffer buffer,
-                           Addr init, Addr limit);
-
-extern Res AMSWhiten(Pool pool, Trace trace, Seg seg);
 extern Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg);
-extern Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO);
-extern void AMSBlacken(Pool pool, TraceSet traceSet, Seg seg);
-extern void AMSReclaim(Pool pool, Trace trace, Seg seg);
 
 #define AMSChain(ams) ((ams)->chain)
 
+extern void AMSSegFreeWalk(AMSSeg amsseg, FreeBlockStepMethod f, void *p);
+
+extern void AMSSegFreeCheck(AMSSeg amsseg);
+
 
 typedef SegClass AMSSegClass;
 typedef SegClassStruct AMSSegClassStruct;
@@ -202,6 +189,7 @@ typedef PoolClass AMSPoolClass;
 typedef PoolClassStruct AMSPoolClassStruct;
 
 extern AMSPoolClass AMSPoolClassGet(void);
+extern AMSPoolClass AMSDebugPoolClassGet(void);
 
 
 #endif /* poolams_h */
diff --git a/mps/code/poolamsi.c b/mps/code/poolamsi.c
new file mode 100644
index 00000000000..c22236c0d7e
--- /dev/null
+++ b/mps/code/poolamsi.c
@@ -0,0 +1,28 @@
+/* impl.c.poolamsi: AUTOMATIC MARK & SWEEP POOL CLASS C INTERFACE
+ *
+ * $Id: poolamsi.c,v 1.2 2002/02/01 14:27:28 pekka Exp $
+ * $HopeName: MMsrc!poolamsi.c(trunk.2) $
+ * Copyright (C) 2002 Global Graphics Software.
+ */
+
+#include "mpscams.h"
+#include "mps.h"
+#include "poolams.h"
+
+SRCID(poolamsi, "$Id: poolamsi.c,v 1.2 2002/02/01 14:27:28 pekka Exp $");
+
+
+/* mps_class_ams -- return the AMS pool class descriptor */
+
+mps_class_t mps_class_ams(void)
+{
+  return (mps_class_t)AMSPoolClassGet();
+}
+
+
+/* mps_class_ams_debug -- return the AMS (debug) pool class descriptor */
+
+mps_class_t mps_class_ams_debug(void)
+{
+  return (mps_class_t)AMSDebugPoolClassGet();
+}
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index d7f0992c40b..bcf799b0bc0 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -43,7 +43,6 @@
 #include "mpm.h"
 #include "chain.h"
 
-
 SRCID(poolawl, "$Id$");
 
 
diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h
index ab145f2a70d..7d77e29dc87 100644
--- a/mps/code/poolmfs.h
+++ b/mps/code/poolmfs.h
@@ -1,6 +1,4 @@
-/*  impl.h.poolmfs  draft impl
- *
- *                    MANUAL FIXED SMALL UNIT POOL
+/*  impl.h.poolmfs: MANUAL FIXED SMALL UNIT POOL
  *
  *  $Id$
  *
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index f10933c2db8..c276794e1a8 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -2,7 +2,9 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
- *
+ * Copyright (C) 2002 Global Graphics Software.
+ * 
+ * 
  * DESIGN
  *
  * .design: See design.mps.poolmrg.
@@ -26,6 +28,7 @@
  * and MRG pools, whatever that might be.
  */
 
+#include "ring.h"
 #include "mpm.h"
 #include "poolmrg.h"
 
@@ -34,12 +37,11 @@ SRCID(poolmrg, "$Id$");
 
 /* Types */
 
-/* enumerate the states of a Guardian */
+/* enumerate the states of a guardian */
 enum {
   MRGGuardianFREE = 1,
   MRGGuardianPREFINAL,
-  MRGGuardianFINAL,
-  MRGGuardianPOSTFINAL
+  MRGGuardianFINAL
 };
 
 
@@ -47,7 +49,7 @@ enum {
 
 typedef struct LinkStruct *Link;
 typedef struct LinkStruct {
-  int state;                     /* Free, Prefinal, Final, Postfinal */
+  int state;                     /* Free, Prefinal, Final */
   union {
     MessageStruct messageStruct; /* state = Final */
     RingStruct linkRing;         /* state one of {Free, Prefinal} */
@@ -323,9 +325,11 @@ static Count MRGGuardiansPerSeg(MRG mrg)
 
 /* design.mps.poolmrg.guardian.assoc */
 
+
 #define refPartOfIndex(refseg, index) \
   ((RefPart)SegBase(RefSeg2Seg(refseg)) + (index))
 
+
 static RefPart MRGRefPartOfLink(Link link, Arena arena)
 {
   Seg seg;
@@ -349,9 +353,12 @@ static RefPart MRGRefPartOfLink(Link link, Arena arena)
   return refPartOfIndex(linkseg->refSeg, index);
 }
 
+
 #define linkOfIndex(linkseg, index) \
   ((Link)SegBase(LinkSeg2Seg(linkseg)) + (index))
 
+
+#if 0
 static Link MRGLinkOfRefPart(RefPart refPart, Arena arena)
 {
   Seg seg;
@@ -374,6 +381,7 @@ static Link MRGLinkOfRefPart(RefPart refPart, Arena arena)
 
   return linkOfIndex(refseg->linkSeg, index);
 }
+#endif
 
 
 /* MRGGuardianInit -- Initialises both parts of a guardian */
@@ -395,35 +403,26 @@ static void MRGGuardianInit(MRG mrg, Link link, RefPart refPart)
 /* MRGMessage* -- Implementation of MRG's MessageClass */
 
 
-/* MRGMessageDelete -- deletes the message (frees up the memory) */
+/* MRGMessageDelete -- deletes the message (frees up the guardian) */
 
 static void MRGMessageDelete(Message message)
 {
-  RefPart refPart;
   Pool pool;
   Arena arena;
   Link link;
+  Bool b;
 
   AVERT(Message, message);
 
   arena = MessageArena(message);
-
-  { /* Calculate pool */
-    Bool b;
-    Seg seg;
-    b = SegOfAddr(&seg, arena, (Addr)message);
-    AVER(b);
-
-    pool = SegPool(seg);
-  }
+  b = PoolOfAddr(&pool, arena, (Addr)message);
+  AVER(b);
   AVER(pool->class == PoolClassMRG());
 
   link = linkOfMessage(message);
-  MessageFinish(message);
   AVER(link->state == MRGGuardianFINAL);
-  link->state = MRGGuardianPOSTFINAL;
-  refPart = MRGRefPartOfLink(link, arena);
-  PoolFree(pool, (Addr)refPart, sizeof(RefPartStruct));
+  MessageFinish(message);
+  MRGGuardianInit(Pool2MRG(pool), link, MRGRefPartOfLink(link, arena));
 }
 
 
@@ -547,7 +546,7 @@ failLinkSegAlloc:
 }
 
 
-/* MRGFinalise -- finalize the indexth guardian in the segment */
+/* MRGFinalize -- finalize the indexth guardian in the segment */
 
 static void MRGFinalize(Arena arena, MRGLinkSeg linkseg, Index index)
 {
@@ -686,6 +685,8 @@ static void MRGFinish(Pool pool)
 }
 
 
+/* MRGRegister -- register an object for finalization */
+
 Res MRGRegister(Pool pool, Ref ref)
 {
   Ring freeNode;
@@ -707,7 +708,6 @@ Res MRGRegister(Pool pool, Ref ref)
 
   /* design.mps.poolmrg.alloc.grow */
   if (RingIsSingle(&mrg->freeRing)) {
-    /* .refseg.useless: refseg isn't used */
     /* @@@@ Should the client be able to use the reservoir for this? */
     res = MRGSegPairCreate(&junk, mrg, /* withReservoirPermit */ FALSE);  
     if (res != ResOK)
@@ -731,32 +731,49 @@ Res MRGRegister(Pool pool, Ref ref)
 }
 
 
-/* MRGFree -- free a guardian */
+/* MRGDeregister -- deregister (once) an object for finalization */
 
-static void MRGFree(Pool pool, Addr old, Size size)
+Res MRGDeregister(Pool pool, Ref obj)
 {
-  MRG mrg;
+  Ring node, nextNode;
+  Count nGuardians;       /* guardians per seg */
   Arena arena;
-  Link link;
-  RefPart refPart;
+  MRG mrg;
 
   AVERT(Pool, pool);
-  AVER(old != (Addr)0);
-  AVER(size == sizeof(RefPartStruct));
+  /* Can't check obj */
 
   mrg = Pool2MRG(pool);
   AVERT(MRG, mrg);
-
-  refPart = (RefPart)old;
-
+  nGuardians = MRGGuardiansPerSeg(mrg);
   arena = PoolArena(pool);
-  AVERT(Arena, arena);
 
-  /* design.mps.poolmrg.guardian.ref.free */
-  link = MRGLinkOfRefPart(refPart, arena);
-  AVER(link->state == MRGGuardianPOSTFINAL);
-
-  MRGGuardianInit(mrg, link, refPart);
+  /* map over the segments */
+  RING_FOR(node, &mrg->refRing, nextNode) {
+    MRGRefSeg refSeg = RING_ELT(MRGRefSeg, mrgRing, node);
+    MRGLinkSeg linkSeg;
+    Count i;
+    Link link;
+    RefPart refPart;
+
+    AVERT(MRGRefSeg, refSeg);
+    linkSeg = refSeg->linkSeg;
+    /* map over each guardian in the segment */
+    for(i = 0, link = (Link)SegBase(LinkSeg2Seg(linkSeg)),
+          refPart = (RefPart)SegBase(RefSeg2Seg(refSeg));
+        i < nGuardians;
+        ++i, ++link, ++refPart) {
+      /* check if it's allocated and points to obj */
+      if (link->state == MRGGuardianPREFINAL
+          && MRGRefPartRef(arena, refPart) == obj) {
+        RingRemove(&link->the.linkRing);
+        RingFinish(&link->the.linkRing);
+        MRGGuardianInit(mrg, link, refPart);
+        return ResOK;
+      }
+    }
+  }
+  return ResFAIL;
 }
 
 
@@ -833,7 +850,6 @@ DEFINE_POOL_CLASS(MRGPoolClass, this)
   this->attr |= (AttrSCAN | AttrFREE | AttrINCR_RB);
   this->init = MRGInit;
   this->finish = MRGFinish;
-  this->free = MRGFree;
   this->grey = PoolTrivGrey;
   this->blacken = PoolTrivBlacken;
   this->scan = MRGScan;
diff --git a/mps/code/poolmrg.h b/mps/code/poolmrg.h
index e6a937fc5fc..fc7b5378f0e 100644
--- a/mps/code/poolmrg.h
+++ b/mps/code/poolmrg.h
@@ -1,19 +1,20 @@
-/*  impl.h.amc  draft impl
- *
- *               MANUAL RANK GUARDIAN POOL CLASS
+/*  impl.h.poolmrg: MANUAL RANK GUARDIAN POOL CLASS INTERFACE
  *
  *  $Id$
- *  Copyright (c) 2001 Ravenbrook Limited.
+ *
+ * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  */
 
 #ifndef poolmrg_h
 #define poolmrg_h
 
-#include "mpm.h"
+#include "mpmtypes.h"
 
 typedef struct MRGStruct *MRG;
 
 extern PoolClass PoolClassMRG(void);
 extern Res MRGRegister(Pool, Ref);
+extern Res MRGDeregister(Pool, Ref);
 
 #endif /* poolmrg_h */
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 7a9115eecd0..5bb92d5a799 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * **** RESTRICTION: This pool may not allocate from the arena control
  *                   pool, since it is used to implement that pool.
@@ -37,14 +38,7 @@ SRCID(poolmv, "$Id$");
 #define mvSpanPool(mv) MFSPool(&(mv)->spanPoolStruct)
 
 
-#define PoolPoolMV(pool) PARENT(MVStruct, poolStruct, pool)
-
-
-Pool (MVPool)(MV mv)
-{
-  AVERT(MV, mv);
-  return &mv->poolStruct;
-}
+#define Pool2MV(pool) PARENT(MVStruct, poolStruct, pool)
 
 
 /* MVDebug -- MV Debug pool class */
@@ -57,8 +51,8 @@ typedef struct MVDebugStruct {
 typedef MVDebugStruct *MVDebug;
 
 
-#define MVPoolMVDebug(mv)   PARENT(MVDebugStruct, MVStruct, mv)
-#define MVDebugPoolMV(mvd)  (&((mvd)->MVStruct))
+#define MV2MVDebug(mv)   PARENT(MVDebugStruct, MVStruct, mv)
+#define MVDebug2MV(mvd)  (&((mvd)->MVStruct))
 
 
 /* MVBlockStruct -- block structure
@@ -207,7 +201,7 @@ static Res MVInit(Pool pool, va_list arg)
   AVER(maxSize > 0);
   AVER(extendBy <= maxSize);
 
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   arena = PoolArena(pool);
 
   /* At 100% fragmentation we will need one block descriptor for every other */
@@ -255,7 +249,7 @@ static void MVFinish(Pool pool)
   MVSpan span;
 
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
 
   /* Destroy all the spans attached to the pool. */
@@ -477,7 +471,7 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
 
   AVER(pReturn != NULL);
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
   AVER(size > 0);
   AVERT(Bool, withReservoirPermit);
@@ -530,8 +524,10 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
       return res;
     }
   }
-
   limit = AddrAdd(base, regionSize);
+
+  DebugPoolFreeSplat(pool, base, limit);
+
   span->size = regionSize;
   span->tract = TractOfBaseAddr(arena, base);
   span->mv = mv;
@@ -551,7 +547,6 @@ static Res MVAlloc(Addr *pReturn, Pool pool, Size size,
   span->base.next = &span->limit;
   span->blocks = &span->base;
   span->blockCount = 2;
-
   span->base.limit = AddrAdd(span->base.limit, size);
   span->space -= size;
   span->largest = span->space;
@@ -581,7 +576,7 @@ static void MVFree(Pool pool, Addr old, Size size)
   Tract tract;
 
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
 
   AVER(old != (Addr)0);
@@ -632,10 +627,10 @@ static PoolDebugMixin MVDebugMixin(Pool pool)
   MV mv;
 
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
   /* Can't check MVDebug, because this is called during MVDebug init */
-  return &(MVPoolMVDebug(mv)->debug);
+  return &(MV2MVDebug(mv)->debug);
 }
 
 
@@ -650,7 +645,7 @@ static Res MVDescribe(Pool pool, mps_lib_FILE *stream)
   Ring spans, node = NULL, nextNode; /* gcc whinge stop */
 
   if(!CHECKT(Pool, pool)) return ResFAIL;
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   if(!CHECKT(MV, mv)) return ResFAIL;
   if(stream == NULL) return ResFAIL;
 
@@ -808,7 +803,7 @@ size_t mps_mv_free_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
 
   spans = &mv->spans;
@@ -834,7 +829,7 @@ size_t mps_mv_size(mps_pool_t mps_pool)
   pool = (Pool)mps_pool;
 
   AVERT(Pool, pool);
-  mv = PoolPoolMV(pool);
+  mv = Pool2MV(pool);
   AVERT(MV, mv);
   arena = PoolArena(pool);
 
diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h
index 1ad7607f0ae..bc930c76167 100644
--- a/mps/code/poolmv.h
+++ b/mps/code/poolmv.h
@@ -1,7 +1,8 @@
-/* .impl.h.poolmv: MANUAL VARIABLE POOL
+/* impl.h.poolmv: MANUAL VARIABLE POOL
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .purpose: This is the interface to the manual-variable pool class.
  *
@@ -49,8 +50,7 @@ extern PoolClass PoolClassMV(void);
 
 extern Bool MVCheck(MV mv);
 
-#define MVPool(mv) (&(mv)->poolStruct)
-extern Pool (MVPool)(MV mv);
+#define MV2Pool(mv) (&(mv)->poolStruct)
 
 
 #endif /* poolmv_h */
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 5706d2db7dd..00f064c1c08 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -1,7 +1,8 @@
-/* impl.c.poolmvff: First Fit Manual Variable Pool
+/* impl.c.poolmvff: Manual Variable First Fit Pool
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .purpose: This is a pool class for manually managed objects of
  * variable size where address-ordered first fit is an appropriate
@@ -53,8 +54,8 @@ typedef struct MVFFStruct {     /* MVFF pool outer structure */
 } MVFFStruct;
 
 
-#define PoolPoolMVFF(pool)   PARENT(MVFFStruct, poolStruct, pool)
-#define MVFFPool(mvff)       (&((mvff)->poolStruct))
+#define Pool2MVFF(pool)   PARENT(MVFFStruct, poolStruct, pool)
+#define MVFF2Pool(mvff)       (&((mvff)->poolStruct))
 #define CBSOfMVFF(mvff)      (&((mvff)->cbsStruct))
 #define MVFFOfCBS(cbs)       PARENT(MVFFStruct, cbsStruct, cbs)
 
@@ -71,8 +72,8 @@ typedef struct MVFFDebugStruct {
 typedef MVFFDebugStruct *MVFFDebug;
 
 
-#define MVFFPoolMVFFDebug(mvff) PARENT(MVFFDebugStruct, mvffStruct, mvff)
-#define MVFFDebugPoolMVFF(mvffd) (&((mvffd)->mvffStruct))
+#define MVFF2MVFFDebug(mvff) PARENT(MVFFDebugStruct, mvffStruct, mvff)
+#define MVFFDebug2MVFF(mvffd) (&((mvffd)->mvffStruct))
 
 
 /* MVFFAddToFreeList -- Add given range to free list
@@ -126,7 +127,7 @@ static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit)
   if (AddrOffset(base, limit) < mvff->minSegSize)
     return; /* not large enough for entire segments */
 
-  arena = PoolArena(MVFFPool(mvff));
+  arena = PoolArena(MVFF2Pool(mvff));
   b = SegOfAddr(&seg, arena, base);
   AVER(b);
 
@@ -143,13 +144,13 @@ static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit)
       mvff->total -= AddrOffset(segBase, segLimit);
       SegFree(seg);
     }
-   
+
     /* Avoid calling SegNext if the next segment would fail */
     /* the loop test, mainly because there might not be a */
     /* next segment. */
     if (segLimit == limit) /* segment ends at end of range */
       break;
-   
+
     b = SegNext(&seg, arena, segBase);
     AVER(b);
     segBase = SegBase(seg);
@@ -181,7 +182,7 @@ static Res MVFFAddSeg(Seg *segReturn,
   AVER(size > 0);
   AVER(BoolCheck(withReservoirPermit));
 
-  pool = MVFFPool(mvff);
+  pool = MVFF2Pool(mvff);
   arena = PoolArena(pool);
   align = ArenaAlign(arena);
 
@@ -211,6 +212,7 @@ static Res MVFFAddSeg(Seg *segReturn,
 
   mvff->total += segSize;
   base = SegBase(seg); limit = AddrAdd(base, segSize);
+  DebugPoolFreeSplat(pool, base, limit);
   MVFFAddToFreeList(&base, &limit, mvff);
   AVER(base <= SegBase(seg));
   if (mvff->minSegSize > segSize) mvff->minSegSize = segSize;
@@ -242,7 +244,7 @@ static Bool MVFFFindFirstFree(Addr *baseReturn, Addr *limitReturn,
   AVER(limitReturn != NULL);
   AVERT(MVFF, mvff);
   AVER(size > 0);
-  AVER(SizeIsAligned(size, PoolAlignment(MVFFPool(mvff))));
+  AVER(SizeIsAligned(size, PoolAlignment(MVFF2Pool(mvff))));
 
   findDelete = mvff->slotHigh ? CBSFindDeleteHIGH : CBSFindDeleteLOW;
 
@@ -268,7 +270,7 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
   Bool foundBlock;
 
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
   AVER(aReturn != NULL);
@@ -313,7 +315,7 @@ static void MVFFFree(Pool pool, Addr old, Size size)
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
   AVER(old != (Addr)0);
@@ -348,7 +350,7 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
   AVER(baseReturn != NULL);
   AVER(limitReturn != NULL);
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
   AVERT(Buffer, buffer);
   AVER(size > 0);
@@ -389,7 +391,7 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer,
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
   AVERT(Buffer, buffer);
   AVER(BufferIsReady(buffer));
@@ -436,7 +438,7 @@ static Res MVFFInit(Pool pool, va_list arg)
   AVER(BoolCheck(arenaHigh));
   AVER(BoolCheck(firstFit));
 
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   arena = PoolArena(pool);
 
   mvff->extendBy = extendBy;
@@ -452,7 +454,7 @@ static Res MVFFInit(Pool pool, va_list arg)
   res = ControlAlloc(&p, arena, sizeof(SegPrefStruct), FALSE);
   if (res != ResOK)
     return res;
- 
+
   mvff->segPref = (SegPref)p;
   *mvff->segPref = *SegPrefDefault();
   SegPrefExpress(mvff->segPref, arenaHigh ? SegPrefHigh : SegPrefLow, NULL);
@@ -463,14 +465,21 @@ static Res MVFFInit(Pool pool, va_list arg)
   mvff->total = 0;
   mvff->free = 0;
 
-  CBSInit(arena, CBSOfMVFF(mvff), (void *)mvff, NULL, NULL, NULL, NULL,
-          mvff->extendBy, align, TRUE, TRUE);
+  res = CBSInit(arena, CBSOfMVFF(mvff), (void *)mvff, NULL, NULL, NULL, NULL,
+                mvff->extendBy, align, TRUE, TRUE);
+
+  if (res != ResOK)
+    goto failInit;
 
   mvff->sig = MVFFSig;
   AVERT(MVFF, mvff);
   EVENT_PPWWWUUU(PoolInitMVFF, pool, arena, extendBy, avgSize, align,
                  slotHigh, arenaHigh, firstFit);
   return ResOK;
+
+failInit:
+  ControlFree(arena, p, sizeof(SegPrefStruct));
+  return res;
 }
 
 
@@ -484,7 +493,7 @@ static void MVFFFinish(Pool pool)
   Ring ring, node, nextNode;
 
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
   ring = PoolSegRing(pool);
@@ -493,7 +502,7 @@ static void MVFFFinish(Pool pool)
     AVER(SegPool(seg) == pool);
     SegFree(seg);
   }
- 
+
   /* Could maintain mvff->total here and check it falls to zero, */
   /* but that would just make the function slow.  If only we had */
   /* a way to do operations only if AVERs are turned on. */
@@ -514,10 +523,10 @@ static PoolDebugMixin MVFFDebugMixin(Pool pool)
   MVFF mvff;
 
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
   /* Can't check MVFFDebug, because this is called during init */
-  return &(MVFFPoolMVFFDebug(mvff)->debug);
+  return &(MVFF2MVFFDebug(mvff)->debug);
 }
 
 
@@ -529,7 +538,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
   MVFF mvff;
 
   if (!CHECKT(Pool, pool)) return ResFAIL;
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   if (!CHECKT(MVFF, mvff)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
@@ -551,7 +560,7 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
 
   res = WriteF(stream, "}\n", NULL);
 
-  return res;              
+  return res;
 }
 
 
@@ -613,9 +622,9 @@ size_t mps_mvff_free_size(mps_pool_t mps_pool)
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
- 
+
   return (size_t)mvff->free;
 }
 
@@ -628,7 +637,7 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
   return (size_t)mvff->total;
@@ -640,16 +649,16 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
 static Bool MVFFCheck(MVFF mvff)
 {
   CHECKS(MVFF, mvff);
-  CHECKD(Pool, MVFFPool(mvff));
-  CHECKL(IsSubclassPoly(MVFFPool(mvff)->class, MVFFPoolClassGet()));
+  CHECKD(Pool, MVFF2Pool(mvff));
+  CHECKL(IsSubclassPoly(MVFF2Pool(mvff)->class, MVFFPoolClassGet()));
   CHECKD(SegPref, mvff->segPref);
   CHECKL(mvff->extendBy > 0);                   /* see .arg.check */
-  CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFFPool(mvff))));
+  CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFF2Pool(mvff))));
   CHECKL(mvff->avgSize > 0);                    /* see .arg.check */
   CHECKL(mvff->avgSize <= mvff->extendBy);      /* see .arg.check */
   CHECKL(mvff->total >= mvff->free);
-  CHECKL(SizeIsAligned(mvff->free, PoolAlignment(MVFFPool(mvff))));
-  CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFFPool(mvff)))));
+  CHECKL(SizeIsAligned(mvff->free, PoolAlignment(MVFF2Pool(mvff))));
+  CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFF2Pool(mvff)))));
   CHECKD(CBS, CBSOfMVFF(mvff));
   CHECKL(BoolCheck(mvff->slotHigh));
   CHECKL(BoolCheck(mvff->firstFit));
@@ -673,7 +682,7 @@ void mps_mvff_stat(mps_pool_t mps_pool)
 
   pool = (Pool)mps_pool;
   AVERT(Pool, pool);
-  mvff = PoolPoolMVFF(pool);
+  mvff = Pool2MVFF(pool);
   AVERT(MVFF, mvff);
 
   METER_EMIT(&CBSOfMVFF(mvff)->splaySearch);
diff --git a/mps/code/poolncv.c b/mps/code/poolncv.c
index 6257a0a9db6..e26caad86b0 100644
--- a/mps/code/poolncv.c
+++ b/mps/code/poolncv.c
@@ -25,7 +25,7 @@ static Bool testit(ArenaClass class, ...)
 
   die(PoolCreate(&pool, arena, PoolClassN()), "PoolNCreate");
   res = PoolAlloc(&p, pool, 1, /* withReservoirPermit */ FALSE);
-  if(res == ResOK) {
+  if (res == ResOK) {
     fprintf(stderr,
             "Error:  Unexpectedly succeeded in"
             "allocating block from PoolN\n");
@@ -40,7 +40,7 @@ static Bool testit(ArenaClass class, ...)
 
 int main(void)
 {
-  if(testit((ArenaClass)mps_arena_class_vm(), (Size)200000)) {
+  if (testit((ArenaClass)mps_arena_class_vm(), (Size)600000)) {
     fprintf(stderr, "Conclusion:  Defects found.\n");
   } else {
     fprintf(stderr, "Conclusion:  Failed to find any defects.\n");
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index a954639f07e..f3e81ca242a 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -21,7 +21,6 @@
 #include "mpscsnc.h"
 #include "mpm.h"
 
-
 SRCID(poolsnc, "$Id$");
 
 
diff --git a/mps/code/proddw.bat b/mps/code/proddw.bat
deleted file mode 100644
index 9318e5b55c5..00000000000
--- a/mps/code/proddw.bat
+++ /dev/null
@@ -1,41 +0,0 @@
-@rem impl.bat.proddw
-@rem Script that automates building and collating a dylan product
-rem $Id$
-rem Copyright (c) 2001 Ravenbrook Limited.
-nmake /f w3i3mv.nmk VARIETY=ci mmdw.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=hi mmdw.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=he mmdw.lib mpsplan.lib
-nmake /f w3i3mv.nmk VARIETY=wi mmdw.lib mpsplan.lib
-rmdir /Q/S dylan
-mkdir dylan
-mkdir dylan\mps
-mkdir dylan\mps\include
-mkdir dylan\mps\lib
-mkdir dylan\mps\lib\w3i3
-mkdir dylan\mps\lib\w3i3\ci
-mkdir dylan\mps\lib\w3i3\hi
-mkdir dylan\mps\lib\w3i3\he
-mkdir dylan\mps\lib\w3i3\wi
-mkdir dylan\mps\src
-copy mps.h dylan\mps\include
-copy mpsavm.h dylan\mps\include
-copy mpscamc.h dylan\mps\include
-copy mpscawl.h dylan\mps\include
-copy mpsclo.h dylan\mps\include
-copy mpscsnc.h dylan\mps\include
-copy mpscmv.h dylan\mps\include
-copy mpsio.h dylan\mps\include
-copy mpslib.h dylan\mps\include
-copy mpstd.h dylan\mps\include
-copy mpsw3.h dylan\mps\include
-copy mpswin.h dylan\mps\include
-copy w3i3mv\ci\mmdw.lib dylan\mps\lib\w3i3\ci
-copy w3i3mv\hi\mmdw.lib dylan\mps\lib\w3i3\hi
-copy w3i3mv\he\mmdw.lib dylan\mps\lib\w3i3\he
-copy w3i3mv\wi\mmdw.lib dylan\mps\lib\w3i3\wi
-copy w3i3mv\ci\mpsplan.lib dylan\mps\lib\w3i3\ci
-copy w3i3mv\hi\mpsplan.lib dylan\mps\lib\w3i3\hi
-copy w3i3mv\he\mpsplan.lib dylan\mps\lib\w3i3\he
-copy w3i3mv\wi\mpsplan.lib dylan\mps\lib\w3i3\wi
-copy mpsliban.c dylan\mps\src
-copy mpsioan.c dylan\mps\src
diff --git a/mps/code/protli.c b/mps/code/protli.c
index c6b283f961c..fa4192dd8b6 100644
--- a/mps/code/protli.c
+++ b/mps/code/protli.c
@@ -2,7 +2,6 @@
  *
  *  $Id$
  *  Copyright (c) 2001 Ravenbrook Limited.
- *
  */
 
 #include "mpm.h"
diff --git a/mps/code/protocol.c b/mps/code/protocol.c
index ead6730c01a..aa83001d7a4 100644
--- a/mps/code/protocol.c
+++ b/mps/code/protocol.c
@@ -10,7 +10,6 @@
 
 #include "mpm.h"
 
-
 SRCID(protocol, "$Id$");
 
 
diff --git a/mps/code/protso.c b/mps/code/protso.c
index 1628fde99f3..467b0460c7b 100644
--- a/mps/code/protso.c
+++ b/mps/code/protso.c
@@ -2,7 +2,6 @@
  *
  *  $Id$
  *  Copyright (c) 2001 Ravenbrook Limited.
- *
  */
 
 #include "mpm.h"
diff --git a/mps/code/reserv.c b/mps/code/reserv.c
index 72d52241aa9..e8060a43a14 100644
--- a/mps/code/reserv.c
+++ b/mps/code/reserv.c
@@ -347,7 +347,7 @@ void ReservoirSetLimit(Reservoir reservoir, Size size)
   if (needed > reservoir->reservoirSize) {
     /* Try to grow the reservoir */
     reservoir->reservoirLimit = needed;
-    ReservoirEnsureFull(reservoir);
+    (void)ReservoirEnsureFull(reservoir);
   } else {
     /* Shrink the reservoir */
     reservoirShrink(reservoir, needed);
@@ -372,7 +372,7 @@ Size ReservoirLimit(Reservoir reservoir)
 Size ReservoirAvailable(Reservoir reservoir)
 {
   AVERT(Reservoir, reservoir);
-  ReservoirEnsureFull(reservoir);
+  (void)ReservoirEnsureFull(reservoir);
   return reservoir->reservoirSize;
 }
 
diff --git a/mps/code/ring.c b/mps/code/ring.c
index 4bd6e924c21..9eae9aa00bd 100644
--- a/mps/code/ring.c
+++ b/mps/code/ring.c
@@ -16,7 +16,6 @@
 #include "check.h"
 #include "misc.h"
 
-
 SRCID(ring, "$Id$");
 
 
diff --git a/mps/code/ring.h b/mps/code/ring.h
index feb61e5d276..6821355fcd7 100644
--- a/mps/code/ring.h
+++ b/mps/code/ring.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
  */
 
 
@@ -96,7 +97,7 @@ extern Ring (RingNext)(Ring ring);
 
 /* .ring.elt: See design.mps.ring.elt */
 #define RING_ELT(type, field, node) \
-   ((type)((char *)(node) - (size_t)(&((type)0)->field)))
+   ((type)(void *)((char *)(node) - (size_t)(&((type)0)->field)))
 
 /* .ring.for: See design.mps.ring.for */
 #define RING_FOR(node, ring, next) \
diff --git a/mps/code/sacss.c b/mps/code/sacss.c
index dda4199bd54..56ed1649565 100644
--- a/mps/code/sacss.c
+++ b/mps/code/sacss.c
@@ -2,9 +2,9 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  */
 
-
 #include "mpscmv.h"
 #include "mpscmvff.h"
 #include "mpslib.h"
@@ -37,6 +37,8 @@ struct itimerspec; /* stop complaints from time.h */
 #define classCOUNT 4
 
 
+/* make -- allocate an object */
+
 static mps_res_t make(mps_addr_t *p, mps_sac_t sac, size_t size)
 {
   mps_res_t res;
@@ -46,9 +48,11 @@ static mps_res_t make(mps_addr_t *p, mps_sac_t sac, size_t size)
 }
 
 
-static mps_res_t stress(mps_class_t class, mps_arena_t arena,
+/* stress -- create a pool of the requested type and allocate in it */
+
+static mps_res_t stress(mps_class_t class,
                         size_t classes_count, mps_sac_classes_s *classes,
-                        size_t (*size)(int i), ...)
+                        size_t (*size)(int i), mps_arena_t arena, ...)
 {
   mps_res_t res;
   mps_pool_t pool;
@@ -58,7 +62,7 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
   int *ps[testSetSIZE];
   size_t ss[testSetSIZE];
 
-  va_start(arg, size);
+  va_start(arg, arena);
   res = mps_pool_create_v(&pool, arena, class, arg);
   va_end(arg);
   if (res != MPS_RES_OK)
@@ -129,6 +133,8 @@ static mps_res_t stress(mps_class_t class, mps_arena_t arena,
 #define max(a, b) (((a) > (b)) ? (a) : (b))
 
 
+/* randomSize8 -- produce sizes both latge and small */
+
 static size_t randomSize8(int i)
 {
   size_t maxSize = 2 * 160 * 0x2000;
@@ -140,7 +146,10 @@ static size_t randomSize8(int i)
 }
 
 
-static mps_pool_debug_option_s debugOptions = { (void *)"postpost", 8 };
+/* testInArena -- test all the pool classes in the given arena */
+
+static mps_pool_debug_option_s debugOptions =
+  { (void *)"postpost", 8, NULL, 0 };
 
 static mps_sac_classes_s classes[4] = { {8, 1, 1}, {16, 1, 2}, {136, 9, 5},
                                         {topClassSIZE, 9, 4} };
@@ -148,15 +157,15 @@ static mps_sac_classes_s classes[4] = { {8, 1, 1}, {16, 1, 2}, {136, 9, 5},
 static int testInArena(mps_arena_t arena)
 {
   printf("MVFF\n\n");
-  die(stress(mps_class_mvff(), arena, classCOUNT, classes, randomSize8,
+  die(stress(mps_class_mvff(), classCOUNT, classes, randomSize8, arena,
              (size_t)65536, (size_t)32, (size_t)4, TRUE, TRUE, TRUE),
       "stress MVFF");
   printf("MV debug\n\n");
-  die(stress(mps_class_mv_debug(), arena, classCOUNT, classes, randomSize8,
+  die(stress(mps_class_mv_debug(), classCOUNT, classes, randomSize8, arena,
              &debugOptions, (size_t)65536, (size_t)32, (size_t)65536),
       "stress MV debug");
   printf("MV\n\n");
-  die(stress(mps_class_mv(), arena, classCOUNT, classes, randomSize8,
+  die(stress(mps_class_mv(), classCOUNT, classes, randomSize8, arena,
              (size_t)65536, (size_t)32, (size_t)65536),
       "stress MV");
   return 0;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 95e8110bb6d..14839e2a6cb 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -637,7 +637,7 @@ Bool SegCheck(Seg seg)
 
   /* Each tract of the segment must agree about white traces */
   TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) {
-    Seg trseg;
+    Seg trseg = NULL; /* suppress compiler warning */
 
     UNUSED(trseg); /* @@@@ unused in hot varieties */
     CHECKL(TractCheck(tract));  /* design.mps.check.type.no-sig */
@@ -1241,9 +1241,9 @@ static void gcSegSetWhite(Seg seg, TraceSet white)
   limit = SegLimit(seg);
   /* Each tract of the segment records white traces */
   TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, limit) {
-    Seg trseg;
+    Seg trseg = NULL; /* suppress compiler warning */
 
-    UNUSED(trseg); /* @@@@ hack: unused in hot varieties */
+    UNUSED(trseg); /* @@@@ unused in hot varieties */
     AVER_CRITICAL(TractCheck(tract));  /* design.mps.check.type.no-sig */
     AVER_CRITICAL(TRACT_SEG(&trseg, tract) && (trseg == seg));
     TractSetWhite(tract, white);
diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c
index 590195a193c..bb8222d0738 100644
--- a/mps/code/segsmss.c
+++ b/mps/code/segsmss.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * .design: Adapted from amsss.c (because AMS already supports
  * a protocol for subclassing AMS segments). Defines a new pool
@@ -343,7 +344,7 @@ static Res AMSTInit(Pool pool, va_list args)
   res = ChainCreate(&chain, pool->arena, 1, &genParam);
   if (res != ResOK)
     return res;
-  res = AMSInitInternal(Pool2AMS(pool), format, chain);
+  res = AMSInitInternal(Pool2AMS(pool), format, chain, FALSE);
   if (res != ResOK)
     return res;
   amst = Pool2AMST(pool);
@@ -704,6 +705,8 @@ static mps_class_t mps_class_amst(void)
 }
 
 
+/* AMS collection parameters */
+
 #define exactRootsCOUNT 50
 #define ambigRootsCOUNT 100
 #define sizeScale       4
@@ -717,6 +720,8 @@ static mps_class_t mps_class_amst(void)
 #define stressTestFREQ  40
 
 
+/* static variables for the test */
+
 static mps_pool_t pool;
 static mps_ap_t ap;
 static mps_addr_t exactRoots[exactRootsCOUNT];
@@ -724,6 +729,8 @@ static mps_addr_t ambigRoots[ambigRootsCOUNT];
 static size_t totalSize = 0;
 
 
+/* make -- object allocation and init */
+
 static mps_addr_t make(void)
 {
   size_t length = rnd() % 20, size = (length+2) * sizeof(mps_word_t);
@@ -744,6 +751,8 @@ static mps_addr_t make(void)
 }
 
 
+/* test -- the actual stress test */
+
 static void *test(void *arg, size_t s)
 {
   mps_arena_t arena;
diff --git a/mps/code/spi3.asm b/mps/code/spi3.asm
deleted file mode 100644
index b19c5b1d45f..00000000000
--- a/mps/code/spi3.asm
+++ /dev/null
@@ -1,27 +0,0 @@
-;  impl.asm.spi3: STACK PROBE
-;
-;  $Id$
-;  Copyright (c) 2001 Ravenbrook Limited.
-;
-;  This function reads a location that is probeDepth words beyond
-;  the current stack pointer.  On intel platforms the stack grows
-;  downwards so this means reading from a location with a lesser address.
-;
-;  The registers edi, esi, ebx are the registers defined to be preserved
-;  across function calls, so we do not use those.
-
-.386
-.model flat
-.code
-
-_StackProbe proc public ; (Size probeDepth)
-  push ebp              ; frame pointer
-  mov  ebp,esp
-  mov  eax, [ebp+08]
-  neg  eax
-  mov  eax, [esp+eax*4]   ; do the actual probe
-  leave
-  ret                   ; return
-_StackProbe endp
-
-end
diff --git a/mps/code/spi3.c b/mps/code/spi3.c
new file mode 100644
index 00000000000..72554d3f6ea
--- /dev/null
+++ b/mps/code/spi3.c
@@ -0,0 +1,24 @@
+/*  impl.c.spi3: STACK PROBE
+ *
+ * $Id: spi3.c,v 1.2 2002/02/01 13:56:52 pekka Exp $
+ * $HopeName: MMsrc!spi3.c(trunk.2) $
+ * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2001 Global Graphics Software.
+ *
+ *  This function reads a location that is probeDepth words beyond
+ *  the current stack pointer.  On intel platforms the stack grows
+ *  downwards so this means reading from a location with a lesser address.
+ */
+
+
+#include "mpm.h"
+
+
+void StackProbe(Size depth)
+{
+  __asm {
+    mov  eax, depth
+    neg  eax
+    mov  eax, [esp+eax*4] /* do the actual probe */
+  }
+}
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 4d30a062de1..ba1057115ba 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -17,10 +17,11 @@
 #include "splay.h"
 #include "mpm.h"
 
-
 SRCID(splay, "$Id$");
 
+
 /* Basic getter and setter methods */
+
 #define SplayTreeRoot(t) RVALUE((t)->root)
 #define SplayTreeSetRoot(t, r) BEGIN ((t)->root = (r)); END
 #define SplayNodeLeftChild(n) RVALUE((n)->left)
@@ -30,9 +31,11 @@ SRCID(splay, "$Id$");
 #define SplayNodeSetRightChild(n, child) \
   BEGIN ((n)->right = (child)); END
 
+
 #define SplayCompare(tree, key, node) \
   (((tree)->compare)((key), (node)))
 
+
 Bool SplayTreeCheck(SplayTree tree)
 {
   UNUSED(tree);
@@ -42,6 +45,7 @@ Bool SplayTreeCheck(SplayTree tree)
   return TRUE;
 }
 
+
 Bool SplayNodeCheck(SplayNode node)
 {
   UNUSED(node);
@@ -64,6 +68,7 @@ void SplayTreeInit(SplayTree tree, SplayCompareMethod compare,
   AVERT(SplayTree, tree);
 }
 
+
 void SplayNodeInit(SplayNode node)
 {
   AVER(node != NULL);
@@ -75,6 +80,7 @@ void SplayNodeInit(SplayNode node)
   AVERT(SplayNode, node);
 }
 
+
 void SplayNodeFinish(SplayNode node)
 {
   AVERT(SplayNode, node);
@@ -84,6 +90,7 @@ void SplayNodeFinish(SplayNode node)
   SplayNodeSetRightChild(node, NULL);
 }
 
+
 void SplayTreeFinish(SplayTree tree)
 {
   AVERT(SplayTree, tree);
@@ -91,6 +98,7 @@ void SplayTreeFinish(SplayTree tree)
   tree->compare = NULL;
 }
 
+
 static void SplayNodeUpdate(SplayTree tree, SplayNode node)
 {
   AVERT(SplayTree, tree);
@@ -130,6 +138,7 @@ static void SplayLinkRight(SplayNode *topIO, SplayNode *rightIO)
   SplayNodeSetLeftChild(*rightIO, NULL);
 }
 
+
 /* SplayLinkLeft -- Move top to right child of top
  *
  * Link the current top node into the right child of the left tree,
@@ -156,6 +165,7 @@ static void SplayLinkLeft(SplayNode *topIO, SplayNode *leftIO) {
   SplayNodeSetRightChild(*leftIO, NULL);
 }
 
+
 /* SplayRotateLeft -- Rotate right child edge of node
  *
  * Rotates node, right child of node, and left child of right
@@ -177,7 +187,7 @@ static void SplayRotateLeft(SplayNode *nodeIO, SplayTree tree) {
   SplayNodeSetLeftChild(nodeRight, *nodeIO);
   *nodeIO = nodeRight;
 
-  if(tree->updateNode != NULL) {
+  if (tree->updateNode != NULL) {
     SplayNodeUpdate(tree, SplayNodeLeftChild(nodeRight));
     /* Don't need to update new root because we know that we will */
     /* do either a link or an assemble next, and that will sort it */
@@ -187,6 +197,7 @@ static void SplayRotateLeft(SplayNode *nodeIO, SplayTree tree) {
   return;
 }
 
+
 /* SplayRotateRight -- Rotate left child edge of node
  *
  * Rotates node, left child of node, and right child of left
@@ -208,7 +219,7 @@ static void SplayRotateRight(SplayNode *nodeIO, SplayTree tree) {
   SplayNodeSetRightChild(nodeLeft, *nodeIO);
   *nodeIO = nodeLeft;
 
-  if(tree->updateNode != NULL) {
+  if (tree->updateNode != NULL) {
     SplayNodeUpdate(tree, SplayNodeRightChild(nodeLeft));
     /* Don't need to update new root because we know that we will */
     /* do either a link or an assemble next, and that will sort it */
@@ -218,6 +229,7 @@ static void SplayRotateRight(SplayNode *nodeIO, SplayTree tree) {
   return;
 }
 
+
 /* SplayAssemble -- Assemble left right and top trees into one
  *
  * We do this by moving the children of the top tree to the last and
@@ -241,11 +253,11 @@ static void SplayAssemble(SplayTree tree, SplayNode top,
   AVER(rightTop == NULL ||
        (SplayNodeCheck(rightTop) && SplayNodeCheck(rightFirst)));
 
-  if(leftTop != NULL) {
+  if (leftTop != NULL) {
     SplayNodeSetRightChild(leftLast, SplayNodeLeftChild(top));
     SplayNodeSetLeftChild(top, leftTop);
 
-    if(tree->updateNode != NULL) {
+    if (tree->updateNode != NULL) {
       /* Update client property using pointer reversal (Ugh!). */
       SplayNode node, parent, rightChild;
 
@@ -274,11 +286,11 @@ static void SplayAssemble(SplayTree tree, SplayNode top,
   }
   /* otherwise leave top->left alone */
 
-  if(rightTop != NULL) {
+  if (rightTop != NULL) {
     SplayNodeSetLeftChild(rightFirst, SplayNodeRightChild(top));
     SplayNodeSetRightChild(top, rightTop);
 
-    if(tree->updateNode != NULL) {
+    if (tree->updateNode != NULL) {
       /* Update client property using pointer reversal (Ugh!). */
       SplayNode node, parent, leftChild;
 
@@ -307,10 +319,11 @@ static void SplayAssemble(SplayTree tree, SplayNode top,
   }
   /* otherwise leave top->right alone */
 
-  if(tree->updateNode != NULL)
+  if (tree->updateNode != NULL)
     SplayNodeUpdate(tree, top);
 }
 
+
 /* SplaySplay -- Splay the tree (top-down) around a given key
  *
  * If the key is not found, splays around an arbitrary neighbour.
@@ -324,7 +337,7 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
                        void *key, SplayCompareMethod compareMethod) {
   /* The sides structure avoids a boundary case in SplayLink* */
   SplayNodeStruct sides; /* rightTop and leftTop */
-  SplayNode top, leftLast, rightFirst; 
+  SplayNode top, leftLast, rightFirst;
   Bool found;
   Compare compareTop;
 
@@ -334,14 +347,14 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
 
   top = SplayTreeRoot(tree); /* will be copied back at end */
 
-  if(top == NULL) {
+  if (top == NULL) {
     *nodeReturn = NULL;
     return FALSE;
   }
-   
+
   /* short-circuit case where node is already top */
   compareTop = (*compareMethod)(key, top);
-  if(compareTop == CompareEQUAL) {
+  if (compareTop == CompareEQUAL) {
     *nodeReturn = top;
     return TRUE;
   }
@@ -356,7 +369,7 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
 
     case CompareLESS: {
       SplayNode topLeft = SplayNodeLeftChild(top);
-      if(topLeft == NULL) {
+      if (topLeft == NULL) {
         found = FALSE;
         goto assemble;
       } else {
@@ -371,14 +384,14 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
         } /* break; */
 
         case CompareLESS: {                  /* zig-zig */
-          if(SplayNodeLeftChild(topLeft) == NULL)
+          if (SplayNodeLeftChild(topLeft) == NULL)
             goto terminalZig;
           SplayRotateRight(&top, tree);
           SplayLinkRight(&top, &rightFirst);
         } break;
 
         case CompareGREATER: {               /* zig-zag */
-          if(SplayNodeRightChild(topLeft) == NULL)
+          if (SplayNodeRightChild(topLeft) == NULL)
             goto terminalZig;
           SplayLinkRight(&top, &rightFirst);
           SplayLinkLeft(&top, &leftLast);
@@ -393,7 +406,7 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
 
     case CompareGREATER: {
       SplayNode topRight = SplayNodeRightChild(top);
-      if(topRight == NULL) {
+      if (topRight == NULL) {
         found = FALSE;
         goto assemble;
       } else {
@@ -408,14 +421,14 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
         } /* break; */
 
         case CompareGREATER: {               /* zag-zag */
-          if(SplayNodeRightChild(topRight) == NULL)
+          if (SplayNodeRightChild(topRight) == NULL)
             goto terminalZag;
           SplayRotateLeft(&top, tree);
           SplayLinkLeft(&top, &leftLast);
         } break;
 
         case CompareLESS: {                  /* zag-zig */
-          if(SplayNodeLeftChild(topRight) == NULL)
+          if (SplayNodeLeftChild(topRight) == NULL)
             goto terminalZag;
           SplayLinkLeft(&top, &leftLast);
           SplayLinkRight(&top, &rightFirst);
@@ -439,7 +452,7 @@ static Bool SplaySplay(SplayNode *nodeReturn, SplayTree tree,
     }
     compareTop = (*compareMethod)(key, top);
   } /* end while(TRUE) */
-     
+
 terminalZig:
   SplayLinkRight(&top, &rightFirst);
   found = FALSE;
@@ -476,9 +489,9 @@ Res SplayTreeInsert(SplayTree tree, SplayNode node, void *key) {
   AVER(SplayNodeLeftChild(node) == NULL);
   AVER(SplayNodeRightChild(node) == NULL);
 
-  if(SplayTreeRoot(tree) == NULL) {
+  if (SplayTreeRoot(tree) == NULL) {
     SplayTreeSetRoot(tree, node);
-  } else if(SplaySplay(&neighbour, tree, key, tree->compare)) {
+  } else if (SplaySplay(&neighbour, tree, key, tree->compare)) {
     return ResFAIL;
   } else {
     AVER(SplayTreeRoot(tree) == neighbour);
@@ -504,7 +517,7 @@ Res SplayTreeInsert(SplayTree tree, SplayNode node, void *key) {
     } break;
     }
 
-    if(tree->updateNode != NULL) {
+    if (tree->updateNode != NULL) {
       SplayNodeUpdate(tree, neighbour);
       SplayNodeUpdate(tree, node);
     }
@@ -530,21 +543,21 @@ Res SplayTreeDelete(SplayTree tree, SplayNode node, void *key) {
   found = SplaySplay(&del, tree, key, tree->compare);
   AVER(!found || del == node);
 
-  if(!found) {
+  if (!found) {
     return ResFAIL;
-  } else if(SplayNodeLeftChild(node) == NULL) {
+  } else if (SplayNodeLeftChild(node) == NULL) {
     SplayTreeSetRoot(tree, SplayNodeRightChild(node));
-  } else if(SplayNodeRightChild(node) == NULL) {
+  } else if (SplayNodeRightChild(node) == NULL) {
     SplayTreeSetRoot(tree, SplayNodeLeftChild(node));
   } else {
     rightHalf = SplayNodeRightChild(node);
     SplayTreeSetRoot(tree, SplayNodeLeftChild(node));
-    if(SplaySplay(&leftLast, tree, key, tree->compare)) {
+    if (SplaySplay(&leftLast, tree, key, tree->compare)) {
       return ResFAIL;
     } else {
       AVER(SplayNodeRightChild(leftLast) == NULL);
       SplayNodeSetRightChild(leftLast, rightHalf);
-      if(tree->updateNode != NULL) {
+      if (tree->updateNode != NULL) {
         SplayNodeUpdate(tree, leftLast);
       }
     }
@@ -562,14 +575,13 @@ Res SplayTreeDelete(SplayTree tree, SplayNode node, void *key) {
  * design.mps.splay.impl.search.
  */
 
-
 Res SplayTreeSearch(SplayNode *nodeReturn, SplayTree tree, void *key) {
   SplayNode node;
 
   AVERT(SplayTree, tree);
   AVER(nodeReturn != NULL);
 
-  if(SplaySplay(&node, tree, key, tree->compare)) {
+  if (SplaySplay(&node, tree, key, tree->compare)) {
     *nodeReturn = node;
   } else {
     return ResFAIL;
@@ -593,20 +605,20 @@ static SplayNode SplayTreePredecessor(SplayTree tree, void *key) {
   oldRoot = SplayTreeRoot(tree);
   AVERT(SplayNode, oldRoot);
 
-  if(SplayNodeLeftChild(oldRoot) == NULL) {
+  if (SplayNodeLeftChild(oldRoot) == NULL) {
     newRoot = NULL; /* No predecessor */
   } else {
     /* temporarily chop off the right half-tree, inclusive of root */
     SplayTreeSetRoot(tree, SplayNodeLeftChild(oldRoot));
     SplayNodeSetLeftChild(oldRoot, NULL);
-    if(SplaySplay(&newRoot, tree, key, tree->compare)) {
+    if (SplaySplay(&newRoot, tree, key, tree->compare)) {
       NOTREACHED; /* Another matching node found */
     } else {
       AVER(SplayNodeRightChild(newRoot) == NULL);
       SplayNodeSetRightChild(newRoot, oldRoot);
     }
 
-    if(tree->updateNode != NULL) {
+    if (tree->updateNode != NULL) {
       SplayNodeUpdate(tree, oldRoot);
       SplayNodeUpdate(tree, newRoot);
     }
@@ -630,20 +642,20 @@ static SplayNode SplayTreeSuccessor(SplayTree tree, void *key) {
   oldRoot = SplayTreeRoot(tree);
   AVERT(SplayNode, oldRoot);
 
-  if(SplayNodeRightChild(oldRoot) == NULL) {
+  if (SplayNodeRightChild(oldRoot) == NULL) {
     newRoot = NULL; /* No successor */
   } else {
     /* temporarily chop off the left half-tree, inclusive of root */
     SplayTreeSetRoot(tree, SplayNodeRightChild(oldRoot));
     SplayNodeSetRightChild(oldRoot, NULL);
-    if(SplaySplay(&newRoot, tree, key, tree->compare)) {
+    if (SplaySplay(&newRoot, tree, key, tree->compare)) {
       NOTREACHED; /* Another matching node found */
     } else {
       AVER(SplayNodeLeftChild(newRoot) == NULL);
       SplayNodeSetLeftChild(newRoot, oldRoot);
     }
 
-    if(tree->updateNode != NULL) {
+    if (tree->updateNode != NULL) {
       SplayNodeUpdate(tree, oldRoot);
       SplayNodeUpdate(tree, newRoot);
     }
@@ -670,9 +682,9 @@ Res SplayTreeNeighbours(SplayNode *leftReturn, SplayNode *rightReturn,
   AVER(leftReturn != NULL);
   AVER(rightReturn != NULL);
 
-  if(SplaySplay(&neighbour, tree, key, tree->compare)) {
+  if (SplaySplay(&neighbour, tree, key, tree->compare)) {
     return ResFAIL;
-  } else if(neighbour == NULL) {
+  } else if (neighbour == NULL) {
     *leftReturn = *rightReturn = NULL;
   } else {
     switch(SplayCompare(tree, key, neighbour)) {
@@ -700,7 +712,7 @@ Res SplayTreeNeighbours(SplayNode *leftReturn, SplayNode *rightReturn,
 /* SplayTreeFirst, SplayTreeNext -- Iterators
  *
  * SplayTreeFirst receives a key that must precede all
- * nodes in the tree.  It returns NULL if the tree is empty. 
+ * nodes in the tree.  It returns NULL if the tree is empty.
  * Otherwise, it splays the tree to the first node, and returns the
  * new root.  See design.mps.splay.function.splay.tree.first.
  *
@@ -714,9 +726,9 @@ SplayNode SplayTreeFirst(SplayTree tree, void *zeroKey) {
   SplayNode node;
   AVERT(SplayTree, tree);
 
-  if(SplayTreeRoot(tree) == NULL) {
+  if (SplayTreeRoot(tree) == NULL) {
     node = NULL;
-  } else if(SplaySplay(&node, tree, zeroKey, tree->compare)) {
+  } else if (SplaySplay(&node, tree, zeroKey, tree->compare)) {
     NOTREACHED;
   } else {
     AVER(SplayNodeLeftChild(node) == NULL);
@@ -751,44 +763,40 @@ static Res SplayNodeDescribe(SplayNode node, mps_lib_FILE *stream,
                              SplayNodeDescribeMethod nodeDescribe) {
   Res res;
 
-  AVERT(SplayNode, node);
+#if defined(CHECK)
+  if (!SplayNodeCheck(node)) return ResFAIL;
   /* stream and nodeDescribe checked by SplayTreeDescribe */
+#endif
 
   res = WriteF(stream, "( ", NULL);
-  if(res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
-  if(SplayNodeLeftChild(node) != NULL) {
+  if (SplayNodeLeftChild(node) != NULL) {
     res = SplayNodeDescribe(SplayNodeLeftChild(node), stream, nodeDescribe);
-    if(res != ResOK)
-      return res;
+    if (res != ResOK) return res;
 
     res = WriteF(stream, " / ", NULL);
-    if(res != ResOK)
-      return res;
+    if (res != ResOK) return res;
   }
 
   res = (*nodeDescribe)(node, stream);
-  if(res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
-  if(SplayNodeRightChild(node) != NULL) {
+  if (SplayNodeRightChild(node) != NULL) {
     res = WriteF(stream, " \\ ", NULL);
-    if(res != ResOK)
-      return res;
+    if (res != ResOK) return res;
 
     res = SplayNodeDescribe(SplayNodeRightChild(node), stream, nodeDescribe);
-    if(res != ResOK)
-      return res;
+    if (res != ResOK) return res;
   }
 
   res = WriteF(stream, " )", NULL);
-  if(res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
   return ResOK;
 }
 
+
 typedef struct {
   SplayTestNodeMethod testNode;
   SplayTestTreeMethod testTree;
@@ -816,10 +824,10 @@ static Compare SplayFindFirstCompare(void *key, SplayNode node)
   testTree = closure->testTree;
   tree = closure->tree;
 
-  if(SplayNodeLeftChild(node) != NULL &&
+  if (SplayNodeLeftChild(node) != NULL &&
      (*testTree)(tree, SplayNodeLeftChild(node), closureP, closureS)) {
     return CompareLESS;
-  } else if((*testNode)(tree, node, closureP, closureS)) {
+  } else if ((*testNode)(tree, node, closureP, closureS)) {
     return CompareEQUAL;
   } else {
     AVER(SplayNodeRightChild(node) != NULL &&
@@ -847,10 +855,10 @@ static Compare SplayFindLastCompare(void *key, SplayNode node)
   testTree = closure->testTree;
   tree = closure->tree;
 
-  if(SplayNodeRightChild(node) != NULL &&
+  if (SplayNodeRightChild(node) != NULL &&
      (*testTree)(tree, SplayNodeRightChild(node), closureP, closureS)) {
      return CompareGREATER;
-  } else if((*testNode)(tree, node, closureP, closureS)) {
+  } else if ((*testNode)(tree, node, closureP, closureS)) {
     return CompareEQUAL;
   } else {
     AVER(SplayNodeLeftChild(node) != NULL &&
@@ -887,7 +895,7 @@ Bool SplayFindFirst(SplayNode *nodeReturn, SplayTree tree,
 
   node = SplayTreeRoot(tree);
 
-  if(node == NULL || !(*testTree)(tree, node, closureP, closureS))
+  if (node == NULL || !(*testTree)(tree, node, closureP, closureS))
     return FALSE; /* no suitable nodes in tree */
 
   closureStruct.p = closureP;
@@ -896,8 +904,8 @@ Bool SplayFindFirst(SplayNode *nodeReturn, SplayTree tree,
   closureStruct.testTree = testTree;
   closureStruct.tree = tree;
 
-  if(SplaySplay(&node, tree, (void *)&closureStruct,
-    &SplayFindFirstCompare)) {
+  if (SplaySplay(&node, tree, (void *)&closureStruct,
+                 &SplayFindFirstCompare)) {
     *nodeReturn = node;
     return TRUE;
   } else {
@@ -923,7 +931,7 @@ Bool SplayFindLast(SplayNode *nodeReturn, SplayTree tree,
 
   node = SplayTreeRoot(tree);
 
-  if(node == NULL || !(*testTree)(tree, node, closureP, closureS))
+  if (node == NULL || !(*testTree)(tree, node, closureP, closureS))
     return FALSE; /* no suitable nodes in tree */
 
   closureStruct.p = closureP;
@@ -932,8 +940,8 @@ Bool SplayFindLast(SplayNode *nodeReturn, SplayTree tree,
   closureStruct.testTree = testTree;
   closureStruct.tree = tree;
 
-  if(SplaySplay(&node, tree, (void *)&closureStruct,
-    &SplayFindLastCompare)) {
+  if (SplaySplay(&node, tree, (void *)&closureStruct,
+                 &SplayFindLastCompare)) {
     *nodeReturn = node;
     return TRUE;
   } else {
@@ -952,7 +960,7 @@ Bool SplayRoot(SplayNode *nodeReturn, SplayTree tree)
   AVERT(SplayTree, tree);
 
   node = SplayTreeRoot(tree);
-  if(node == NULL)
+  if (node == NULL)
     return FALSE;
   else {
     *nodeReturn = node;
@@ -997,21 +1005,21 @@ Res SplayTreeDescribe(SplayTree tree, mps_lib_FILE *stream,
                       SplayNodeDescribeMethod nodeDescribe) {
   Res res;
 
-  if(!SplayTreeCheck(tree)) return ResFAIL;
-  if(stream == NULL) return ResFAIL;
-  if(!FUNCHECK(nodeDescribe)) return ResFAIL;
+#if defined(CHECK)
+  if (!SplayTreeCheck(tree)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+  if (!FUNCHECK(nodeDescribe)) return ResFAIL;
+#endif
 
   res = WriteF(stream,
                "Splay $P {\n", (WriteFP)tree,
                "  compare $F\n", (WriteFF)tree->compare,
                NULL);
-  if(res != ResOK)
-    return res;
+  if (res != ResOK) return res;
 
-  if(SplayTreeRoot(tree) != NULL) {
+  if (SplayTreeRoot(tree) != NULL) {
     res = SplayNodeDescribe(SplayTreeRoot(tree), stream, nodeDescribe);
-    if(res != ResOK)
-      return res;
+    if (res != ResOK) return res;
   }
 
   res = WriteF(stream, "\n}\n", NULL);
diff --git a/mps/code/ss.h b/mps/code/ss.h
index 9b30efcb46a..84d9719c43b 100644
--- a/mps/code/ss.h
+++ b/mps/code/ss.h
@@ -1,5 +1,4 @@
-/*  impl.h.ss
- *              STACK SCANNING
+/* impl.h.ss: STACK SCANNING
  *
  *  $Id$
  *
diff --git a/mps/code/sslii3.c b/mps/code/sslii3.c
index c9c12c13119..7219ab33c20 100644
--- a/mps/code/sslii3.c
+++ b/mps/code/sslii3.c
@@ -34,6 +34,7 @@
 
 SRCID(sslii3, "$Id$");
 
+
 /* .assume.asm.order */
 #define ASMV(x) __asm__ volatile (x)
 
diff --git a/mps/code/sssos8.s b/mps/code/sssos8.s
index 7457635b09e..73c86b6f3c0 100644
--- a/mps/code/sssos8.s
+++ b/mps/code/sssos8.s
@@ -1,6 +1,5 @@
-!  impl.s.sssos8
+!  impl.s.sssos8: STACK SCANNING
 !
-!                      STACK SCANNING
 !
 !  $Id$
 !
diff --git a/mps/code/sssus8.c b/mps/code/sssus8.c
new file mode 100644
index 00000000000..a53d5c779e9
--- /dev/null
+++ b/mps/code/sssus8.c
@@ -0,0 +1,63 @@
+/* impl.c.sssus8: SPARC STACK SCANNING
+ *
+ * $HopeName: MMsrc!sssus8.c(trunk.1) $
+ * $Id: sssus8.c,v 1.1 2002/02/15 19:12:02 pekka Exp $
+ * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
+ *
+ * This scans the stack and fixes the registers which may contain
+ * roots.  See design.mps.thread-manager.
+ *
+ * .roots: The non-global registers are preserved into the stackframe
+ * by the "ta 3" instruction.  This leaves the global registers.
+ * According to the Sparc Architecture Manual:
+ * %g1 is assumed to be volatile across procedure calls
+ * %g2...%g4 are "reserved for use by application programmer"
+ * %g5...%g7 are "nonvolatile and reserved for (as-yet-undefined)
+ *    use by the execution environment"
+ * To be safe %g2 to %g7 are pushed onto the stack before scanning
+ * it just in case.
+ *
+ * ASSUMPTIONS
+ *
+ * .assume.align: The stack pointer is assumed to be aligned on a word
+ * boundary.
+ *
+ * .assume.asm.stack: The compiler must not do wacky things with the
+ * stack pointer around a call since we need to ensure that the
+ * callee-save regs are visible during TraceScanArea.
+ *
+ * .assume.asm.order: The volatile modifier should prevent movement
+ * of code, which might break .assume.asm.stack.
+ */
+
+#include "mpm.h"
+#include <alloca.h>
+
+SRCID(sssus8, "$Id: sssus8.c,v 1.1 2002/02/15 19:12:02 pekka Exp $");
+
+
+/* .assume.asm.order */
+#define ASMV(x) __asm__ volatile (x)
+
+
+Res StackScan(ScanState ss, Addr *stackBot)
+{
+  Addr *stackTop;
+  Res res;
+  void *globals;
+
+  /* We expect C will save the caller's window, but we don't really care, */
+  /* because it's bound to be an MPS window. */
+  globals = alloca(24); /* for 6 globals */
+  ASMV("std %%g2, [%0]" : : "r" (globals)); /* double stores */
+  ASMV("std %%g4, [%0 + 8]" : : "r" (globals));
+  ASMV("std %%g6, [%0 + 16]" : : "r" (globals));
+  ASMV("ta 3"); /* flushes register windows onto stack */
+  ASMV("mov %%sp, %0" : "=r" (stackTop));    /* stackTop = sp */
+
+  AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
+  res = TraceScanArea(ss, stackTop, stackBot);
+
+  return res;
+}
diff --git a/mps/code/sssus8.s b/mps/code/sssus8.s
index a20d9225552..198b491ad02 100644
--- a/mps/code/sssus8.s
+++ b/mps/code/sssus8.s
@@ -1,6 +1,4 @@
-!  impl.s.sssus8
-!
-!                      STACK SCANNING
+!  impl.s.sssus8: STACK SCANNING
 !
 !  $Id$
 !
diff --git a/mps/code/sus8lc.gmk b/mps/code/sus8lc.gmk
deleted file mode 100644
index 215046b2f94..00000000000
--- a/mps/code/sus8lc.gmk
+++ /dev/null
@@ -1,14 +0,0 @@
-# impl.gmk.sus8lc: BUILD FOR SUNOS/SPARC V8/LCC PLATFORM
-#
-# $Id$
-# Copyright (c) 2001 Ravenbrook Limited.
-#
-# This is the GNU makefile for platform.sus8lc.
-
-PFM = sus8lc
-
-MPMPF = mpsliban.c mpsioan.c lockan.c than.c vmsu.c \
-        protsu.c prmcan.c span.c
-MPMS = sssus8.s
-
-include lc.gmk
diff --git a/mps/code/teletest.c b/mps/code/teletest.c
index 3d39e9a186e..cc8c38992bf 100644
--- a/mps/code/teletest.c
+++ b/mps/code/teletest.c
@@ -13,7 +13,6 @@
 
 #include <stdlib.h>
 
-
 SRCID(teletest, "$Id$");
 
 
diff --git a/mps/code/testlib.c b/mps/code/testlib.c
index c59d3fa717a..e747e2cc7f4 100644
--- a/mps/code/testlib.c
+++ b/mps/code/testlib.c
@@ -2,15 +2,17 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .purpose: A library of functions that may be of use to unit tests.
  */
 
 #include "testlib.h"
 #include "mps.h"
-#include "mpm.h"
+#include "misc.h" /* for NOOP */
 #include <math.h>
 #include <stdlib.h>
+#include <limits.h>
 #ifdef MPS_OS_IA
 struct itimerspec; /* stop complaints from time.h */
 #endif
@@ -19,16 +21,16 @@ struct itimerspec; /* stop complaints from time.h */
 
 /* rnd -- a random number generator
  *
- * I nabbed it from "ML for the Working Programmer"
- * Originally from:
+ * I nabbed it from "ML for the Working Programmer", originally from:
  * Stephen K Park & Keith W Miller (1988). Random number generators:
- * good one are to find.  Communications of the ACM, 31:1192-1201
+ * good one are to find.  Communications of the ACM, 31:1192-1201.
  */
 
 unsigned long rnd(void)
 {
   static unsigned long seed = 1;
   double s;
+
   s = seed;
   s *= 16807.0;
   s = fmod(s, 2147483647.0);  /* 2^31 - 1 */
@@ -37,13 +39,32 @@ unsigned long rnd(void)
 }
 
 
+/* rnd_addr -- a random address generator
+ *
+ * rnd gives 31 random bits, we run it repeatedly to get enough bits.
+ */
+
+#define ADDR_BITS (sizeof(mps_addr_t) * CHAR_BIT)
+
+mps_addr_t rnd_addr(void)
+{
+  mps_word_t res;
+  unsigned bits;
+
+  for (bits = 0, res = 0; bits < ADDR_BITS;
+       bits += 31, res = res << 31 | (mps_word_t)rnd())
+    NOOP;
+  return (mps_addr_t)res;
+}
+
+
 /* randomize -- randomize the generator, or initialize to replay */
 
 void randomize(int argc, char **argv)
 {
   int i, k, n;
 
-  if(argc > 1) {
+  if (argc > 1) {
     n = sscanf(argv[1], "%d", &k);
     die((n == 1) ? MPS_RES_OK : MPS_RES_FAIL, "randomize");
   } else {
diff --git a/mps/code/testlib.h b/mps/code/testlib.h
index 6245ef46a2c..3a461be8505 100644
--- a/mps/code/testlib.h
+++ b/mps/code/testlib.h
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .purpose: A library of functions that may be of use to unit tests.
  */
@@ -14,6 +15,9 @@
 
 /* Include system header hackery. */
 #include "mpstd.h"
+#ifdef MPS_OS_W3
+#include "mpswin.h"
+#endif
 #ifdef MPS_OS_SU
 #include "ossu.h"
 #endif
@@ -52,12 +56,12 @@
 #pragma warning(disable: 4701)
 #endif
 
-/* In white-hot versions, absolutely no checking is done.  This leads to
- * many spurious warnings because parameters are suddenly unused, etc.
- * We aren't interested in these.
+
+/* Non-checking varieties give many spurious warnings because parameters
+ * are suddenly unused, etc.  We aren't interested in these.
  */
 
-#if defined(CONFIG_VAR_WI)
+#if defined(CHECK_NONE)
 
 /* "unreferenced formal parameter" */
 #pragma warning(disable: 4100)
@@ -140,6 +144,14 @@ extern void verror(const char *format, va_list args);
 extern unsigned long rnd(void);
 
 
+/* rnd_addr -- random number generator
+ *
+ * rnd_addr() generates a sequence of addresses all over the address space.
+ */
+
+extern mps_addr_t rnd_addr(void);
+
+
 /* randomize -- randomize the generator, or initialize to replay
  *
  * randomize(argc, argv) randomizes the rnd generator (using time(3))
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 44acc32b0df..5012d3ce027 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (C) 2002 Global Graphics Software.
  *
  * .design: design.mps.trace.  */
 
@@ -1543,7 +1544,9 @@ Bool TracePoll(Globals globals)
 
       res = TraceCreate(&trace, arena);
       AVER(res == ResOK); /* succeeds because no other trace is busy */
-      traceCondemnAll(trace);
+      res = traceCondemnAll(trace);
+      if (res != ResOK) /* should try some other trace, really @@@@ */
+        goto failCondemn;
       finishingTime = ArenaAvail(arena)
                       - trace->condemned * (1.0 - TraceTopGenMortality);
       if (finishingTime < 0)
@@ -1574,7 +1577,7 @@ Bool TracePoll(Globals globals)
         res = TraceCreate(&trace, arena);
         AVER(res == ResOK);
         res = ChainCondemnAuto(&mortality, firstChain, trace);
-        if (res != ResOK)
+        if (res != ResOK) /* should try some other trace, really @@@@ */
           goto failCondemn;
         trace->chain = firstChain;
         ChainStartGC(firstChain, trace);
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 546f68803b4..3f697e41800 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -11,6 +11,7 @@
 
 #include "tract.h"
 #include "boot.h"
+#include "bt.h"
 #include "mpm.h"
 
 SRCID(tract, "$Id$");
diff --git a/mps/code/tract.h b/mps/code/tract.h
index 92db6991721..aa525825098 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -10,6 +10,7 @@
 
 #include "mpmtypes.h"
 #include "ring.h"
+#include "bt.h"
 
 
 /* TractStruct -- tract structure
@@ -231,11 +232,11 @@ extern Index IndexOfAddr(Chunk chunk, Addr addr);
   AddrAdd((chunk)->base, ChunkPagesToSize(chunk, i))
 
 
-/* TractIsContiguousRange -- do base and limit define a contiguous range */
+/* TractAverContiguousRange -- verify that range is contiguous */
 
-#define AverTractIsContiguousRange(arena, rangeBase, rangeLimit) \
+#define TractAverContiguousRange(arena, rangeBase, rangeLimit) \
   BEGIN \
-    Chunk _ch; \
+    Chunk _ch = NULL; \
     \
     UNUSED(_ch); \
     AVER(ChunkOfAddr(&_ch, arena, rangeBase) && (rangeLimit) <= _ch->limit); \
@@ -255,7 +256,7 @@ extern Bool TractNext(Tract *tractReturn, Arena arena, Addr addr);
 
 #define TRACT_TRACT_FOR(tract, addr, arena, firstTract, limit) \
   tract = (firstTract); addr = TractBase(tract); \
-  AverTractIsContiguousRange(arena, addr, limit); \
+  TractAverContiguousRange(arena, addr, limit); \
   for(; tract != NULL; \
       (addr = AddrAdd(addr, (arena)->alignment)), \
       (addr < (limit) ? \
diff --git a/mps/code/version.c b/mps/code/version.c
index 066d157cdc7..963c5ebad6e 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -10,14 +10,12 @@
  *
  * DESIGN
  *
- * .design: See design.mps.version-library, but to let you in on a
- * secret it works by declaring a string with all the necessary info
- * in.
- */
+ * .design: See design.mps.version-library, but - to let you in on a
+ * secret - it works by declaring a string with all the necessary info
+ * in.  */
 
 #include "mpm.h"
 
-
 SRCID(version, "$Id$");
 
 
@@ -28,7 +26,7 @@ SRCID(version, "$Id$");
  * whatever.
  */
 
-#define MPS_RELEASE "$Id$ *** DEVELOPMENT ONLY ***"
+#define MPS_RELEASE "release.epcore.chub"
 
 
 /* MPSCopyrightNotice -- copyright notice for the binary
@@ -38,7 +36,7 @@ SRCID(version, "$Id$");
  */
 
 char MPSCopyrightNotice[] =
-  "Copyright (c) 2001 Ravenbrook Limited.";
+  "Copyright (c) 2002 Ravenbrook Limited and Global Graphics Software.";
 
 
 /* MPSVersion -- return version string
diff --git a/mps/code/vman.c b/mps/code/vman.c
index 1d3959d0aee..a92d4bef7b4 100644
--- a/mps/code/vman.c
+++ b/mps/code/vman.c
@@ -195,7 +195,7 @@ void VMUnmap(VM vm, Addr base, Addr limit)
   AVER(AddrIsAligned(limit, VMANPageALIGNMENT));
  
   size = AddrOffset(base, limit);
-  memset((void *)base, VM_JUNKBYTE, size);
+  memset((void *)base, 0xCD, size);
 
   AVER(vm->mapped >= size);
   vm->mapped -= size;
diff --git a/mps/code/vmso.c b/mps/code/vmso.c
index 68e6e2131a5..3c205eb9599 100644
--- a/mps/code/vmso.c
+++ b/mps/code/vmso.c
@@ -2,6 +2,7 @@
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.
+ * Copyright (c) 2002 Global Graphics Software.
  *
  * DESIGN
  *
@@ -44,6 +45,7 @@
 
 /* Open sesame magic */
 #define _POSIX_SOURCE
+#define _XOPEN_SOURCE 500
 
 #include <sys/types.h>
 #include <sys/mman.h>
@@ -56,12 +58,6 @@
 SRCID(vmso, "$Id$");
 
 
-/* Fix up unprototyped system calls.  */
-
-extern int close(int fd);
-extern int munmap(caddr_t addr, size_t len);
-
-
 /* VMStruct -- virtual memory structure */
 
 #define VMSig           ((Sig)0x519B3999) /* SIGnature VM */
@@ -78,6 +74,8 @@ typedef struct VMStruct {
 } VMStruct;
 
 
+/* VMAlign -- return the page size */
+
 Align VMAlign(VM vm)
 {
   AVERT(VM, vm);
@@ -85,6 +83,8 @@ Align VMAlign(VM vm)
 }
 
 
+/* VMCheck -- check a VM structure */
+
 Bool VMCheck(VM vm)
 {
   CHECKS(VM, vm);
@@ -102,9 +102,11 @@ Bool VMCheck(VM vm)
 }
 
 
+/* VMCreate -- reserve some virtual address space, and create a VM structure */
+
 Res VMCreate(VM *vmReturn, Size size)
 {
-  caddr_t addr;
+  void *addr;
   Align align;
   int zero_fd;
   int none_fd;
@@ -137,7 +139,7 @@ Res VMCreate(VM *vmReturn, Size size)
   }
 
   /* Map in a page to store the descriptor on. */
-  addr = mmap((caddr_t)0, (size_t)SizeAlignUp(sizeof(VMStruct), align),
+  addr = mmap((void *)0, (size_t)SizeAlignUp(sizeof(VMStruct), align),
               PROT_READ | PROT_WRITE, MAP_PRIVATE,
               zero_fd, (off_t)0);
   if(addr == MAP_FAILED) {
@@ -152,7 +154,7 @@ Res VMCreate(VM *vmReturn, Size size)
   vm->align = align;
 
   /* .map.reserve: See .assume.not-last. */
-  addr = mmap((caddr_t)0, (size_t)size, PROT_NONE, MAP_SHARED,
+  addr = mmap((void *)0, (size_t)size, PROT_NONE, MAP_SHARED,
               none_fd, (off_t)0);
   if(addr == MAP_FAILED) {
     AVER(errno == ENOMEM); /* .assume.mmap.err */
@@ -175,7 +177,7 @@ Res VMCreate(VM *vmReturn, Size size)
   return ResOK;
 
 failReserve:
-  (void)munmap((caddr_t)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align));
+  (void)munmap((void *)vm, (size_t)SizeAlignUp(sizeof(VMStruct), align));
 failVMMap:
   (void)close(none_fd); /* see .close.fail */
 failNoneOpen:
@@ -184,6 +186,8 @@ failNoneOpen:
 }
 
 
+/* VMDestroy -- destroy the VM structure */
+
 void VMDestroy(VM vm)
 {
   int r;
@@ -199,9 +203,9 @@ void VMDestroy(VM vm)
   vm->sig = SigInvalid;
 
   zero_fd = vm->zero_fd; none_fd = vm->none_fd;
-  r = munmap((caddr_t)vm->base, (size_t)AddrOffset(vm->base, vm->limit));
+  r = munmap((void *)vm->base, (size_t)AddrOffset(vm->base, vm->limit));
   AVER(r == 0);
-  r = munmap((caddr_t)vm,
+  r = munmap((void *)vm,
              (size_t)SizeAlignUp(sizeof(VMStruct), vm->align));
   AVER(r == 0);
   /* .close.fail: We ignore failure from close() as there's very */
@@ -213,12 +217,17 @@ void VMDestroy(VM vm)
 }
 
 
+/* VMBase -- return the base address of the memory reserved */
+
 Addr VMBase(VM vm)
 {
   AVERT(VM, vm);
   return vm->base;
 }
 
+
+/* VMLimit -- return the limit address of the memory reserved */
+
 Addr VMLimit(VM vm)
 {
   AVERT(VM, vm);
@@ -226,12 +235,17 @@ Addr VMLimit(VM vm)
 }
 
 
+/* VMReserved -- return the amount of address space reserved */
+
 Size VMReserved(VM vm)
 {
   AVERT(VM, vm);
   return vm->reserved;
 }
 
+
+/* VMMapped -- return the amount of memory actually mapped */
+
 Size VMMapped(VM vm)
 {
   AVERT(VM, vm);
@@ -239,10 +253,12 @@ Size VMMapped(VM vm)
 }
 
 
+/* VMMap -- map the given range of memory */
+
 Res VMMap(VM vm, Addr base, Addr limit)
 {
   Size size;
-  caddr_t addr;
+  void *addr;
 
   AVERT(VM, vm);
   AVER(base < limit);
@@ -258,7 +274,7 @@ Res VMMap(VM vm, Addr base, Addr limit)
   /* Check it won't lose any bits. */
   AVER(size <= (Size)(size_t)-1);
 
-  addr = mmap((caddr_t)base, (size_t)size,
+  addr = mmap((void *)base, (size_t)size,
               PROT_READ | PROT_WRITE | PROT_EXEC,
               MAP_PRIVATE | MAP_FIXED,
               vm->zero_fd, (off_t)0);
@@ -266,7 +282,7 @@ Res VMMap(VM vm, Addr base, Addr limit)
     AVER(errno == EAGAIN); /* .assume.mmap.err */
     return ResMEMORY;
   }
-  AVER(addr == (caddr_t)base);
+  AVER(addr == (void *)base);
 
   vm->mapped += size;
 
@@ -275,10 +291,12 @@ Res VMMap(VM vm, Addr base, Addr limit)
 }
 
 
+/* VMUnmap -- unmap the given range of memory */
+
 void VMUnmap(VM vm, Addr base, Addr limit)
 {
   Size size;
-  caddr_t addr;
+  void *addr;
 
   AVERT(VM, vm);
   AVER(base < limit);
@@ -296,10 +314,10 @@ void VMUnmap(VM vm, Addr base, Addr limit)
   size = AddrOffset(base, limit);
   /* Check it won't lose any bits. */
   AVER(size <= (Size)(size_t)-1);
-  addr = mmap((caddr_t)base, (size_t)size,
+  addr = mmap((void *)base, (size_t)size,
               PROT_NONE, MAP_SHARED | MAP_FIXED,
               vm->none_fd, (off_t)AddrOffset(vm->base, base));
-  AVER(addr == (caddr_t)base);
+  AVER(addr == (void *)base);
 
   vm->mapped -= size;
 
diff --git a/mps/code/w3almv.nmk b/mps/code/w3almv.nmk
index e045ead0a60..f20180c31da 100644
--- a/mps/code/w3almv.nmk
+++ b/mps/code/w3almv.nmk
@@ -10,29 +10,29 @@ DONGLELIB = $(RAINBOWPATH)\spromeps.lib
 
 PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH)
 
-MPM = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> <lockw3> \
       <ref> <trace> <protw3> <prmcan> <shield> <vmw3> \
       <than> <ssan> <mpsi> <mpsiw3> <ld> <span> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
       <ref> <trace> <protw3> <prmcan> <shield> \
       <than> <ssan> <mpsi> <mpsiw3> <ld> <vmw3> \
-      <event> <action> <seg> <poolmrg> <message> <span> \
+      <event> <seg> <poolmrg> <message> <span> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
-SW  = <assert> <ring> <mpm> <bt> <protocol> \
+SW  = <ring> <mpm> <bt> <protocol> \
       <arenavm> <arenacl> <arena> <tract> <walk> <reserv> \
       <pool> <poolabs> <poolmfs> \
       <poolmv> <root> <format> <buffer> \
       <ref> <trace> <protsw> <prmcan> <shield> <vmw3> \
       <than> <ssan> <mpsi> <ld> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <mpsioan> \
-      <poolepdl> <poolepvm> <poolams> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
+      <poolams> <poolamsi> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
-AMS = <poolams>
+AMS = <poolams> <poolamsi>
 AWL = <poolawl>
 LO  = <poollo>
 DW = <fmtdy> <fmtno>
diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk
index 9add7193248..add22d2a8f7 100644
--- a/mps/code/w3i3mv.nmk
+++ b/mps/code/w3i3mv.nmk
@@ -10,34 +10,34 @@ DONGLELIB = $(RAINBOWPATH)\spromeps.lib
 
 PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH)
 
-MPM = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> <lockw3> \
       <ref> <trace> <protw3> <proti3> <prmci3w3> <shield> <vmw3> \
       <thw3i3> <ssw3i3> <mpsi> <mpsiw3> <ld> <spi3> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version>
-SW  = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> \
       <ref> <trace> <protsw> <prmcan> <shield> <vmw3> \
       <thw3i3> <ssan> <mpsi> <ld> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <mpsioan> \
-      <poolepdl> <poolepvm> <poolams> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
+      <poolams> <poolamsi> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
-CONFIGURA = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+CONFIGURA = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> \
       <ref> <trace> <protw3> <proti3> <prmci3w3> <shield> <vmw3> \
       <thw3i3> <ssw3i3> <mpsi> <mpsiw3> <ld> <spi3> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <splay> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
-AMS = <poolams>
+AMS = <poolams> <poolamsi>
 AWL = <poolawl>
 LO = <poollo>
 SNC = <poolsnc>
diff --git a/mps/code/w3ppmv.nmk b/mps/code/w3ppmv.nmk
index c9d41fb90a0..fd9898b1545 100644
--- a/mps/code/w3ppmv.nmk
+++ b/mps/code/w3ppmv.nmk
@@ -10,26 +10,26 @@ DONGLELIB = $(RAINBOWPATH)\spromeps.lib
 
 PFMDEFS = /DWIN32 /D_WINDOWS /I$(RAINBOWPATH)
 
-MPM = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> <lockw3> \
       <ref> <trace> <protw3> <prmcan> <shield> <vmw3> \
       <than> <ssan> <mpsi> <mpsiw3> <ld> <span> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version>
-SW  = <assert> <ring> <mpm> <bt> <protocol> <boot> \
+SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> \
       <ref> <trace> <protsw> <prmcan> <shield> <vmw3> \
       <than> <ssan> <mpsi> <ld> \
-      <event> <action> <seg> <sac> <poolmrg> <message> <mpsioan> \
-      <poolepdl> <poolepvm> <poolams> <dbgpool> \
+      <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
+      <poolams> <poolamsi> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
-AMS = <poolams>
+AMS = <poolams> <poolamsi>
 AWL = <poolawl>
 LO = <poollo>
 DW = <fmtdy> <fmtno>