Partial merge of branch/2012-07-23/cet-transform, excluding cet-specific parts.

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

30 files changed, 802 insertions, 393 deletions

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index f67802daf56..3b775882bc3 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -150,7 +150,8 @@ MPMCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \
             trace.c traceanc.c root.c seg.c format.c buffer.c ref.c \
             bt.c ring.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 diag.c
+            boot.c meter.c splay.c cbs.c diag.c \
+            ss.c table.c
 MPM = $(MPMCOMMON) $(MPMPF)
 
 
@@ -414,7 +415,7 @@ $(PFM)/$(VARIETY)/zmess: $(PFM)/$(VARIETY)/zmess.o \
         $(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
 
 $(PFM)/$(VARIETY)/eventcnv: $(PFM)/$(VARIETY)/eventcnv.o \
-  $(PFM)/$(VARIETY)/eventpro.o $(PFM)/$(VARIETY)/table.o
+  $(PFM)/$(VARIETY)/eventpro.o $(PFM)/$(VARIETY)/mps.a
 
 $(PFM)/$(VARIETY)/replay: $(PFM)/$(VARIETY)/replay.o \
   $(PFM)/$(VARIETY)/eventrep.o \
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 63cd0fdd44f..483acb09710 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -232,7 +232,7 @@ $(PFM)\$(VARIETY)\zmess.exe: $(PFM)\$(VARIETY)\zmess.obj \
         $(TESTLIBOBJ)
 
 $(PFM)\$(VARIETY)\eventcnv.exe: $(PFM)\$(VARIETY)\eventcnv.obj \
-        $(PFM)\$(VARIETY)\eventpro.obj $(PFM)\$(VARIETY)\table.obj
+        $(PFM)\$(VARIETY)\eventpro.obj $(MPMOBJ) $(PLINTHOBJ)
 
 $(PFM)\$(VARIETY)\replay.exe: $(PFM)\$(VARIETY)\replay.obj \
   $(PFM)\$(VARIETY)\eventrep.obj \
diff --git a/mps/code/eventpro.c b/mps/code/eventpro.c
index 52d913a19dd..a1856eaee02 100644
--- a/mps/code/eventpro.c
+++ b/mps/code/eventpro.c
@@ -340,6 +340,19 @@ void EventDestroy(EventProc proc, Event event)
 
 /* EventProcCreate -- initialize the module */
 
+static void *tableAlloc(void *closure, size_t size)
+{
+  UNUSED(closure);
+  return malloc(size);
+}
+
+static void tableFree(void *closure, void *p, size_t size)
+{
+  UNUSED(closure);
+  UNUSED(size);
+  free(p);
+}
+
 Res EventProcCreate(EventProc *procReturn,
                     EventProcReader reader,
                     void *readerP)
@@ -356,9 +369,14 @@ Res EventProcCreate(EventProc *procReturn,
   assert(sizeof(Word) >= sizeof(Addr));
 
   proc->reader = reader; proc->readerP = readerP;
-  res = TableCreate(&proc->internTable, (size_t)1<<4);
+  res = TableCreate(&proc->internTable,
+                    (size_t)1<<4,
+                    tableAlloc, tableFree, NULL,
+                    (Word)-1, (Word)-2);  /* because MPS IDs are serials from zero up */
   if (res != ResOK) goto failIntern;
-  res = TableCreate(&proc->labelTable, (size_t)1<<7);
+  res = TableCreate(&proc->labelTable, (size_t)1<<7,
+                    tableAlloc, tableFree, NULL,
+                    0, 1);    /* no Addrs down here */
   if (res != ResOK) goto failLabel;
   proc->cachedEvent = NULL;
   *procReturn = proc;
@@ -374,23 +392,25 @@ failIntern:
 
 /* EventProcDestroy -- finish the module */
 
-static void deallocItem(Word key, void *value)
+static void deallocItem(void *closure, Word key, void *value)
 {
   UNUSED(key);
+  UNUSED(closure);
   free(value);
 }
 
-static void deallocSym(Word key, void *value)
+static void deallocSym(void *closure, Word key, void *value)
 {
   UNUSED(key);
+  UNUSED(closure);
   eventStringDestroy(((Symbol)value)->name);
   free(value);
 }
 
 void EventProcDestroy(EventProc proc)
 {
-  TableMap(proc->labelTable, deallocItem);
-  TableMap(proc->internTable, deallocSym);
+  TableMap(proc->labelTable, deallocItem, NULL);
+  TableMap(proc->internTable, deallocSym, NULL);
   TableDestroy(proc->labelTable);
   TableDestroy(proc->internTable);
   if (proc->cachedEvent != NULL)
diff --git a/mps/code/fmtdytst.h b/mps/code/fmtdytst.h
index 5aea06c7ee7..14f8993383d 100644
--- a/mps/code/fmtdytst.h
+++ b/mps/code/fmtdytst.h
@@ -8,6 +8,7 @@
 #define fmtdytst_h
 
 #include "mps.h"
+#include "testlib.h"
 
 extern mps_res_t dylan_init(mps_addr_t addr, size_t size,
                             mps_addr_t *refs, size_t nr_refs);
@@ -25,8 +26,16 @@ extern mps_res_t make_dylan_vector(mps_word_t *v, mps_ap_t ap, size_t slots);
 
 #define DYLAN_INT(n) (((mps_word_t)(n) << 2) | 1)
 
+#define INT_DYI(n)  ( (n) <= DYLAN_UINT_MAX ? DYLAN_INT(n) : (mps_word_t)fail() )
+
+
 #define DYLAN_INT_INT(d)  ((mps_word_t)(d) >> 2)
 
+#define DYI_INT(d)  ( ((d) & 0x3) == 0x1 ? DYLAN_INT_INT(d) : (mps_word_t)fail() )
+
+#define DYLAN_UINT_MAX  ((mps_word_t)-1 >> 2)
+#define DYLAN_UINT_MASK  DYLAN_UINT_MAX
+
 #endif /* fmtdy_h */
 
 
diff --git a/mps/code/global.c b/mps/code/global.c
index 0dccbb5b914..43853745b58 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -212,6 +212,10 @@ Bool GlobalsCheck(Globals arenaGlobals)
   CHECKL(BoolCheck(arenaRingInit));
   CHECKL(RingCheck(&arenaRing));
 
+  CHECKL(BoolCheck(arena->emergency));
+
+  /* can't check arena->stackAtArenaEnter */
+  
   return TRUE;
 }
 
@@ -222,9 +226,8 @@ Res GlobalsInit(Globals arenaGlobals)
 {
   Arena arena;
   Index i;
-  TraceId ti;
-  Trace trace;
   Rank rank;
+  TraceId ti;
 
   /* This is one of the first things that happens, */
   /* so check static consistency here. */
@@ -287,13 +290,15 @@ Res GlobalsInit(Globals arenaGlobals)
   for(i = 0; i < ShieldCacheSIZE; i++)
     arena->shCache[i] = NULL;
 
-  TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
+  for (ti = 0; ti < TraceLIMIT; ++ti) {
     /* <design/arena/#trace.invalid> */
     arena->trace[ti].sig = SigInvalid;
+    /* ti must be valid so that TraceSetIsMember etc. always work */
+    arena->trace[ti].ti = ti;
     /* <design/message-gc/#lifecycle> */
     arena->tsMessage[ti] = NULL;
     arena->tMessage[ti] = NULL;
-  TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
+  }
 
   for(rank = 0; rank < RankLIMIT; ++rank)
     RingInit(&arena->greyRing[rank]);
@@ -305,6 +310,10 @@ Res GlobalsInit(Globals arenaGlobals)
   for(i = 0; i < LDHistoryLENGTH; ++i)
     arena->history[i] = RefSetEMPTY;
 
+  arena->emergency = FALSE;
+
+  arena->stackAtArenaEnter = NULL;
+
   arenaGlobals->sig = GlobalsSig;
   AVERT(Globals, arenaGlobals);
   return ResOK;
@@ -1031,6 +1040,39 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream)
 }
 
 
+/* ArenaSetEmergency -- move the arena into emergency mode
+ *
+ * Emergency mode is set when garbage collection cannot make progress because
+ * it can't allocate memory.
+ *
+ * Emergency mode affects the choice of PoolFixMethod in new ScanStates.
+ * See ScanStateInit.
+ *
+ * If the traces aren't normal GC traces, and have their fix method
+ * set to something other than PoolFix, then this won't affect the choice
+ * of fix method in ScanStateInit and so won't have any effect.  Whatever
+ * caused the first failure will likely repeat.
+ */
+
+void ArenaSetEmergency(Arena arena, Bool emergency)
+{
+  AVERT(Arena, arena);
+  AVERT(Bool, emergency);
+
+  DIAG_SINGLEF(( "ArenaSetEmergency",
+    "emergency: $U", (WriteFU)emergency, NULL ));
+  
+  arena->emergency = emergency;
+}
+
+Bool ArenaEmergency(Arena arena)
+{
+  AVERT(Arena, arena);
+  return arena->emergency;
+}
+
+
+
 /* C. COPYRIGHT AND LICENSE
  *
  * Copyright (C) 2001-2003, 2008 Ravenbrook Limited <http://www.ravenbrook.com/>.
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index f653e643d8a..f8f2e9e7466 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -210,7 +210,7 @@ extern Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg);
 extern Res (PoolFix)(Pool pool, ScanState ss, Seg seg, Addr *refIO);
 #define PoolFix(pool, ss, seg, refIO) \
   ((*(pool)->fix)(pool, ss, seg, refIO))
-extern void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO);
+extern Res PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO);
 extern void PoolReclaim(Pool pool, Trace trace, Seg seg);
 extern void PoolTraceEnd(Pool pool, Trace trace);
 extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsStepMethod f,
@@ -374,14 +374,11 @@ extern void TraceDestroy(Trace trace);
 
 extern Res TraceAddWhite(Trace trace, Seg seg);
 extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
-extern void TraceStart(Trace trace, double mortality,
-                       double finishingTime);
+extern Res TraceStart(Trace trace, double mortality, double finishingTime);
 extern Size TracePoll(Globals globals);
 
 extern Rank TraceRankForAccess(Arena arena, Seg seg);
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
-extern Res TraceFix(ScanState ss, Ref *refIO);
-extern Res TraceFixEmergency(ScanState ss, Ref *refIO);
 
 extern void TraceQuantum(Trace trace);
 extern Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why);
@@ -421,12 +418,11 @@ extern double TraceWorkFactor;
 #define TRACE_FIX1(ss, ref) \
   (SCANt = (Word)1 << ((Word)(ref) >> SCANzoneShift & (MPS_WORD_WIDTH-1)), \
    SCANsummary |= SCANt, \
-   SCANwhite & SCANt)
+   (SCANwhite & SCANt) != 0)
 
 /* Equivalent to <code/mps.h> MPS_FIX2 */
 
-#define TRACE_FIX2(ss, refIO) \
-  ((*(ss)->fix)(ss, refIO))
+#define TRACE_FIX2(ss, refIO) mps_fix2((mps_ss_t)(ss), (mps_addr_t *)(refIO))
 
 /* Equivalent to <code/mps.h> MPS_FIX */
 
@@ -522,6 +518,9 @@ extern Res ArenaStartCollect(Globals globals, int why);
 extern Res ArenaCollect(Globals globals, int why);
 extern Bool ArenaHasAddr(Arena arena, Addr addr);
 
+extern void ArenaSetEmergency(Arena arena, Bool emergency);
+extern Bool ArenaEmergency(Arena arean);
+
 extern Res ControlInit(Arena arena);
 extern void ControlFinish(Arena arena);
 extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 0903e783ba0..8807d086b66 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -453,9 +453,8 @@ typedef struct LDStruct {
  *
  * .ss: See <code/trace.c>.
  *
- * .ss: The first four fields of the trace structure must match the
+ * .ss: The first three fields of the trace structure must match the
  * external scan state structure (mps_ss_s) thus:
- *   ss->fix            mps_ss->fix
  *   ss->zoneShift      mps_ss->w0
  *   ss->white          mps_ss->w1
  *   ss->unfixedSummary mps_ss->w2
@@ -466,12 +465,13 @@ typedef struct LDStruct {
 #define ScanStateSig    ((Sig)0x5195CA45) /* SIGnature SCAN State */
 
 typedef struct ScanStateStruct {
-  TraceFixMethod fix;           /* fix function */
   Word zoneShift;               /* copy of arena->zoneShift.  See .ss.zone */
   ZoneSet white;                /* white set, for inline fix test */
   RefSet unfixedSummary;        /* accumulated summary of scanned references */
   Sig sig;                      /* <design/sig/> */
   Arena arena;                  /* owning arena */
+  PoolFixMethod fix;            /* third stage fix function */
+  void *fixClosure;             /* closure data for fix */
   TraceSet traces;              /* traces to scan for */
   Rank rank;                    /* reference rank of scanning */
   Bool wasMarked;               /* design.mps.fix.protocol.was-ready */
@@ -505,7 +505,8 @@ typedef struct TraceStruct {
   TraceState state;             /* current state of trace */
   Rank band;                    /* current band */
   Bool firstStretch;            /* in first stretch of band (see accessor) */
-  Bool emergency;               /* ran out of memory during trace */
+  PoolFixMethod fix;            /* fix method to apply to references */
+  void *fixClosure;             /* closure information for fix method */
   Chain chain;                  /* chain being incrementally collected */
   STATISTIC_DECL(Size preTraceArenaReserved); /* ArenaReserved before this trace */
   Size condemned;               /* condemned bytes */
@@ -712,6 +713,11 @@ typedef struct ArenaStruct {
   RefSet prehistory;               /* <design/arena/#ld.prehistory> */
   RefSet history[LDHistoryLENGTH]; /* <design/arena/#ld.history> */
 
+  Bool emergency;               /* garbage collect in emergency mode? */
+
+  Addr *stackAtArenaEnter;  /* NULL or top of client stack, in the thread */
+                            /* that then entered the MPS. */
+
   Sig sig;
 } ArenaStruct;
 
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index d4f07cb99f4..66d5b533546 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -411,6 +411,8 @@ enum {
 /* TraceStart reasons: the trigger that caused a trace to start. */
 /* Make these specific trigger names, not broad categories; */
 /* and if a new trigger is added, add a new reason. */
+/* TODO: A better way for MPS extensions to extend the list of reasons
+   instead of the catch-all TraceStartWhyEXTENSION. */
 
 enum {
   TraceStartWhyBASE = 1, /* not a reason, the base of the enum. */
@@ -419,7 +421,8 @@ enum {
   TraceStartWhyOPPORTUNISM,      /* start full */
   TraceStartWhyCLIENTFULL_INCREMENTAL,   /* start full */
   TraceStartWhyCLIENTFULL_BLOCK, /* do full */
-  TraceStartWhyWALK,
+  TraceStartWhyWALK,            /* walking references -- see walk.c */
+  TraceStartWhyEXTENSION,       /* MPS extension using traces */
   TraceStartWhyLIMIT /* not a reason, the limit of the enum. */
 };
 
diff --git a/mps/code/mps.c b/mps/code/mps.c
index 8adcf146226..1d1d93100d0 100644
--- a/mps/code/mps.c
+++ b/mps/code/mps.c
@@ -67,7 +67,9 @@
 #include "splay.c"
 #include "cbs.c"
 #include "diag.c"
+#include "ss.c"
 #include "version.c"
+#include "table.c"
 
 /* Additional pool classes */
 
@@ -184,7 +186,7 @@
 #include "protw3.c"     /* Windows protection */
 #include "proti3.c"     /* 32-bit Intel mutator context decoding */
 #include "prmci3w3.c"   /* Windows on 32-bit Intel mutator context */
-#include "ssw3mv.c"     /* Windows stack scan for Microsoft C */
+#include "ssw3i3mv.c"   /* Windows on 32-bit stack scan for Microsoft C */
 #include "spi3.c"       /* Intel stack probe */
 #include "mpsiw3.c"     /* Windows interface layer extras */
 
@@ -200,7 +202,7 @@
 #include "protw3.c"     /* Windows protection */
 #include "proti6.c"     /* 64-bit Intel mutator context decoding */
 #include "prmci6w3.c"   /* Windows on 64-bit Intel mutator context */
-#include "ssw3mv.c"     /* Windows stack scan for Microsoft C */
+#include "ssw3i6mv.c"   /* Windows on 64-bit stack scan for Microsoft C */
 #include "span.c"       /* generic stack probe FIXME: Is this correct? */
 #include "mpsiw3.c"     /* Windows interface layer extras */
 
diff --git a/mps/code/mps.h b/mps/code/mps.h
index 633dbb5ddac..8971c3a4f2d 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -189,7 +189,6 @@ typedef mps_addr_t (*mps_fmt_class_t)(mps_addr_t);
 /* .ss: See also <code/mpsi.c#check.ss> and <code/mpmst.h#ss>. */
 
 typedef struct mps_ss_s {
-  mps_res_t (*fix)(mps_ss_t, mps_addr_t *);
   mps_word_t w0, w1, w2;
 } mps_ss_s;
 
@@ -640,10 +639,10 @@ extern mps_res_t mps_fix(mps_ss_t, mps_addr_t *);
   (_mps_wt = (mps_word_t)1 << ((mps_word_t)(ref) >> _mps_w0 \
                                & (sizeof(mps_word_t) * CHAR_BIT - 1)), \
    _mps_w2 |= _mps_wt, \
-   _mps_w1 & _mps_wt)
+   (_mps_w1 & _mps_wt) != 0)
 
-#define MPS_FIX2(ss, ref_io) \
-  ((*(ss)->fix)(ss, ref_io))
+extern mps_res_t mps_fix2(mps_ss_t, mps_addr_t *);
+#define MPS_FIX2(ss, ref_io) mps_fix2(ss, ref_io)
 
 #define MPS_FIX12(ss, ref_io) \
   (MPS_FIX1(ss, *(ref_io)) ? \
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index c97826e7c98..528ffebea3e 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -160,11 +160,7 @@ static Bool mpsi_check(void)
   /* Check ss_s/ScanStateStruct compatibility by hand */
   /* .check.ss: See <code/mps.h#ss> and <code/mpmst.h#ss>. */
   /* Note that the size of the mps_ss_s and ScanStateStruct */
-  /* are not equal.  See <code/mpmst.h#ss>.  COMPATFIELDAPPROX */
-  /* is used on the fix field because its type is punned and */
-  /* therefore isn't exactly checkable.  See */
-  /* <design/interface-c/#pun.addr>. */
-  CHECKL(COMPATFIELDAPPROX(mps_ss_s, fix, ScanStateStruct, fix));
+  /* are not equal.  See <code/mpmst.h#ss>. */
   CHECKL(COMPATFIELD(mps_ss_s, w0, ScanStateStruct, zoneShift));
   CHECKL(COMPATFIELD(mps_ss_s, w1, ScanStateStruct, white));
   CHECKL(COMPATFIELD(mps_ss_s, w2, ScanStateStruct, unfixedSummary));
diff --git a/mps/code/pool.c b/mps/code/pool.c
index 0635bf012b3..a88cf48e97c 100644
--- a/mps/code/pool.c
+++ b/mps/code/pool.c
@@ -425,7 +425,7 @@ Res (PoolFix)(Pool pool, ScanState ss, Seg seg, Addr *refIO)
   return PoolFix(pool, ss, seg, refIO);
 }
 
-void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO)
+Res PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO)
 {
   Res res;
 
@@ -440,6 +440,7 @@ void PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO)
 
   res = (pool->class->fixEmergency)(pool, ss, seg, refIO);
   AVER(res == ResOK);
+  return res;
 }
 
 
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index 8c9934d43ca..713a627dd08 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -1520,55 +1520,41 @@ static Res amcScanNailed(Bool *totalReturn, ScanState ss, Pool pool,
   } while(moreScanning);
 
   if(loops > 1) {
-    {
-      /* Looped: should only happen under emergency tracing. */
-      TraceId ti;
-      Trace trace;
-      Bool emerg = FALSE;
-      TraceSet ts = ss->traces;
-      Arena arena = pool->arena;
-      
-      TRACE_SET_ITER(ti, trace, ts, arena)
-        if(trace->emergency) {
-          emerg = TRUE;
-        }
-      TRACE_SET_ITER_END(ti, trace, ts, arena);
-      AVER(emerg);
-    }
-    {      
-      /* Looped: fixed refs (from 1st pass) were seen by MPS_FIX1
-       * (in later passes), so the "ss.unfixedSummary" is _not_ 
-       * purely unfixed.  In this one case, unfixedSummary is not 
-       * accurate, and cannot be used to verify the SegSummary (see 
-       * impl/trace/#verify.segsummary).  Use ScanStateSetSummary to 
-       * store ScanStateSummary in ss.fixedSummary and reset 
-       * ss.unfixedSummary.  See job001548.
-       */
-      RefSet refset;
-    
-      refset = ScanStateSummary(ss);
+    RefSet refset;
+
+    AVER(ArenaEmergency(PoolArena(pool)));
+
+    /* Looped: fixed refs (from 1st pass) were seen by MPS_FIX1
+     * (in later passes), so the "ss.unfixedSummary" is _not_
+     * purely unfixed.  In this one case, unfixedSummary is not 
+     * accurate, and cannot be used to verify the SegSummary (see 
+     * impl/trace/#verify.segsummary).  Use ScanStateSetSummary to 
+     * store ScanStateSummary in ss.fixedSummary and reset 
+     * ss.unfixedSummary.  See job001548.
+     */
+  
+    refset = ScanStateSummary(ss);
 
 #if 1
-      /* A rare event, which might prompt a rare defect to appear. */
-      DIAG_SINGLEF(( "amcScanNailed_loop",
-        "scan completed, but had to loop $U times:\n", (WriteFU)loops,
-        " SegSummary:        $B\n", (WriteFB)SegSummary(seg),
-        " ss.white:          $B\n", (WriteFB)ss->white,
-        " ss.unfixedSummary: $B", (WriteFB)ss->unfixedSummary,
-          "$S\n", (WriteFS)( 
-            (RefSetSub(ss->unfixedSummary, SegSummary(seg)))
-            ? ""
-            : " <=== This would have failed .verify.segsummary!"
-            ),
-        " ss.fixedSummary:   $B\n", (WriteFB)ss->fixedSummary,
-        "ScanStateSummary:   $B\n", (WriteFB)refset,
-        "MOVING ScanStateSummary TO fixedSummary, "
-        "RESETTING unfixedSummary.\n", NULL
-      ));
+    /* A rare event, which might prompt a rare defect to appear. */
+    DIAG_SINGLEF(( "amcScanNailed_loop",
+      "scan completed, but had to loop $U times:\n", (WriteFU)loops,
+      " SegSummary:        $B\n", (WriteFB)SegSummary(seg),
+      " ss.white:          $B\n", (WriteFB)ss->white,
+      " ss.unfixedSummary: $B", (WriteFB)ss->unfixedSummary,
+        "$S\n", (WriteFS)( 
+          (RefSetSub(ss->unfixedSummary, SegSummary(seg)))
+          ? ""
+          : " <=== This would have failed .verify.segsummary!"
+          ),
+      " ss.fixedSummary:   $B\n", (WriteFB)ss->fixedSummary,
+      "ScanStateSummary:   $B\n", (WriteFB)refset,
+      "MOVING ScanStateSummary TO fixedSummary, "
+      "RESETTING unfixedSummary.\n", NULL
+    ));
 #endif
-    
-      ScanStateSetSummary(ss, refset);
-    }
+  
+    ScanStateSetSummary(ss, refset);
   }
   
   *totalReturn = total;
@@ -2219,7 +2205,6 @@ static void AMCTraceEnd(Pool pool, Trace trace)
     DIAG_SINGLEF(( "AMCTraceEnd_pageret",
       " $U", (WriteFU)ArenaEpoch(pool->arena),
       " $U", (WriteFU)trace->why,
-      " $S", (WriteFS)(trace->emergency ? "Emergency" : "-"),
       " $U", (WriteFU)amc->pageretstruct[ti].pCond,
       " $U", (WriteFU)amc->pageretstruct[ti].pRet, ",",
       " $U", (WriteFU)amc->pageretstruct[ti].pCS,
diff --git a/mps/code/protsgix.c b/mps/code/protsgix.c
index 80a2f94dff0..9552d18eeca 100644
--- a/mps/code/protsgix.c
+++ b/mps/code/protsgix.c
@@ -78,6 +78,8 @@ static void sigHandle(int sig, siginfo_t *info, void *context)  /* .sigh.args */
   /* sigset renamed to asigset due to clash with global on Darwin. */
   sigset_t asigset, oldset;
   struct sigaction sa;
+  
+  UNUSED(context);
 
   UNUSED(context);
   AVER(sig == PROT_SIGNAL);
diff --git a/mps/code/ss.c b/mps/code/ss.c
new file mode 100644
index 00000000000..084682b2a23
--- /dev/null
+++ b/mps/code/ss.c
@@ -0,0 +1,106 @@
+/* ss.c: STACK SCANNING
+ *
+ * $Id$
+ * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
+ *
+ *  This is part of the code that scans the stack and fixes the registers
+ *  that may contain roots.  See <design/thread-manager/>
+ *
+ *  Each platform ABI has a set of callee-save registers that may still
+ *  contain roots.  The StackScan function is defined for each ABI in source
+ *  files like ss*.c and ss*.asm.  That function saves the callee save
+ *  registers in its frame, then calls StackScanInner to do the scanning.
+ */
+
+#include "mpm.h"
+
+SRCID(ss, "$Id$");
+
+
+/* StackScanInner -- carry out stack scanning
+ *
+ * This function should be called by StackScan once it has saved the
+ * callee-save registers for the platform ABI in order to do the actual
+ * scanning.
+ */
+
+Res StackScanInner(ScanState ss,
+                   Addr *stackBot,
+                   Addr *stackTop,
+                   Count nSavedRegs)
+{
+  Arena arena;
+  Res res;
+
+  AVERT(ScanState, ss);
+  AVER(stackTop < stackBot);
+  AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
+  AVER(0 < nSavedRegs && nSavedRegs < 128);     /* sanity check */
+
+  arena = ss->arena;
+
+  /* If a stack pointer was stored when we entered the arena (through the
+     MPS interface in mpsi*.c) then we scan just the saved registers and
+     the stack starting there, in order to avoid false ambiguous references
+     in the MPS stack.  This is particularly important for transforms
+     (trans.c).  Otherwise, scan the whole stack. */
+
+  if (arena->stackAtArenaEnter != NULL) {
+    AVER(stackTop < arena->stackAtArenaEnter);
+    AVER(arena->stackAtArenaEnter < stackBot);
+    res = TraceScanAreaTagged(ss, stackTop, stackTop + nSavedRegs);
+    if (res != ResOK)
+      return res;
+    res = TraceScanAreaTagged(ss, arena->stackAtArenaEnter, stackBot);
+    if (res != ResOK)
+      return res;
+  } else {
+    res = TraceScanAreaTagged(ss, stackTop, stackBot);
+    if (res != ResOK)
+      return res;
+  }
+
+  return ResOK;
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * All rights reserved.  This is an open source license.  Contact
+ * Ravenbrook for commercial licensing options.
+ * 
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ * 
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 
+ * 3. Redistributions in any form must be accompanied by information on how
+ * to obtain complete source code for this software and any accompanying
+ * software that uses this software.  The source code must either be
+ * included in the distribution or be available for no more than the cost
+ * of distribution plus a nominal fee, and must be freely redistributable
+ * under reasonable conditions.  For an executable file, complete source
+ * code means the source code for all modules it contains. It does not
+ * include source code for modules or files that typically accompany the
+ * major components of the operating system on which the executable file
+ * runs.
+ * 
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+ * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+ * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+ * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
diff --git a/mps/code/ss.h b/mps/code/ss.h
index 14c0fd19d70..831ad98aea8 100644
--- a/mps/code/ss.h
+++ b/mps/code/ss.h
@@ -12,24 +12,34 @@
 #include "mpm.h"
 
 
-/*  == StackScan ==
+/* StackScan -- scan the current thread's stack
  *
- *  StackScan scans the current stack between the
- *  stackBot and the current top of stack. It also fixes
- *  any roots which may be in registers.
+ * StackScan scans the stack of the current thread, Between stackBot and the
+ * current top of stack. It also fixes any roots which may be in callee-save
+ * registers.
  *
- *  See the specific implementation for the exact registers which
- *  are scanned.
+ * See the specific implementation for the exact registers which are scanned.
  *
- *  The word pointed to by stackBot is fixed if the stack
- *  is by convention empty, and not fixed if it is full.
- *  Where empty means sp points to first free word beyond the top of
- *  stack.  Full means sp points to the top of stack itself.
+ * If a stack pointer has been stashed at arena entry (through the MPS
+ * interface in mpsi*.c) then only the registers and the stack between
+ * stackAtArenaEnter and stackBot is scanned, to avoid scanning false
+ * ambiguous references on the MPS's own stack.  This is particularly
+ * important for transforms (trans.c).
+ *
+ * The word pointed to by stackBot is fixed if the stack is by convention
+ * empty, and not fixed if it is full.  Where empty means sp points to first
+ * free word beyond the top of stack.  Full means sp points to the top of
+ * stack itself.
  */
 
 extern Res StackScan(ScanState ss, Addr *stackBot);
 
 
+extern Res StackScanInner(ScanState ss,
+                          Addr *stackBot,
+                          Addr *stackTop,
+                          Count nSavedRegs);
+
 #endif /* ss_h */
 
 
diff --git a/mps/code/ssixi3.c b/mps/code/ssixi3.c
index 04601803438..8cc1f8cbd45 100644
--- a/mps/code/ssixi3.c
+++ b/mps/code/ssixi3.c
@@ -52,8 +52,6 @@ SRCID(ssixi3, "$Id$");
 Res StackScan(ScanState ss, Addr *stackBot)
 {
   Addr calleeSaveRegs[4];
-  Addr *stackTop;
-  Res res;
 
   /* .assume.asm.stack */
   /* Store the callee save registers on the stack so they get scanned 
@@ -63,12 +61,8 @@ Res StackScan(ScanState ss, Addr *stackBot)
   ASMV("mov %%esi, %0" : "=m" (calleeSaveRegs[1]));
   ASMV("mov %%edi, %0" : "=m" (calleeSaveRegs[2]));
   ASMV("mov %%ebp, %0" : "=m" (calleeSaveRegs[3]));
-  ASMV("mov %%esp, %0" : "=r" (stackTop) :);    /* stackTop = esp */
-
-  AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
-  res = TraceScanAreaTagged(ss, stackTop, stackBot);
-
-  return res;
+  
+  return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs));
 }
 
 
diff --git a/mps/code/ssixi6.c b/mps/code/ssixi6.c
index 6eeac9ae45b..70954edb5da 100644
--- a/mps/code/ssixi6.c
+++ b/mps/code/ssixi6.c
@@ -50,21 +50,19 @@ SRCID(ssixi6, "$Id$");
 Res StackScan(ScanState ss, Addr *stackBot)
 {
   Addr calleeSaveRegs[6];
-  Addr *stackTop;
-  Res res;
-
+  
+  /* .assume.asm.stack */
+  /* Store the callee save registers on the stack so they get scanned
+   * as they may contain roots.
+   */
   ASMV("mov %%rbp, %0" : "=m" (calleeSaveRegs[0]));
   ASMV("mov %%rbx, %0" : "=m" (calleeSaveRegs[1]));
   ASMV("mov %%r12, %0" : "=m" (calleeSaveRegs[2]));
   ASMV("mov %%r13, %0" : "=m" (calleeSaveRegs[3]));
   ASMV("mov %%r14, %0" : "=m" (calleeSaveRegs[4]));
   ASMV("mov %%r15, %0" : "=m" (calleeSaveRegs[5]));
-  ASMV("mov %%rsp, %0" : "=r" (stackTop) :);    /* stackTop = rsp */
-
-  AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .assume.align */
-  res = TraceScanAreaTagged(ss, stackTop, stackBot);
-
-  return res;
+  
+  return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs));
 }
 
 
diff --git a/mps/code/ssw3i3mv.c b/mps/code/ssw3i3mv.c
new file mode 100755
index 00000000000..e09b53ec620
--- /dev/null
+++ b/mps/code/ssw3i3mv.c
@@ -0,0 +1,35 @@
+/* ssw3mv.c: STACK SCANNING FOR WIN32 WITH MICROSOFT C
+ *
+ * $Id$
+ * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
+ *
+ * This scans the stack and fixes the registers which may contain roots.
+ * See <design/thread-manager/>.
+ */
+
+#include "mpm.h"
+#include <setjmp.h>
+
+SRCID(ssw3mv, "$Id$");
+
+
+Res StackScan(ScanState ss, Addr *stackBot)
+{
+  jmp_buf jb;
+
+  /* We rely on the fact that Microsoft C's setjmp stores the callee-save
+     registers in the jmp_buf. */
+  (void)setjmp(jb);
+
+  /* These checks will just serve to warn us at compile-time if the
+     setjmp.h header changes to indicate that the registers we want aren't
+     saved any more. */
+  AVER(sizeof(((_JUMP_BUFFER *)jb)->Edi) == sizeof(Addr));
+  AVER(sizeof(((_JUMP_BUFFER *)jb)->Esi) == sizeof(Addr));
+  AVER(sizeof(((_JUMP_BUFFER *)jb)->Ebx) == sizeof(Addr));
+
+  AVER(offsetof(_JUMP_BUFFER, Edi) == offsetof(_JUMP_BUFFER, Ebx) + 4);
+  AVER(offsetof(_JUMP_BUFFER, Esi) == offsetof(_JUMP_BUFFER, Ebx) + 8);
+
+  return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Ebx, 3);
+}
diff --git a/mps/code/ssw3mv.c b/mps/code/ssw3i6mv.c
index 26753b79232..d3e1dd85f46 100755
--- a/mps/code/ssw3mv.c
+++ b/mps/code/ssw3i6mv.c
@@ -16,7 +16,6 @@ SRCID(ssw3mv, "$Id$");
 Res StackScan(ScanState ss, Addr *stackBot)
 {
   jmp_buf jb;
-  Addr *stackTop;
 
   /* We rely on the fact that Microsoft C's setjmp stores the callee-save
      registers in the jmp_buf. */
@@ -25,11 +24,6 @@ Res StackScan(ScanState ss, Addr *stackBot)
   /* These checks will just serve to warn us at compile-time if the
      setjmp.h header changes to indicate that the registers we want aren't
      saved any more. */
-#if defined(MPS_ARCH_I3)
-  AVER(sizeof(((_JUMP_BUFFER *)jb)->Edi) == sizeof(Addr));
-  AVER(sizeof(((_JUMP_BUFFER *)jb)->Esi) == sizeof(Addr));
-  AVER(sizeof(((_JUMP_BUFFER *)jb)->Ebx) == sizeof(Addr));
-#elif defined(MPS_ARCH_I6)
   AVER(sizeof(((_JUMP_BUFFER *)jb)->Rdi) == sizeof(Addr));
   AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsi) == sizeof(Addr));
   AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbp) == sizeof(Addr));
@@ -37,12 +31,16 @@ Res StackScan(ScanState ss, Addr *stackBot)
   AVER(sizeof(((_JUMP_BUFFER *)jb)->R13) == sizeof(Addr));
   AVER(sizeof(((_JUMP_BUFFER *)jb)->R14) == sizeof(Addr));
   AVER(sizeof(((_JUMP_BUFFER *)jb)->R15) == sizeof(Addr));
-#else
-#error "StackScan not verified for the target architecture"
-#endif
 
-  stackTop = (Addr *)jb;
-  AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr)));  /* .align */
-
-  return TraceScanAreaTagged(ss, stackTop, stackBot);
+  /* The layout of the jmp_buf forces us to harmlessly scan Rsp as well. */
+  AVER(offsetof(_JUMP_BUFFER, Rsp) == offsetof(_JUMP_BUFFER, Rbx) + 8);
+  AVER(offsetof(_JUMP_BUFFER, Rbp) == offsetof(_JUMP_BUFFER, Rbx) + 16);
+  AVER(offsetof(_JUMP_BUFFER, Rsi) == offsetof(_JUMP_BUFFER, Rbx) + 24);
+  AVER(offsetof(_JUMP_BUFFER, Rdi) == offsetof(_JUMP_BUFFER, Rbx) + 32);
+  AVER(offsetof(_JUMP_BUFFER, R12) == offsetof(_JUMP_BUFFER, Rbx) + 40);
+  AVER(offsetof(_JUMP_BUFFER, R13) == offsetof(_JUMP_BUFFER, Rbx) + 48);
+  AVER(offsetof(_JUMP_BUFFER, R14) == offsetof(_JUMP_BUFFER, Rbx) + 56);
+  AVER(offsetof(_JUMP_BUFFER, R15) == offsetof(_JUMP_BUFFER, Rbx) + 64);
+
+  return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Rbx, 9);
 }
diff --git a/mps/code/table.c b/mps/code/table.c
index e141bf1d8e2..7e6b1ec7149 100644
--- a/mps/code/table.c
+++ b/mps/code/table.c
@@ -8,60 +8,75 @@
  */
 
 #include "table.h"
-#include "mpmtypes.h"
+#include "mpm.h"
 
 #include <stddef.h>
-#include <stdlib.h>
-#include <assert.h>
-#include <stdio.h>
-#include "mpstd.h"
 
-typedef unsigned long ulong;
 
+SRCID(table, "$Id$");
 
-#define tableUNUSED    ((Word)0x2AB7E040)
-#define tableDELETED   ((Word)0x2AB7EDE7)
-#define tableACTIVE    ((Word)0x2AB7EAC2)
 
+/* TableHash -- return a hash value from an address
+ *
+ * This uses a single cycle of an MLCG, more commonly seen as a 
+ * pseudorandom number generator.  It works extremely well as a 
+ * hash function.
+ *
+ * (In particular, it is substantially better than simply doing this:
+ *   seed = (unsigned long)addr * 48271;
+ * Tested by RHSK 2010-12-28.)
+ *
+ * This MLCG is a full period generator: it cycles through every 
+ * number from 1 to m-1 before repeating.  Therefore, no two numbers 
+ * in that range hash to the same value.  Furthermore, it has prime 
+ * modulus, which tends to avoid recurring patterns in the low-order 
+ * bits, which is good because the hash will be used modulus the 
+ * number of slots in the table.
+ *
+ * Of course it's only a 31-bit cycle, so we start by losing the top 
+ * bit of the address, but that's hardly a great problem.
+ *
+ * The implementation is quite subtle.  See rnd() in testlib.c, where 
+ * it has been exhaustively (ie: totally) tested.  RHSK 2010-12-28.
+ *
+ * TODO: Check how this works out on 64-bit. RB 2012-09-04
+ */
+ 
+#define R_m 2147483647UL
+#define R_a 48271UL
 
-typedef struct TableEntryStruct *TableEntry;
-typedef struct TableEntryStruct {
-  Word status;
-  Word key;
-  void *value;
-} TableEntryStruct;
-
-
-typedef struct TableStruct {
-  size_t length;
-  size_t count;
-  size_t limit;
-  TableEntry array;
-} TableStruct;
-
+typedef Word Hash;
 
+static Hash TableHash(Word key)
+{
+  Hash seed = (Hash)(key & 0x7FFFFFFF);
+  /* requires m == 2^31-1, a < 2^16 */
+  Hash bot = R_a * (seed & 0x7FFF);
+  Hash top = R_a * (seed >> 15);
+  seed = bot + ((top & 0xFFFF) << 15) + (top >> 16);
+  if(seed > R_m)
+    seed -= R_m;
+  return seed;
+}
 
-/* sizeFloorLog2 -- logarithm base 2 */
 
-static size_t sizeFloorLog2(size_t size)
+Bool TableCheck(Table table)
 {
-  size_t l = 0;
-
-  assert(size != 0);
-  while(size > 1) {
-    ++l;
-    size >>= 1;
-  }
-  return l;
+  CHECKS(Table, table);
+  CHECKL(table->count <= table->length);
+  CHECKL(table->length == 0 || table->array != NULL);
+  CHECKL(FUNCHECK(table->alloc));
+  CHECKL(FUNCHECK(table->free));
+  /* can't check allocClosure -- it could be anything */
+  CHECKL(table->unusedKey != table->deletedKey);
+  return TRUE;
 }
 
 
-/* TableHash -- table hashing function */
-
-static ulong TableHash(Word key)
+static Bool entryIsActive(Table table, TableEntry entry)
 {
-  /* Shift some randomness into the low bits. */
-  return (ulong)((key >> 10) + key);
+  return !(entry->key == table->unusedKey ||
+           entry->key == table->deletedKey);
 }
 
 
@@ -72,69 +87,126 @@ static ulong TableHash(Word key)
  * that all the items still fit in after growing the table.
  */
 
-static TableEntry TableFind(Table table, Word key, int skip_deleted)
+static TableEntry TableFind(Table table, Word key, Bool skip_deleted)
 {
-  ulong hash;
-  size_t i, mask = table->length - 1;
- 
+  Hash hash;
+  Index i;
+  Word mask;
+
+  /* .find.visit: Ensure the length is a power of two so that the stride
+     is coprime and so visits all entries in the array eventually. */
+  AVER(WordIsP2(table->length)); /* .find.visit */
+
+  mask = table->length - 1; 
   hash = TableHash(key) & mask;
   i = hash;
   do {
-    switch (table->array[i].status) {
-    case tableACTIVE:
-      if (table->array[i].key == key)
-        return &table->array[i];
-      break;
-    case tableDELETED:
-      if (!skip_deleted)
-        return &table->array[i];
-      break;
-    case tableUNUSED:
+    Word k = table->array[i].key;
+    if (k == key ||
+        k == table->unusedKey ||
+        (!skip_deleted && key == table->deletedKey))
       return &table->array[i];
-      break;
-    }
-    i = (i + 1) & mask;
+    i = (i + (hash | 1)) & mask; /* .find.visit */
   } while(i != hash);
 
   return NULL;
 }
 
 
-/* TableGrow -- doubles the size of the table */
+/* TableGrow -- increase the capacity of the table
+ *
+ * Ensure the transform's hashtable can accommodate N entries (filled 
+ * slots), without becoming cramped.  If necessary, resize the 
+ * hashtable by allocating a new one and rehashing all old entries.
+ * If insufficient memory, return error without modifying table.
+ *
+ * .hash.spacefraction: As with all closed hash tables, we must choose 
+ * an appropriate proportion of slots to remain free.  More free slots 
+ * help avoid large-sized contiguous clumps of full cells and their 
+ * associated linear search costs. 
+ *
+ * .hash.initial: Any reasonable number.
+ *
+ * .hash.growth: A compromise between space inefficency (growing bigger 
+ * than required) and time inefficiency (growing too slowly, with all 
+ * the rehash costs at every step).  A factor of 2 means that at the 
+ * point of growing to a size X table, hash-work equivalent to filling 
+ * a size-X table has already been done.  So we do at most 2x the 
+ * hash-work we would have done if we had been able to guess the right 
+ * table size initially.
+ *
+ * Numbers of slots maintain this relation:
+ *     occupancy <= capacity < enough <= cSlots
+ */
+
+#define SPACEFRACTION 0.75      /* .hash.spacefraction */
 
-static Res TableGrow(Table table)
+Res TableGrow(Table table, Count extraCapacity)
 {
   TableEntry oldArray, newArray;
-  size_t i, oldLength, newLength;
+  Count oldLength, newLength;
+  Count required, minimum;
+  Count i, found;
+
+  required = table->count + extraCapacity;
+  if (required < table->count)  /* overflow? */
+    return ResLIMIT;
+
+  /* Calculate the minimum table length that would allow for the required
+     capacity without growing again. */
+  minimum = (Count)(required / SPACEFRACTION);
+  if (minimum < required)       /* overflow? */
+    return ResLIMIT;
 
+  /* Double the table length until it's larger than the minimum */
   oldLength = table->length;
+  newLength = oldLength;
+  while(newLength < minimum) {
+    Count doubled = newLength > 0 ? newLength * 2 : 1; /* .hash.growth */
+    if (doubled <= newLength)   /* overflow? */
+      return ResLIMIT;
+    newLength = doubled;
+  }
+
+  if (newLength == oldLength)   /* already enough space? */
+    return ResOK;
+
+  /* TODO: An event would be good here */
+
   oldArray = table->array;
-  newLength = oldLength * 2;
-  newArray = malloc(sizeof(TableEntryStruct) * newLength);
-  if(newArray == NULL) return ResMEMORY;
+  newArray = table->alloc(table->allocClosure,
+                          sizeof(TableEntryStruct) * newLength);
+  if(newArray == NULL)
+    return ResMEMORY;
 
   for(i = 0; i < newLength; ++i) {
-    newArray[i].key = 0;
+    newArray[i].key = table->unusedKey;
     newArray[i].value = NULL;
-    newArray[i].status = tableUNUSED;
   }
  
   table->length = newLength;
   table->array = newArray;
-  table->limit *= 2;
 
+  found = 0;
   for(i = 0; i < oldLength; ++i) {
-    if (oldArray[i].status == tableACTIVE) {
+    if (entryIsActive(table, &oldArray[i])) {
       TableEntry entry;
-      entry = TableFind(table, oldArray[i].key, 0 /* none deleted */);
-      assert(entry != NULL);
-      assert(entry->status == tableUNUSED);
+      entry = TableFind(table, oldArray[i].key, FALSE /* none deleted */);
+      AVER(entry != NULL);
+      AVER(entry->key == table->unusedKey);
       entry->key = oldArray[i].key;
       entry->value = oldArray[i].value;
-      entry->status = tableACTIVE;
+      ++found;
     }
   }
-  free(oldArray);
+  AVER(found == table->count);
+
+  if (oldLength > 0) {
+    AVER(oldArray != NULL);
+    table->free(table->allocClosure,
+                oldArray,
+                sizeof(TableEntryStruct) * oldLength);
+  }
 
   return ResOK;
 }
@@ -142,35 +214,44 @@ static Res TableGrow(Table table)
 
 /* TableCreate -- makes a new table */
 
-extern Res TableCreate(Table *tableReturn, size_t length)
+extern Res TableCreate(Table *tableReturn,
+                       Count length,
+                       TableAllocMethod tableAlloc,
+                       TableFreeMethod tableFree,
+                       void *allocClosure,
+                       Word unusedKey,
+                       Word deletedKey)
 {
   Table table;
-  size_t i;
+  Res res;
+
+  AVER(tableReturn != NULL);
+  AVER(FUNCHECK(tableAlloc));
+  AVER(FUNCHECK(tableFree));
+  AVER(unusedKey != deletedKey);
 
-  assert(tableReturn != NULL);
+  table = tableAlloc(allocClosure, sizeof(TableStruct));
+  if(table == NULL)
+    return ResMEMORY;
 
-  table = malloc(sizeof(TableStruct));
-  if(table == NULL) goto failMallocTable;
-  if (length < 2) length = 2;
-  /* Table size is length rounded up to the next power of 2. */
-  table->length = (size_t)1 << (sizeFloorLog2(length-1) + 1);
+  table->length = 0;
   table->count = 0;
-  table->limit = (size_t)(.5 * length);
-  table->array = malloc(sizeof(TableEntryStruct) * length);
-  if(table->array == NULL) goto failMallocArray;
-  for(i = 0; i < length; ++i) {
-    table->array[i].key = 0;
-    table->array[i].value = NULL;
-    table->array[i].status = tableUNUSED;
-  }
+  table->array = NULL;
+  table->alloc = tableAlloc;
+  table->free = tableFree;
+  table->allocClosure = allocClosure;
+  table->unusedKey = unusedKey;
+  table->deletedKey = deletedKey;
+  table->sig = TableSig;
+  
+  AVERT(Table, table);
+
+  res = TableGrow(table, length);
+  if (res != ResOK)
+    return res;
  
   *tableReturn = table;
   return ResOK;
-
-failMallocArray:
-  free(table);
-failMallocTable:
-  return ResMEMORY;
 }
 
 
@@ -178,9 +259,15 @@ failMallocTable:
 
 extern void TableDestroy(Table table)
 {
-  assert(table != NULL);
-  free(table->array);
-  free(table);
+  AVER(table != NULL);
+  if (table->length > 0) {
+    AVER(table->array != NULL);
+    table->free(table->allocClosure,
+                table->array,
+                sizeof(TableEntryStruct) * table->length);
+  }
+  table->sig = SigInvalid;
+  table->free(table->allocClosure, table, sizeof(TableStruct));
 }
 
 
@@ -188,9 +275,9 @@ extern void TableDestroy(Table table)
 
 extern Bool TableLookup(void **valueReturn, Table table, Word key)
 {
-  TableEntry entry = TableFind(table, key, 1 /* skip deleted */);
+  TableEntry entry = TableFind(table, key, TRUE /* skip deleted */);
 
-  if(entry == NULL || entry->status != tableACTIVE)
+  if(entry == NULL || !entryIsActive(table, entry))
     return FALSE;
   *valueReturn = entry->value;
   return TRUE;
@@ -202,24 +289,26 @@ extern Bool TableLookup(void **valueReturn, Table table, Word key)
 extern Res TableDefine(Table table, Word key, void *value)
 {
   TableEntry entry;
+  
+  AVER(key != table->unusedKey);
+  AVER(key != table->deletedKey);
 
-  if (table->count >= table->limit) {
-    Res res = TableGrow(table);
+  if (table->count >= table->length * SPACEFRACTION) {
+    Res res = TableGrow(table, 1);
     if(res != ResOK) return res;
-    entry = TableFind(table, key, 0 /* no deletions yet */);
-    assert(entry != NULL);
-    if (entry->status == tableACTIVE)
+    entry = TableFind(table, key, FALSE /* no deletions yet */);
+    AVER(entry != NULL);
+    if (entryIsActive(table, entry))
       return ResFAIL;
   } else {
-    entry = TableFind(table, key, 1 /* skip deleted */);
-    if (entry != NULL && entry->status == tableACTIVE)
+    entry = TableFind(table, key, TRUE /* skip deleted */);
+    if (entry != NULL && entryIsActive(table, entry))
       return ResFAIL;
     /* Search again to find the best slot, deletions included. */
-    entry = TableFind(table, key, 0 /* don't skip deleted */);
-    assert(entry != NULL);
+    entry = TableFind(table, key, FALSE /* don't skip deleted */);
+    AVER(entry != NULL);
   }
 
-  entry->status = tableACTIVE;
   entry->key = key;
   entry->value = value;
   ++table->count;
@@ -232,11 +321,11 @@ extern Res TableDefine(Table table, Word key, void *value)
 
 extern Res TableRedefine(Table table, Word key, void *value)
 {
-  TableEntry entry = TableFind(table, key, 1 /* skip deletions */);
+  TableEntry entry = TableFind(table, key, TRUE /* skip deletions */);
  
-  if (entry == NULL || entry->status != tableACTIVE)
+  if (entry == NULL || !entryIsActive(table, entry))
     return ResFAIL;
-  assert(entry->key == key);
+  AVER(entry->key == key);
   entry->value = value;
   return ResOK;
 }
@@ -246,11 +335,11 @@ extern Res TableRedefine(Table table, Word key, void *value)
 
 extern Res TableRemove(Table table, Word key)
 {
-  TableEntry entry = TableFind(table, key, 1);
+  TableEntry entry = TableFind(table, key, TRUE);
 
-  if (entry == NULL || entry->status != tableACTIVE)
+  if (entry == NULL || !entryIsActive(table, entry))
     return ResFAIL;
-  entry->status = tableDELETED;
+  entry->key = table->deletedKey;
   --table->count;
   return ResOK;
 }
@@ -258,18 +347,20 @@ extern Res TableRemove(Table table, Word key)
 
 /* TableMap -- apply a function to all the mappings */
 
-extern void TableMap(Table table, void(*fun)(Word key, void*value))
+extern void TableMap(Table table,
+                     void (*fun)(void *closure, Word key, void*value),
+                     void *closure)
 {
-  size_t i;
+  Index i;
   for (i = 0; i < table->length; i++)
-    if (table->array[i].status == tableACTIVE)
-      (*fun)(table->array[i].key, table->array[i].value);
+    if (entryIsActive(table, &table->array[i]))
+      (*fun)(closure, table->array[i].key, table->array[i].value);
 }
 
 
 /* TableCount -- count the number of mappings in the table */
 
-extern size_t TableCount(Table table)
+extern Count TableCount(Table table)
 {
   return table->count;
 }
diff --git a/mps/code/table.h b/mps/code/table.h
index 1b9840a7b25..1697be09b9b 100644
--- a/mps/code/table.h
+++ b/mps/code/table.h
@@ -13,14 +13,46 @@
 
 typedef struct TableStruct *Table;
 
-extern Res TableCreate(Table *tableReturn, size_t length);
+#define TableSig        ((Sig)0x5192AB13) /* SIGnature TABLE */
+
+typedef void *(*TableAllocMethod)(void *closure, size_t size);
+typedef void (*TableFreeMethod)(void *closure, void *p, size_t size);
+
+typedef struct TableEntryStruct {
+  Word key;
+  void *value;
+} TableEntryStruct, *TableEntry;
+
+typedef struct TableStruct {
+  Sig sig;                      /* <design/sig/> */
+  Count length;                 /* Number of slots in the array */
+  Count count;                  /* Active entries in the table */
+  TableEntry array;             /* Array of table slots */
+  TableAllocMethod alloc;
+  TableFreeMethod free;
+  void *allocClosure;
+  Word unusedKey;               /* key marking unused (undefined) entries */
+  Word deletedKey;              /* key marking deleted entries */
+} TableStruct;
+
+extern Res TableCreate(Table *tableReturn,
+                       Count length,
+                       TableAllocMethod tableAlloc,
+                       TableFreeMethod tableFree,
+                       void *allocClosure,
+                       Word unusedKey,
+                       Word deletedKey);
 extern void TableDestroy(Table table);
+extern Bool TableCheck(Table table);
 extern Res TableDefine(Table table, Word key, void *value);
 extern Res TableRedefine(Table table, Word key, void *value);
 extern Bool TableLookup(void **valueReturn, Table table, Word key);
 extern Res TableRemove(Table table, Word key);
-extern size_t TableCount(Table table);
-extern void TableMap(Table table, void(*fun)(Word key, void *value));
+extern Count TableCount(Table table);
+extern void TableMap(Table table,
+                     void(*fun)(void *closure, Word key, void *value),
+                     void *closure);
+extern Res TableGrow(Table table, Count extraCapacity);
 
 
 #endif /* table_h */
diff --git a/mps/code/testlib.c b/mps/code/testlib.c
index d7f4bc60418..06d0641c688 100644
--- a/mps/code/testlib.c
+++ b/mps/code/testlib.c
@@ -32,6 +32,15 @@ struct itimerspec; /* stop complaints from time.h */
 #endif
 
 
+/* fail -- like assert, but (notionally) returns a value, so usable in an expression */
+
+int fail(void)
+{
+  Insist(FALSE);
+  return 1111UL;
+}
+
+
 /* rnd -- a random number generator
  *
  * We use the (Multiplicative) Linear Congruential Generator
diff --git a/mps/code/testlib.h b/mps/code/testlib.h
index 3d187080fc2..d16f4fb6eef 100644
--- a/mps/code/testlib.h
+++ b/mps/code/testlib.h
@@ -88,6 +88,7 @@
 #define PRIXLONGEST "llX"
 #define PRIwWORD "16"
 typedef unsigned long long ulongest_t;
+typedef long long longest_t;
 #define MPS_WORD_CONST(n) (n##ull)
 #else
 #define PRIuLONGEST "lu"
@@ -95,6 +96,7 @@ typedef unsigned long long ulongest_t;
 #define PRIXLONGEST "lX"
 #define PRIwWORD "8"
 typedef unsigned long ulongest_t;
+typedef long longest_t;
 #define MPS_WORD_CONST(n) (n##ul)
 #endif
 #define PRIXPTR     "0"PRIwWORD PRIXLONGEST
@@ -164,6 +166,11 @@ extern void verror(const char *format, va_list args);
     cdie(cond, condstring "\n" __FILE__ "\n" STR(__LINE__))
 
 
+/* fail -- like assert, but (notionally) returns a value, so usable in an expression */
+
+extern int fail(void);
+
+
 /* rnd -- random number generator
  *
  * rnd() generates a sequence of integers in the range [1, 2^31-2].
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 8ff9bf8bdf1..9771797337d 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -39,6 +39,7 @@ Bool ScanStateCheck(ScanState ss)
 
   CHECKS(ScanState, ss);
   CHECKL(FUNCHECK(ss->fix));
+  /* Can't check ss->fixClosure. */
   CHECKL(ss->zoneShift == ss->arena->zoneShift);
   white = ZoneSetEMPTY;
   TRACE_SET_ITER(ti, trace, ss->traces, ss->arena)
@@ -69,12 +70,28 @@ void ScanStateInit(ScanState ss, TraceSet ts, Arena arena,
   AVER(RankCheck(rank));
   /* white is arbitrary and can't be checked */
 
-  ss->fix = TraceFix;
-  TRACE_SET_ITER(ti, trace, ts, arena)
-    if(trace->emergency) {
-      ss->fix = TraceFixEmergency;
+  /* NOTE: We can only currently support scanning for a set of traces with
+     the same fix method and closure.  To remove this restriction,
+     it would be necessary to dispatch to the fix methods of sets of traces
+     in TraceFix. */
+  ss->fix = NULL;
+  ss->fixClosure = NULL;
+  TRACE_SET_ITER(ti, trace, ts, arena) {
+    if (ss->fix == NULL) {
+      ss->fix = trace->fix;
+      ss->fixClosure = trace->fixClosure;
+    } else {
+      AVER(ss->fix == trace->fix);
+      AVER(ss->fixClosure == trace->fixClosure);
     }
-  TRACE_SET_ITER_END(ti, trace, ts, arena);
+  } TRACE_SET_ITER_END(ti, trace, ts, arena);
+  AVER(ss->fix != NULL);
+
+  /* If the fix method is the normal GC fix, then we optimise the test for
+     whether it's an emergency or not by updating the dispatch here, once. */
+  if (ss->fix == PoolFix && ArenaEmergency(arena))
+        ss->fix = PoolFixEmergency;
+
   ss->rank = rank;
   ss->traces = ts;
   ss->zoneShift = arena->zoneShift;
@@ -174,10 +191,11 @@ Bool TraceCheck(Trace trace)
   if(trace->state == TraceFLIPPED) {
     CHECKL(RankCheck(trace->band));
   }
-  CHECKL(BoolCheck(trace->emergency));
   if(trace->chain != NULL) {
     CHECKU(Chain, trace->chain);
   }
+  CHECKL(FUNCHECK(trace->fix));
+  /* Can't check trace->fixClosure. */
 
   /* @@@@ checks for counts missing */
 
@@ -303,24 +321,6 @@ static void traceSetUpdateCounts(TraceSet ts, Arena arena, ScanState ss,
 }
 
 
-/* traceSetSignalEmergency -- move a set of traces into emergency mode. */
-
-static void traceSetSignalEmergency(TraceSet ts, Arena arena)
-{
-  TraceId ti;
-  Trace trace;
-
-  DIAG_SINGLEF(( "traceSetSignalEmergency",
-    "traceSet: $B", (WriteFB)ts, NULL ));
-
-  TRACE_SET_ITER(ti, trace, ts, arena)
-    trace->emergency = TRUE;
-  TRACE_SET_ITER_END(ti, trace, ts, arena);
-
-  return;
-}
-
-
 /* traceSetWhiteUnion
  *
  * Returns a ZoneSet describing the union of the white sets of all the
@@ -360,7 +360,7 @@ Res TraceAddWhite(Trace trace, Seg seg)
   if(res != ResOK)
     return res;
 
-  /* Add the segment to the approximation of the white set the */
+  /* Add the segment to the approximation of the white set if the */
   /* pool made it white. */
   if(TraceSetIsMember(SegWhite(seg), trace)) {
     trace->white = ZoneSetUnion(trace->white, ZoneSetOfSeg(trace->arena, seg));
@@ -474,23 +474,23 @@ static Res traceScanRootRes(TraceSet ts, Rank rank, Arena arena, Root root)
 
 /* traceScanRoot
  *
- * Scan a root without fail.  The traces may enter emergency mode to
- * ensure this.  */
+ * Scan a root, entering emergency mode on allocation failure.
+ */
 
-static void traceScanRoot(TraceSet ts, Rank rank, Arena arena, Root root)
+static Res traceScanRoot(TraceSet ts, Rank rank, Arena arena, Root root)
 {
   Res res;
 
   res = traceScanRootRes(ts, rank, arena, root);
-  if(res != ResOK) {
-    AVER(ResIsAllocFailure(res));
-    traceSetSignalEmergency(ts, arena);
+
+  if (ResIsAllocFailure(res)) {
+    ArenaSetEmergency(arena, TRUE);
     res = traceScanRootRes(ts, rank, arena, root);
     /* Should be OK in emergency mode */
+    AVER(!ResIsAllocFailure(res));
   }
-  AVER(ResOK == res);
 
-  return;
+  return res;
 }
 
 
@@ -505,6 +505,7 @@ struct rootFlipClosureStruct {
 static Res rootFlip(Root root, void *p)
 {
   struct rootFlipClosureStruct *rf = (struct rootFlipClosureStruct *)p;
+  Res res;
 
   AVERT(Root, root);
   AVER(p != NULL);
@@ -514,18 +515,47 @@ static Res rootFlip(Root root, void *p)
 
   AVER(RootRank(root) <= RankEXACT); /* see .root.rank */
 
-  if(RootRank(root) == rf->rank)
-    traceScanRoot(rf->ts, rf->rank, rf->arena, root);
+  if(RootRank(root) == rf->rank) {
+    res = traceScanRoot(rf->ts, rf->rank, rf->arena, root);
+    if (res != ResOK)
+      return res;
+  }
 
   return ResOK;
 }
 
-static void traceFlip(Trace trace)
+
+/* traceFlip -- flip the mutator from grey to black w.r.t. a trace
+ *
+ * The main job of traceFlip is to scan references which can't be protected
+ * from the mutator, changing the colour of the mutator from grey to black
+ * with respect to a trace.  The mutator threads are suspended while this
+ * is happening, and the mutator perceives and instantaneous change in all
+ * the references, enforced by the shield (barrier) system.
+ *
+ * NOTE: We don't have a way to shield the roots, so they are all scanned
+ * here.  This is a coincidence.  There is no particular reason that the
+ * roots have to be scanned at flip time.  (The thread registers are unlikely
+ * ever to be protectable on stock hardware, however.)
+ *
+ * NOTE: Ambiguous references may only exist in roots, because we can't
+ * shield the exact roots and defer them for later scanning (after ambiguous
+ * heap references).
+ *
+ * NOTE: We don't support weak or final roots because we can't shield them
+ * and defer scanning until later.  See above.
+ *
+ * If roots and segments were more similar, we could melt a lot of these
+ * problems.
+ */
+
+static Res traceFlip(Trace trace)
 {
   Ring node, nextNode;
   Arena arena;
   Rank rank;
   struct rootFlipClosureStruct rfc;
+  Res res;
 
   AVERT(Trace, trace);
   rfc.ts = TraceSetSingle(trace);
@@ -555,11 +585,10 @@ static void traceFlip(Trace trace)
   /* higher ranking roots than data in pools. */
 
   for(rank = RankAMBIG; rank <= RankEXACT; ++rank) {
-    Res res;
-
     rfc.rank = rank;
     res = RootsIterate(ArenaGlobals(arena), rootFlip, (void *)&rfc);
-    AVER(res == ResOK);
+    if (res != ResOK)
+      goto failRootFlip;
   }
 
   /* .flip.alloc: Allocation needs to become black now. While we flip */
@@ -595,8 +624,11 @@ static void traceFlip(Trace trace)
   EVENT2(TraceFlipEnd, trace, arena);
 
   ShieldResume(arena);
+  return ResOK;
 
-  return;
+failRootFlip:
+  ShieldResume(arena);
+  return res;
 }
 
 /* traceCopySizes -- preserve size information for later use
@@ -668,7 +700,8 @@ found:
   trace->ti = ti;
   trace->state = TraceINIT;
   trace->band = RankAMBIG;      /* Required to be the earliest rank. */
-  trace->emergency = FALSE;
+  trace->fix = PoolFix;
+  trace->fixClosure = NULL;
   trace->chain = NULL;
   STATISTIC(trace->preTraceArenaReserved = ArenaReserved(arena));
   trace->condemned = (Size)0;   /* nothing condemned yet */
@@ -908,7 +941,7 @@ Rank TraceRankForAccess(Arena arena, Seg seg)
  *
  * .check.ambig.not: RankAMBIG segments never appear on the grey ring.
  * The current tracer cannot support ambiguous reference except as
- * roots, so it's a buf if we ever find any.  This behaviour is not set
+ * roots, so it's a bug if we ever find any.  This behaviour is not set
  * in stone, it's possible to imagine changing the tracer so that we can
  * support ambiguous objects one day.  For example, a fully conservative
  * non-moving mode.
@@ -1180,23 +1213,23 @@ static Res traceScanSegRes(TraceSet ts, Rank rank, Arena arena, Seg seg)
 
 /* traceScanSeg
  *
- * Scans a segment without fail.  May put the traces into emergency mode
- * to ensure this.  */
+ * Scans a segment, switching to emergency mode if there is an allocation
+ * failure.
+ */
 
-static void traceScanSeg(TraceSet ts, Rank rank, Arena arena, Seg seg)
+static Res traceScanSeg(TraceSet ts, Rank rank, Arena arena, Seg seg)
 {
   Res res;
 
   res = traceScanSegRes(ts, rank, arena, seg);
-  if(res != ResOK) {
-    AVER(ResIsAllocFailure(res));
-    traceSetSignalEmergency(ts, arena);
+  if(ResIsAllocFailure(res)) {
+    ArenaSetEmergency(arena, TRUE);
     res = traceScanSegRes(ts, rank, arena, seg);
     /* Should be OK in emergency mode. */
+    AVER(!ResIsAllocFailure(res));
   }
-  AVER(ResOK == res);
 
-  return;
+  return res;
 }
 
 
@@ -1204,6 +1237,8 @@ static void traceScanSeg(TraceSet ts, Rank rank, Arena arena, Seg seg)
 
 void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
 {
+  Res res;
+
   AVERT(Arena, arena);
   AVERT(Seg, seg);
 
@@ -1226,9 +1261,13 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
     
     /* Pick set of traces to scan for: */
     TraceSet traces = arena->flippedTraces;
-    
     rank = TraceRankForAccess(arena, seg);
-    traceScanSeg(traces, rank, arena, seg);      
+    res = traceScanSeg(traces, rank, arena, seg);      
+
+    /* Allocation failures should be handled my emergency mode, and we don't
+       expect any other kind of failure in a normal GC that causes access
+       faults. */
+    AVER(res == ResOK);
 
     /* The pool should've done the job of removing the greyness that */
     /* was causing the segment to be protected, so that the mutator */
@@ -1254,20 +1293,31 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode)
 }
 
 
-/* TraceFix -- fix a reference */
+/* TraceFix2 -- second stage of fixing a reference
+ *
+ * TraceFix is on the critical path.  A one-instruction difference in the
+ * early parts of this code will have a significant impact on overall run
+ * time.  The priority is to eliminate irrelevant references early and fast
+ * using the colour information stored in the tract table.
+ */
 
-Res TraceFix(ScanState ss, Ref *refIO)
+static Res TraceFix2(ScanState ss, Ref *refIO)
 {
   Ref ref;
   Tract tract;
-  Pool pool;
 
+  /* Special AVER macros are used on the critical path. */
   /* See <design/trace/#fix.noaver> */
   AVERT_CRITICAL(ScanState, ss);
   AVER_CRITICAL(refIO != NULL);
 
   ref = *refIO;
 
+  /* The zone test should already have been passed by MPS_FIX1 in mps.h. */
+  AVER_CRITICAL(ZoneSetInter(ss->white,
+                             ZoneSetAdd(ss->arena, ZoneSetEMPTY, ref)) !=
+                ZoneSetEMPTY);
+
   STATISTIC(++ss->fixRefCount);
   EVENT4(TraceFix, ss, refIO, ref, ss->rank);
 
@@ -1277,17 +1327,18 @@ Res TraceFix(ScanState ss, Ref *refIO)
       Seg seg;
       if(TRACT_SEG(&seg, tract)) {
         Res res;
+        Pool pool;
         STATISTIC(++ss->segRefCount);
         STATISTIC(++ss->whiteSegRefCount);
         EVENT1(TraceFixSeg, seg);
         EVENT0(TraceFixWhite);
         pool = TractPool(tract);
-        /* Could move the rank switch here from the class-specific */
-        /* fix methods. */
-        res = PoolFix(pool, ss, seg, refIO);
+        res = (*ss->fix)(pool, ss, seg, refIO);
         if(res != ResOK) {
-          /* Fix protocol (de facto): if Fix fails, ref must be unchanged */
-          /* Justification for this restriction:
+          /* PoolFixEmergency should never fail. */
+          AVER_CRITICAL(ss->fix != PoolFixEmergency);
+          /* Fix protocol (de facto): if Fix fails, ref must be unchanged
+           * Justification for this restriction:
            * A: it simplifies;
            * B: it's reasonable (given what may cause Fix to fail);
            * C: the code (here) already assumes this: it returns without 
@@ -1296,6 +1347,14 @@ Res TraceFix(ScanState ss, Ref *refIO)
           AVER(*refIO == ref);
           return res;
         }
+      } else {
+        /* Only tracts with segments ought to have been condemned. */
+        /* SegOfAddr FALSE => a ref into a non-seg Tract (poolmv etc) */
+        /* .notwhite: ...But it should NOT be white.  
+         * [I assert this both from logic, and from inspection of the 
+         * current condemn code.  RHSK 2010-11-30]
+         */
+        NOTREACHED;
       }
     } else {
       /* Tract isn't white. Don't compute seg for non-statistical */
@@ -1322,56 +1381,18 @@ Res TraceFix(ScanState ss, Ref *refIO)
 }
 
 
-/* TraceFixEmergency -- fix a reference in emergency mode */
+/* mps_fix2 -- external interface to TraceFix
+ *
+ * We rely on compiler inlining to make this equivalent to TraceFix, because
+ * the name "TraceFix" is pervasive in the MPS.  That's also why this
+ * function is in trace.c and not mpsi.c.
+ */
 
-Res TraceFixEmergency(ScanState ss, Ref *refIO)
+mps_res_t mps_fix2(mps_ss_t mps_ss, mps_addr_t *mps_ref_io)
 {
-  Ref ref;
-  Tract tract;
-  Pool pool;
-
-  AVERT(ScanState, ss);
-  AVER(refIO != NULL);
-
-  ref = *refIO;
-
-  STATISTIC(++ss->fixRefCount);
-  EVENT4(TraceFix, ss, refIO, ref, ss->rank);
-
-  TRACT_OF_ADDR(&tract, ss->arena, ref);
-  if(tract) {
-    if(TraceSetInter(TractWhite(tract), ss->traces) != TraceSetEMPTY) {
-      Seg seg;
-      if(TRACT_SEG(&seg, tract)) {
-        STATISTIC(++ss->segRefCount);
-        STATISTIC(++ss->whiteSegRefCount);
-        EVENT1(TraceFixSeg, seg);
-        EVENT0(TraceFixWhite);
-        pool = TractPool(tract);
-        PoolFixEmergency(pool, ss, seg, refIO);
-      }
-    } else {
-      /* Tract isn't white. Don't compute seg for non-statistical */
-      /* variety. See <design/trace/#fix.tractofaddr> */
-      STATISTIC_STAT
-        ({
-          Seg seg;
-          if(TRACT_SEG(&seg, tract)) {
-            ++ss->segRefCount;
-            EVENT1(TraceFixSeg, seg);
-          }
-        });
-    }
-  } else {
-    /* See <design/trace/#exact.legal> */
-    AVER(ss->rank < RankEXACT ||
-         !ArenaIsReservedAddr(ss->arena, ref));
-  }
-
-  /* See <design/trace/#fix.fixed.all> */
-  ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO);
-
-  return ResOK;
+  ScanState ss = (ScanState)mps_ss;
+  Ref *refIO = (Ref *)mps_ref_io;
+  return TraceFix2(ss, refIO);
 }
 
 
@@ -1430,7 +1451,7 @@ void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
 
   res = traceScanSingleRefRes(ts, rank, arena, seg, refIO);
   if(res != ResOK) {
-    traceSetSignalEmergency(ts, arena);
+    ArenaSetEmergency(arena, TRUE);
     res = traceScanSingleRefRes(ts, rank, arena, seg, refIO);
     /* Ought to be OK in emergency mode now. */
   }
@@ -1652,7 +1673,18 @@ static void TraceStartGenDesc_diag(GenDesc desc, Bool top, Index i)
   }
 }
 
-void TraceStart(Trace trace, double mortality, double finishingTime)
+
+/* TraceStart -- start a trace whose white set has been established
+ *
+ * The main job of TraceStart is to set up the grey list for a trace.  The
+ * trace is first created with TraceCreate, objects are whitened, then
+ * TraceStart is called to initialise the tracing process.
+ *
+ * NOTE: At present, TraceStart also flips the mutator, so there is no
+ * grey-mutator tracing.
+ */
+
+Res TraceStart(Trace trace, double mortality, double finishingTime)
 {
   Arena arena;
   Res res;
@@ -1783,9 +1815,7 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
   TracePostStartMessage(trace);
 
   /* All traces must flip at beginning at the moment. */
-  traceFlip(trace);
-
-  return;
+  return traceFlip(trace);
 }
 
 
@@ -1801,6 +1831,7 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
 void TraceQuantum(Trace trace)
 {
   Size pollEnd;
+  Arena arena = trace->arena;
 
   pollEnd = traceWorkClock(trace) + trace->rate;
   do {
@@ -1810,13 +1841,16 @@ void TraceQuantum(Trace trace)
         NOTREACHED;
         break;
       case TraceFLIPPED: {
-        Arena arena = trace->arena;
         Seg seg;
         Rank rank;
 
         if(traceFindGrey(&seg, &rank, arena, trace->ti)) {
+          Res res;
           AVER((SegPool(seg)->class->attr & AttrSCAN) != 0);
-          traceScanSeg(TraceSetSingle(trace), rank, arena, seg);
+          res = traceScanSeg(TraceSetSingle(trace), rank, arena, seg);
+          /* Allocation failures should be handled by emergency mode, and we
+             don't expect any other error in a normal GC trace. */
+          AVER(res == ResOK);
         } else {
           trace->state = TraceRECLAIM;
         }
@@ -1830,7 +1864,7 @@ void TraceQuantum(Trace trace)
         break;
     }
   } while(trace->state != TraceFINISHED
-          && (trace->emergency || traceWorkClock(trace) < pollEnd));
+          && (ArenaEmergency(arena) || traceWorkClock(trace) < pollEnd));
 }
 
 /* TraceStartCollectAll: start a trace which condemns everything in
@@ -1859,12 +1893,25 @@ Res TraceStartCollectAll(Trace *traceReturn, Arena arena, int why)
     /* Run out of time, should really try a smaller collection. @@@@ */
     finishingTime = 0.0;
   }
-  TraceStart(trace, TraceTopGenMortality, finishingTime);
+  res = TraceStart(trace, TraceTopGenMortality, finishingTime);
+  if (res != ResOK)
+    goto failStart;
   *traceReturn = trace;
   return ResOK;
 
+failStart:
+  /* TODO: We can't back-out from a failed TraceStart that has
+     already done some scanning, so this error path is somewhat bogus if it
+     destroys the trace.  In the current system, TraceStartCollectAll is
+     only used for a normal GC, so TraceStart should not fail and this case
+     should never be reached.  There's a chance the mutator will survive
+     if the assertion isn't hit, so drop through anyway. */
+  NOTREACHED;
 failCondemn:
   TraceDestroy(trace);
+  /* We don't know how long it'll be before another collection.  Make sure
+     the next one starts in normal mode. */
+  ArenaSetEmergency(arena, FALSE);
   return res;
 }
 
@@ -1933,7 +1980,9 @@ Size TracePoll(Globals globals)
           goto failCondemn;
         trace->chain = firstChain;
         ChainStartGC(firstChain, trace);
-        TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
+        res = TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
+        /* We don't expect normal GC traces to fail to start. */
+        AVER(res == ResOK);
         scannedSize = traceWorkClock(trace);
       }
     } /* (dynamicDeferral > 0.0) */
@@ -1950,12 +1999,18 @@ Size TracePoll(Globals globals)
     scannedSize = traceWorkClock(trace) - oldScanned;
     if(trace->state == TraceFINISHED) {
       TraceDestroy(trace);
+      /* A trace finished, and hopefully reclaimed some memory, so clear any
+         emergency. */
+      ArenaSetEmergency(arena, FALSE);
     }
   }
   return scannedSize;
 
 failCondemn:
   TraceDestroy(trace);
+  /* This is an unlikely case, but clear the emergency flag so the next attempt
+     starts normally. */
+  ArenaSetEmergency(arena, FALSE);
 failStart:
   return (Size)0;
 }
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index 04d7528c24c..24da7a92741 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -167,6 +167,9 @@ const char *TraceStartWhyToString(int why)
   case TraceStartWhyWALK:
     r = "Walking all live objects.";
     break;
+  case TraceStartWhyEXTENSION:
+    r = "Extension: an MPS extension started the trace.";
+    break;
   default:
     NOTREACHED;
     r = "Unknown reason (internal error).";
@@ -590,6 +593,10 @@ void ArenaPark(Globals globals)
       }
     TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena);
   }
+  
+  /* Clear any emergency flag so that the next collection starts normally.
+     Any traces that have been finished may have reclaimed memory. */
+  ArenaSetEmergency(arena, FALSE);
 }
 
 /* ArenaStartCollect -- start a collection of everything in the
diff --git a/mps/code/w3build.bat b/mps/code/w3build.bat
index a7bbf226df0..ae84606bff6 100755
--- a/mps/code/w3build.bat
+++ b/mps/code/w3build.bat
@@ -20,6 +20,7 @@ mkdir %mpsreleasename%
 
 mkdir %mpsreleasename%\include
 copy mps.h %mpsreleasename%\include
+copy mpstr.h %mpsreleasename%\include
 copy mpsavm.h %mpsreleasename%\include
 copy mpsacl.h %mpsreleasename%\include
 copy mpscamc.h %mpsreleasename%\include
diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk
index bc05f037b35..37d440235e8 100644
--- a/mps/code/w3i3mv.nmk
+++ b/mps/code/w3i3mv.nmk
@@ -16,10 +16,10 @@ MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> <lockw3> \
       <ref> <trace> <traceanc> <protw3> <proti3> <prmci3w3> \
-      <shield> <vmw3> \
-      <thw3> <thw3i3> <ssw3mv> <mpsi> <mpsiw3> <ld> <spi3> \
+      <shield> <vmw3> <table> \
+      <thw3> <thw3i3> <ss> <ssw3i3mv> <mpsi> <mpsiw3> <ld> <spi3> \
       <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <diag>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
 AMS = <poolams> <poolamsi>
diff --git a/mps/code/w3i6mv.nmk b/mps/code/w3i6mv.nmk
index c7b6deb796c..23fc63ef66d 100644
--- a/mps/code/w3i6mv.nmk
+++ b/mps/code/w3i6mv.nmk
@@ -17,8 +17,8 @@ MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <pool> <poolabs> <poolmfs> <poolmv> \
       <root> <format> <buffer> <walk> <lockw3> \
       <ref> <trace> <traceanc> <protw3> <proti6> <prmci6w3> \
-      <shield> <vmw3> \
-      <thw3> <thw3i6> <ssw3mv> <mpsi> <mpsiw3> <ld> <span> \
+      <shield> <vmw3> <table> \
+      <thw3> <thw3i6> <ss> <ssw3i6mv> <mpsi> <mpsiw3> <ld> <span> \
       <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
       <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version>
 PLINTH = <mpsliban> <mpsioan>
diff --git a/mps/code/walk.c b/mps/code/walk.c
index bb81a7aa152..9828eb49f57 100644
--- a/mps/code/walk.c
+++ b/mps/code/walk.c
@@ -120,7 +120,7 @@ void mps_arena_formatted_objects_walk(mps_arena_t mps_arena,
  * scanning them. But there's no direct support for invoking the scanner
  * without there being a trace, and there's no direct support for
  * creating a trace without also condemning part of the heap. (@@@@ This
- * looks like a useful canditate for inclusion in the future). For now,
+ * looks like a useful candidate for inclusion in the future). For now,
  * the root walker contains its own code for creating a minimal trace
  * and scan state.
  *
@@ -185,7 +185,7 @@ static Bool rootsStepClosureCheck(rootsStepClosure rsc)
 
 static void rootsStepClosureInit(rootsStepClosure rsc,
                                  Globals arena, Trace trace,
-                                 TraceFixMethod rootFix,
+                                 PoolFixMethod rootFix,
                                  mps_roots_stepper_t f, void *p, size_t s)
 {
   ScanState ss;
@@ -229,37 +229,26 @@ static void rootsStepClosureFinish(rootsStepClosure rsc)
  * This doesn't cause further scanning of transitive references, it just
  * calls the client closure.  */
 
-static Res RootsWalkFix(ScanState ss, Ref *refIO)
+static Res RootsWalkFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
 {
   rootsStepClosure rsc;
   Ref ref;
-  Seg seg;
-  Arena arena;
+        
+  UNUSED(pool);
 
   AVERT(ScanState, ss);
   AVER(refIO != NULL);
   rsc = ScanState2rootsStepClosure(ss);
   AVERT(rootsStepClosure, rsc);
 
-  arena = ss->arena;
   ref = *refIO;
 
-  /* Check that the reference is to a valid segment */
-  if (SegOfAddr(&seg, arena, ref)) {
-    /* Test if the segment belongs to a GCable pool */
-    /* If it isn't then it's not in the heap, and the reference */
-    /* shouldn't be passed to the client */
-    if ((SegPool(seg)->class->attr & AttrGC) != 0) {
-      /* Call the client closure - .assume.rootaddr */
-      rsc->f((mps_addr_t*)refIO, (mps_root_t)rsc->root, rsc->p, rsc->s);
-    }
-  } else {
-    /* See <design/trace/#exact.legal> */
-    AVER(ss->rank < RankEXACT || !ArenaIsReservedAddr(arena, ref));
-  }
+  /* If the segment isn't GCable then the ref is not to the heap and */
+  /* shouldn't be passed to the client. */
+  AVER((SegPool(seg)->class->attr & AttrGC) != 0);
 
-  /* See <design/trace/#fix.fixed.all> */
-  ss->fixedSummary = RefSetAdd(ss->arena, ss->fixedSummary, *refIO);
+  /* Call the client closure - .assume.rootaddr */
+  rsc->f((mps_addr_t*)refIO, (mps_root_t)rsc->root, rsc->p, rsc->s);
 
   AVER(ref == *refIO);  /* can walk object graph - but not modify it */
 
@@ -298,6 +287,7 @@ static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f,
   ScanState ss;
   Rank rank;
   Res res;
+  Seg seg;
 
   AVERT(Globals, arenaGlobals);
   AVER(FUNCHECK(f));
@@ -314,9 +304,19 @@ static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f,
   /* Have to fail if no trace available.  Unlikely due to .assume.parked. */
   if (res != ResOK)
     return res;
-  /* Set the white set to universal so that the scanner */
-  /* doesn't filter out any references from roots into the arena. */
-  trace->white = ZoneSetUNIV;
+
+  /* ArenaRootsWalk only passes references to GCable pools to the client. */
+  /* NOTE: I'm not sure why this is. RB 2012-07-24 */
+  if (SegFirst(&seg, arena)) {
+    Addr base;
+    do {
+      base = SegBase(seg);
+      if ((SegPool(seg)->class->attr & AttrGC) != 0) {
+        TraceAddWhite(trace, seg);
+      }
+    } while (SegNext(&seg, arena, base));
+  }
+
   /* Make the roots grey so that they are scanned */
   res = RootsIterate(arenaGlobals, (RootIterateFn)RootGrey, (void *)trace);
   /* Make this trace look like any other trace. */
@@ -337,6 +337,7 @@ static Res ArenaRootsWalk(Globals arenaGlobals, mps_roots_stepper_t f,
   /* Make this trace look like any other finished trace. */
   trace->state = TraceFINISHED;
   TraceDestroy(trace);
+  AVER(!ArenaEmergency(arena)); /* There was no allocation. */
 
   return res;
 }