From 1d2ccefa9770397026f31e8fd1ecf4fe17e630d2 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Wed, 18 Apr 2007 17:12:16 +0100
Subject: [PATCH 01/53] Mps: branching for development.

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

From c2e79477d31d0a3c8dc82c6ac30ea7624a3c705a Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Thu, 19 Apr 2007 11:32:08 +0100
Subject: [PATCH 02/53] Added diag and diag_writef

Copied from Perforce
 Change: 162160
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index edd4a2e5dbe..2279b7ed2b7 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -945,6 +945,28 @@ extern void StackProbe(Size depth);
 
 #endif
 
+/* Diagnostics */
+
+Bool DiagIsOn(void);
+
+#define DIAG_STREAM (DiagStream())
+
+#define DIAG(s) BEGIN \
+    s \
+  END
+
+/*
+ * Note the macro argument args should have parens around it (in the
+ * invocation); it is a variable number of arguments that we pass
+ * to another function.
+ * That makes this macro unclean in all sorts of ways.
+ */
+#define DIAG_WRITEF(stream, args) DIAG( \
+  if(DiagIsOn()) { \
+    WriteF a; \
+  } \
+)
+
 
 #endif /* mpm_h */
 

From c165d3d179e1d0b0052e50ad3fb682d46c26dfd6 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Thu, 19 Apr 2007 13:02:21 +0100
Subject: [PATCH 03/53] Mps: diag fixes.

Copied from Perforce
 Change: 162163
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk |  2 +-
 mps/code/diag.c   | 23 +++++++++++++++++++++++
 mps/code/mpm.h    |  5 +++--
 3 files changed, 27 insertions(+), 3 deletions(-)
 create mode 100644 mps/code/diag.c

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 2e88d211cc2..fc3d2db1168 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -193,7 +193,7 @@ MPMCOMMON = mpsi.c mpm.c arenavm.c arenacl.c arena.c global.c locus.c \
             trace.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 version.c
+            boot.c meter.c splay.c cbs.c diag.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 \
diff --git a/mps/code/diag.c b/mps/code/diag.c
new file mode 100644
index 00000000000..5f79d92624a
--- /dev/null
+++ b/mps/code/diag.c
@@ -0,0 +1,23 @@
+/*$Header$
+  Implementation of diagnostic interface.
+*/
+
+#include <stdarg.h>
+
+#include "mpm.h"
+#include "mpslib.h" /* for mps_lib_stdout */
+
+Bool DiagEnabledGlobal = TRUE;
+
+Bool DiagIsOn(void)
+{
+  return DiagEnabledGlobal;
+}
+
+
+mps_lib_FILE *DiagStream(void)
+{
+  return mps_lib_stdout;
+}
+
+
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 2279b7ed2b7..b27f29138ab 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -948,6 +948,7 @@ extern void StackProbe(Size depth);
 /* Diagnostics */
 
 Bool DiagIsOn(void);
+mps_lib_FILE *DiagStream(void);
 
 #define DIAG_STREAM (DiagStream())
 
@@ -961,9 +962,9 @@ Bool DiagIsOn(void);
  * to another function.
  * That makes this macro unclean in all sorts of ways.
  */
-#define DIAG_WRITEF(stream, args) DIAG( \
+#define DIAG_WRITEF(args) DIAG( \
   if(DiagIsOn()) { \
-    WriteF a; \
+    WriteF args; \
   } \
 )
 

From 148513250ee28710910584662f802a45000531af Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 14:24:14 +0100
Subject: [PATCH 04/53] Mps br/diag: vmarenadescribe, plus comment in arena.c:
 .describe.triv.dont-upcall

Copied from Perforce
 Change: 162210
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   | 12 ++++++++++++
 mps/code/arenavm.c | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 46 insertions(+)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 4b40a8f8b06..3f90ba55223 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -24,6 +24,18 @@ static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream)
   if (!CHECKT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
 
+  /* .describe.triv.never-called-from-subclass-method:
+   * This Triv method seems to assume that it will never get called
+   * from a subclass-method invoking ARENA_SUPERCLASS()->describe.
+   * It assumes that it only gets called if the describe method has
+   * not been subclassed.  (That's the only reason for printing the
+   * "No class-specific description available" message).
+   * This is bogus, but that's the status quo.  RHSK 2007-04-27.
+   */
+  /* .describe.triv.dont-upcall: Therefore (for now) the last 
+   * subclass describe method should avoid invoking 
+   * ARENA_SUPERCLASS()->describe.  RHSK 2007-04-27.
+   */
   return WriteF(stream,
     "  No class-specific description available.\n", NULL);
 }
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 67f71247ef2..73a77c08ef5 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -191,6 +191,39 @@ static Bool VMArenaCheck(VMArena vmArena)
 }
 
 
+/* VMArenaDescribe -- describe the VMArena
+ */
+static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
+{
+  Res res;
+  VMArena vmArena;
+  ArenaClass super;
+
+  if (!CHECKT(Arena, arena)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+  vmArena = Arena2VMArena(arena);
+  if (!CHECKT(VMArena, vmArena)) return ResFAIL;
+
+  /* Describe the superclass fields first via next-method call */
+  /* ...but the next method is ArenaTrivDescribe, so don't call it;
+   * see impl.c.arena#describe.triv.dont-upcall.
+   *
+  super = ARENA_SUPERCLASS(VMArenaClass);
+  res = super->describe(arena, stream);
+  if (res != ResOK) return res;
+   *
+  */
+
+  res = WriteF(stream, "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n", NULL);
+  if (res != ResOK) return res;
+
+  /* @@@@ INCOMPLETE @@@@ */
+
+  return ResOK;
+}
+
+
+
 /* VM indirect functions
  *
  * These functions should be used to map and unmap within the arena.
@@ -1518,6 +1551,7 @@ DEFINE_ARENA_CLASS(VMArenaClass, this)
   this->free = VMFree;
   this->chunkInit = VMChunkInit;
   this->chunkFinish = VMChunkFinish;
+  this->describe = VMArenaDescribe;
 }
 
 

From dba0d98034953878cd1ca38f34095f138d8a661c Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 14:27:40 +0100
Subject: [PATCH 05/53] Mps br/diag: (not for release until diag is off in
 wi/we):

arenavm.c: add DIAG(ArenaDescribe) in VMChunkCreate;
amcss.c: make initial-size to mps_arena_create comically small,
 to prompt VMChunkCreates and occasional MPS_RESERVE_BLOCK: 7's
 (== commit-limit, which is ok; probably)

Copied from Perforce
 Change: 162211
 ServerID: perforce.ravenbrook.com
---
 mps/code/amcss.c   | 2 +-
 mps/code/arenavm.c | 4 ++++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 76a5088360f..b3c55a0a812 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -294,7 +294,7 @@ int main(int argc, char **argv)
 
   randomize(argc, argv);
 
-  die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
+  die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE/8),
       "arena_create");
   mps_message_type_enable(arena, mps_message_type_gc());
   mps_message_type_enable(arena, mps_message_type_gc_start());
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 73a77c08ef5..1e1515150ee 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -293,6 +293,10 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
   AVERT(VMArena, vmArena);
   AVER(size > 0);
 
+  DIAG_WRITEF(( DIAG_STREAM, "\n** VMChunkCreate $U\n", size, NULL ));
+
+  DIAG( ArenaDescribe(VMArena2Arena(vmArena), DIAG_STREAM); );
+
   res = VMCreate(&vm, size);
   if (res != ResOK)
     goto failVMCreate;

From 646df26578a58b8d028e676a24e4fec24aca7fd5 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:02:45 +0100
Subject: [PATCH 06/53] Mps br/diag: make vmarenadescribe show zones.

arena.c: turn off call from ArenaDescribe to GlobalsDescribe,
 because it outputs too much stuff (perhaps this change should be
 reverted later).

Copied from Perforce
 Change: 162212
 ServerID: perforce.ravenbrook.com
---
 mps/code/arena.c   |  5 +++++
 mps/code/arenavm.c | 14 +++++++++++---
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 3f90ba55223..94c72dd336f 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -343,8 +343,13 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream)
   res = (*arena->class->describe)(arena, stream);
   if (res != ResOK) return res;
 
+  /* Do not call GlobalsDescribe: it makes too much output, thanks.
+   * RHSK 2007-04-27
+   *
   res = GlobalsDescribe(ArenaGlobals(arena), stream);
   if (res != ResOK) return res;
+   *
+   */
 
   res = WriteF(stream,
                "} Arena $P ($U)\n", (WriteFP)arena,
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 1e1515150ee..3e0723ad3ac 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -214,10 +214,19 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
    *
   */
 
-  res = WriteF(stream, "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n", NULL);
+  AVER(3 < VMArenaGenCount);
+  res = WriteF(stream,
+    "  blacklist:     $B\n", (WriteFB)vmArena->blacklist,
+    "  genZoneSet[0]: $B\n", (WriteFB)vmArena->genZoneSet[0],
+    "  genZoneSet[1]: $B\n", (WriteFB)vmArena->genZoneSet[1],
+    "  genZoneSet[2]: $B\n", (WriteFB)vmArena->genZoneSet[2],
+    "  genZoneSet[3]: $B\n", (WriteFB)vmArena->genZoneSet[3],
+    "  freeSet:       $B\n", (WriteFB)vmArena->freeSet,
+    NULL
+  );
   if (res != ResOK) return res;
 
-  /* @@@@ INCOMPLETE @@@@ */
+  /* (incomplete: some fields are not Described) */
 
   return ResOK;
 }
@@ -294,7 +303,6 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
   AVER(size > 0);
 
   DIAG_WRITEF(( DIAG_STREAM, "\n** VMChunkCreate $U\n", size, NULL ));
-
   DIAG( ArenaDescribe(VMArena2Arena(vmArena), DIAG_STREAM); );
 
   res = VMCreate(&vm, size);

From a31f4e99388bc00bf64cbad603336a9dfc747bc0 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:04:08 +0100
Subject: [PATCH 07/53] Mps br/diag: pass why reason down to tracestart.

Also: DIAG-out TraceStart reason, and -- if a non-monor collection --
 DIAG-out an ArenaDescribe.

Copied from Perforce
 Change: 162213
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpm.h   |  3 ++-
 mps/code/trace.c | 16 ++++++++++++----
 2 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index b27f29138ab..11b2cb0416e 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -358,7 +358,8 @@ 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 void TraceStart(Trace trace, double mortality,
+                       double finishingTime, int why);
 extern Size TracePoll(Globals globals);
 
 extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 948df5fde40..914ccd368d8 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1553,7 +1553,8 @@ static Res rootGrey(Root root, void *p)
   return ResOK;
 }
 
-void TraceStart(Trace trace, double mortality, double finishingTime)
+void TraceStart(Trace trace, double mortality,
+                double finishingTime, int why)
 {
   Arena arena;
   Message message;
@@ -1569,6 +1570,12 @@ void TraceStart(Trace trace, double mortality, double finishingTime)
 
   arena = trace->arena;
 
+  DIAG_WRITEF(( DIAG_STREAM,  "\n** TraceStart: $S\n", (WriteFS)trace->startMessage.why, NULL ));
+  if (why != TraceStartWhyCHAIN_GEN0CAP) {
+    /* a non-minor collection */
+    DIAG( ArenaDescribe(arena, DIAG_STREAM); );
+  }
+
   message = TraceStartMessageMessage(&trace->startMessage);
   /* Attempt to re-use message.
    * @@@@ This is not done safely, because we fail to record 
@@ -1726,7 +1733,7 @@ static 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);
+  TraceStart(trace, TraceTopGenMortality, finishingTime, why);
   *traceReturn = trace;
   return ResOK;
 
@@ -1791,16 +1798,17 @@ Size TracePoll(Globals globals)
 
       /* If one was found, start collection on that chain. */
       if (firstTime < 0) {
+        int why = TraceStartWhyCHAIN_GEN0CAP;
         double mortality;
 
-        res = TraceCreate(&trace, arena, TraceStartWhyCHAIN_GEN0CAP);
+        res = TraceCreate(&trace, arena, why);
         AVER(res == ResOK);
         res = ChainCondemnAuto(&mortality, firstChain, trace);
         if (res != ResOK) /* should try some other trace, really @@@@ */
           goto failCondemn;
         trace->chain = firstChain;
         ChainStartGC(firstChain, trace);
-        TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
+        TraceStart(trace, mortality, trace->condemned * TraceWorkFactor, why);
         scannedSize = traceWorkClock(trace);
       }
     } /* (dynamicDeferral > 0.0) */

From 51ae6e346f309879ebed46da6de8bcc644ca2574 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:37:16 +0100
Subject: [PATCH 08/53] Mps br/diag: variety.ii: now has diagnostics, and no
 logging (pro tem);

mpm.h: DIAG() et al under control of DIAGNOSTICS;
diag.c: under control of DIAGNOSTICS, plus add header and copyright.

Copied from Perforce
 Change: 162214
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h |  7 ++++--
 mps/code/diag.c   | 59 ++++++++++++++++++++++++++++++++++++++++++++---
 mps/code/mpm.h    | 34 +++++++++++++--------------
 3 files changed, 78 insertions(+), 22 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index edf27000969..6b4d0163b08 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -54,10 +54,13 @@
 #define CONFIG_LOG
 
 #elif defined(CONFIG_VAR_II)    /* Ice, Internal; variety.ii (HotLog) */
+/* This WAS a hot logging variety.  Now it's a hot diagnostic variety
+ * (non-logging), pro tem.  RHSK 2007-04-27.
+ */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-/* no debug diagnostic statistic meters */
-#define CONFIG_LOG
+#define CONFIG_DEBUG
+/* no telemetry log events */
 #endif
 
 
diff --git a/mps/code/diag.c b/mps/code/diag.c
index 5f79d92624a..b48dbf5ff27 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -1,12 +1,17 @@
-/*$Header$
-  Implementation of diagnostic interface.
-*/
+/* diag.c: MEMORY POOL MANAGER DIAGNOSTICS
+ *
+ * $Id$
+ * Copyright (c) 2007 Ravenbrook Limited.  See end of file for license.
+ *
+ */
 
 #include <stdarg.h>
 
 #include "mpm.h"
 #include "mpslib.h" /* for mps_lib_stdout */
 
+#if defined(DIAGNOSTICS)
+
 Bool DiagEnabledGlobal = TRUE;
 
 Bool DiagIsOn(void)
@@ -21,3 +26,51 @@ mps_lib_FILE *DiagStream(void)
 }
 
 
+#elif defined(DIAGNOSTICS_NONE)
+
+#else
+
+#error "No diagnostics configured."
+
+#endif
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (C) 2001-2003 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/mpm.h b/mps/code/mpm.h
index 11b2cb0416e..f10d491076b 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -934,29 +934,13 @@ extern void StackProbe(Size depth);
 #define STATISTIC_STAT(gather) BEGIN gather; END
 #define STATISTIC_WRITE(format, arg) (format), (arg),
 
-#elif defined(DIAGNOSTICS_NONE)
-
-#define STATISTIC(gather) DISCARD(((gather), 0))
-#define STATISTIC_STAT(gather) DISCARD_STAT(gather)
-#define STATISTIC_WRITE(format, arg)
-
-#else
-
-#error "No diagnostics configured."
-
-#endif
-
-/* Diagnostics */
-
+/* Diagnostic Calculation and Output */
 Bool DiagIsOn(void);
 mps_lib_FILE *DiagStream(void);
-
 #define DIAG_STREAM (DiagStream())
-
 #define DIAG(s) BEGIN \
     s \
   END
-
 /*
  * Note the macro argument args should have parens around it (in the
  * invocation); it is a variable number of arguments that we pass
@@ -969,6 +953,22 @@ mps_lib_FILE *DiagStream(void);
   } \
 )
 
+#elif defined(DIAGNOSTICS_NONE)
+
+#define STATISTIC(gather) DISCARD(((gather), 0))
+#define STATISTIC_STAT(gather) DISCARD_STAT(gather)
+#define STATISTIC_WRITE(format, arg)
+
+/* Diagnostic Calculation and Output */
+#define DIAG(s) BEGIN END
+#define DIAG_WRITEF(args) BEGIN END
+
+#else
+
+#error "No diagnostics configured."
+
+#endif
+
 
 #endif /* mpm_h */
 

From f79512cbf967bf8e89009cc2ba116302382fb543 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:49:45 +0100
Subject: [PATCH 09/53] Mps br/diag: arenavm.c: fix unused var super in
 vmarenadescribe

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

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 3e0723ad3ac..e70db21a6a2 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -197,7 +197,6 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
 {
   Res res;
   VMArena vmArena;
-  ArenaClass super;
 
   if (!CHECKT(Arena, arena)) return ResFAIL;
   if (stream == NULL) return ResFAIL;
@@ -208,9 +207,12 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
   /* ...but the next method is ArenaTrivDescribe, so don't call it;
    * see impl.c.arena#describe.triv.dont-upcall.
    *
-  super = ARENA_SUPERCLASS(VMArenaClass);
-  res = super->describe(arena, stream);
-  if (res != ResOK) return res;
+  {
+    ArenaClass super;
+    super = ARENA_SUPERCLASS(VMArenaClass);
+    res = super->describe(arena, stream);
+    if (res != ResOK) return res;
+  }
    *
   */
 

From da457c084ae78ef1794af7810e0267b731f12335 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:51:31 +0100
Subject: [PATCH 10/53] Mps br/diag: arenavm.c: fix unused var super in
 vmarenadescribe

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

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index e70db21a6a2..b50c0513846 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -207,12 +207,9 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream)
   /* ...but the next method is ArenaTrivDescribe, so don't call it;
    * see impl.c.arena#describe.triv.dont-upcall.
    *
-  {
-    ArenaClass super;
-    super = ARENA_SUPERCLASS(VMArenaClass);
-    res = super->describe(arena, stream);
-    if (res != ResOK) return res;
-  }
+  super = ARENA_SUPERCLASS(VMArenaClass);
+  res = super->describe(arena, stream);
+  if (res != ResOK) return res;
    *
   */
 

From 3e1691b06fe69312e79bc586295b4d0a9ed69d61 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 15:58:55 +0100
Subject: [PATCH 11/53] Copied from Perforce  Change: 162218  ServerID:
 perforce.ravenbrook.com

---
 mps/code/w3i3mv.nmk | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk
index f738fa19735..9d18c7a32a9 100644
--- a/mps/code/w3i3mv.nmk
+++ b/mps/code/w3i3mv.nmk
@@ -20,7 +20,7 @@ MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <ref> <trace> <protw3> <proti3> <prmci3w3> <shield> <vmw3> \
       <thw3i3> <ssw3i3> <mpsi> <mpsiw3> <ld> <spi3> \
       <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version>
 SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
@@ -29,7 +29,7 @@ SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <thw3i3> <ssan> <mpsi> <ld> \
       <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
       <poolams> <poolamsi> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
 AMS = <poolams> <poolamsi>

From 74d3de9ff8bc048831967aaf20863e35520941fb Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 16:01:17 +0100
Subject: [PATCH 12/53] Mps br/diag: (fix w3*mv builds): add <diag> so diag.c
 gets compiled.

(Part of this was submitted on its own as Changelist 162218 -- oops).

Copied from Perforce
 Change: 162219
 ServerID: perforce.ravenbrook.com
---
 mps/code/w3almv.nmk | 4 ++--
 mps/code/w3ppmv.nmk | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/mps/code/w3almv.nmk b/mps/code/w3almv.nmk
index 7c1c8e07b20..994551899f2 100644
--- a/mps/code/w3almv.nmk
+++ b/mps/code/w3almv.nmk
@@ -20,7 +20,7 @@ MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <ref> <trace> <protw3> <prmcan> <shield> \
       <than> <ssan> <mpsi> <mpsiw3> <ld> <vmw3> \
       <event> <seg> <poolmrg> <message> <span> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version> <poolmvff>
 SW  = <ring> <mpm> <bt> <protocol> \
       <arenavm> <arenacl> <arena> <tract> <walk> <reserv> \
       <pool> <poolabs> <poolmfs> \
@@ -29,7 +29,7 @@ SW  = <ring> <mpm> <bt> <protocol> \
       <than> <ssan> <mpsi> <ld> \
       <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
       <poolams> <poolamsi> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
 AMS = <poolams> <poolamsi>
diff --git a/mps/code/w3ppmv.nmk b/mps/code/w3ppmv.nmk
index f75131a576e..4c684d5e610 100644
--- a/mps/code/w3ppmv.nmk
+++ b/mps/code/w3ppmv.nmk
@@ -17,7 +17,7 @@ MPM = <ring> <mpm> <bt> <protocol> <boot> \
       <ref> <trace> <protw3> <prmcan> <shield> <vmw3> \
       <than> <ssan> <mpsi> <mpsiw3> <ld> <span> \
       <event> <seg> <sac> <poolmrg> <message> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version>
 SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <arenavm> <arenacl> <locus> <arena> <global> <tract> <reserv> \
       <pool> <poolabs> <poolmfs> <poolmv> \
@@ -26,7 +26,7 @@ SW  = <ring> <mpm> <bt> <protocol> <boot> \
       <than> <ssan> <mpsi> <ld> \
       <event> <seg> <sac> <poolmrg> <message> <mpsioan> \
       <poolams> <poolamsi> <dbgpool> <dbgpooli> \
-      <abq> <meter> <cbs> <poolmv2> <splay> <version> <poolmvff>
+      <abq> <meter> <cbs> <poolmv2> <splay> <diag> <version> <poolmvff>
 PLINTH = <mpsliban> <mpsioan>
 AMC = <poolamc>
 AMS = <poolams> <poolamsi>

From 6214719361a3df77430649af6d3ff2296187dcf0 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 16:28:24 +0100
Subject: [PATCH 13/53] mps br/diag: backout change to variety.ii:

(was now has DIAGNOSTICS, and no logging;
  now: back to CONFIG_LOG, and no diag)

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

From b991aab81fbe83a660260bda1e8f7cfc05ac8150 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 16:33:38 +0100
Subject: [PATCH 14/53] Mps br/diag: backout change to variety.ii:

(was now has DIAGNOSTICS, and no logging;
now: back to CONFIG_LOG, and no diag)

Copied from Perforce
 Change: 162221
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 6b4d0163b08..edf27000969 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -54,13 +54,10 @@
 #define CONFIG_LOG
 
 #elif defined(CONFIG_VAR_II)    /* Ice, Internal; variety.ii (HotLog) */
-/* This WAS a hot logging variety.  Now it's a hot diagnostic variety
- * (non-logging), pro tem.  RHSK 2007-04-27.
- */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-#define CONFIG_DEBUG
-/* no telemetry log events */
+/* no debug diagnostic statistic meters */
+#define CONFIG_LOG
 #endif
 
 

From 17f1066b273a9523aa26774f2ddc7a6c1636d280 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 16:46:51 +0100
Subject: [PATCH 15/53] Mps br/diag: new variety.di: hot+diagnostics

Copied from Perforce
 Change: 162222
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk    |  5 +++++
 mps/code/commpre.nmk |  3 +++
 mps/code/config.h    |  6 ++++++
 mps/code/w3almv.nmk  | 29 +++++++++++++++++++++++++++++
 mps/code/w3i3mv.nmk  | 29 +++++++++++++++++++++++++++++
 mps/code/w3ppmv.nmk  | 29 +++++++++++++++++++++++++++++
 6 files changed, 101 insertions(+)

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index fc3d2db1168..93c77b2a9e4 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -126,6 +126,7 @@ CFWE = -DCONFIG_VAR_WE -DNDEBUG $(CFLAGSOPTNODEBUG)
 CFWI = -DCONFIG_VAR_WI -DNDEBUG $(CFLAGSOPT)
 CFHE = -DCONFIG_VAR_HE -DNDEBUG $(CFLAGSOPTNODEBUG)
 CFHI = -DCONFIG_VAR_HI -DNDEBUG $(CFLAGSOPT)
+CFDI = -DCONFIG_VAR_DI -DNDEBUG $(CFLAGSOPT)
 CFII = -DCONFIG_VAR_II -DNDEBUG $(CFLAGSOPT)
 CFCE = -DCONFIG_VAR_CE          $(CFLAGSOPTNODEBUG)
 CFCI = -DCONFIG_VAR_CI          $(CFLAGSDEBUG)
@@ -145,6 +146,9 @@ else
 ifeq ($(VARIETY),hi)
 CFLAGS=$(CFLAGSCOMMON) $(CFHI)
 else
+ifeq ($(VARIETY),di)
+CFLAGS=$(CFLAGSCOMMON) $(CFDI)
+else
 ifeq ($(VARIETY),ii)
 CFLAGS=$(CFLAGSCOMMON) $(CFII)
 else
@@ -165,6 +169,7 @@ endif
 endif
 endif
 endif
+endif
 
 
 ARFLAGS=rc$(ARFLAGSPFM)
diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk
index c10da3de76d..66a3cf2965c 100644
--- a/mps/code/commpre.nmk
+++ b/mps/code/commpre.nmk
@@ -146,6 +146,7 @@ CFWE = /DCONFIG_VAR_WE $(CRTFLAGSW)  $(CFLAGSHOT)  $(CFLAGSEXTERNAL)
 CFWI = /DCONFIG_VAR_WI $(CRTFLAGSW)  $(CFLAGSHOT)  $(CFLAGSINTERNAL)
 CFHE = /DCONFIG_VAR_HE $(CRTFLAGSH)  $(CFLAGSHOT)  $(CFLAGSEXTERNAL)
 CFHI = /DCONFIG_VAR_HI $(CRTFLAGSH)  $(CFLAGSHOT)  $(CFLAGSINTERNAL)
+CFDI = /DCONFIG_VAR_DI $(CRTFLAGSH)  $(CFLAGSHOT)  $(CFLAGSINTERNAL)
 CFCE = /DCONFIG_VAR_CE $(CRTFLAGSC)  $(CFLAGSCOOL) $(CFLAGSEXTERNAL)
 CFCI = /DCONFIG_VAR_CI $(CRTFLAGSC)  $(CFLAGSCOOL) $(CFLAGSINTERNAL)
 CFTI = /DCONFIG_VAR_TI $(CRTFLAGSC)  $(CFLAGSCOOL) $(CFLAGSINTERNAL)
@@ -164,6 +165,7 @@ LFWE = $(LINKFLAGSWHITE)  $(LINKFLAGSEXTERNAL)
 LFWI = $(LINKFLAGSWHITE)  $(LINKFLAGSINTERNAL)
 LFHE = $(LINKFLAGSHOT)    $(LINKFLAGSEXTERNAL)
 LFHI = $(LINKFLAGSHOT)    $(LINKFLAGSINTERNAL)
+LFDI = $(LINKFLAGSHOT)    $(LINKFLAGSINTERNAL)
 LFCE = $(LINKFLAGSCOOL)   $(LINKFLAGSEXTERNAL)
 LFCI = $(LINKFLAGSCOOL)   $(LINKFLAGSINTERNAL)
 LFTI = $(LINKFLAGSCOOL)   $(LINKFLAGSINTERNAL)
@@ -178,6 +180,7 @@ LIBFLAGSWE =
 LIBFLAGSWI =
 LIBFLAGSHE =
 LIBFLAGSHI =
+LIBFLAGSDI =
 LIBFLAGSCE =
 LIBFLAGSCI =
 LIBFLAGSTI =
diff --git a/mps/code/config.h b/mps/code/config.h
index edf27000969..7fa0b89c8a4 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -41,6 +41,12 @@
 /* no debug diagnostic statistic meters */
 /* no telemetry log events */
 
+#elif defined(CONFIG_VAR_DI) /* Diagnostic variety */
+#define CONFIG_ASSERT
+#define CHECKLEVEL_INITIAL CheckLevelMINIMAL
+#define CONFIG_DEBUG
+/* no telemetry log events */
+
 #elif defined(CONFIG_VAR_CI) || defined(CONFIG_VAR_CE) /* Cool varieties */
 #define CONFIG_ASSERT
 /* ... let PRODUCT determine CHECKLEVEL_INITIAL */
diff --git a/mps/code/w3almv.nmk b/mps/code/w3almv.nmk
index 994551899f2..d961739b0b0 100644
--- a/mps/code/w3almv.nmk
+++ b/mps/code/w3almv.nmk
@@ -141,6 +141,35 @@ POOLNOBJ = $(POOLNOBJ0:>=.obj)
 TESTLIBOBJ0 = $(TESTLIB:<=w3almv\hi\)
 TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
 
+!ELSEIF "$(VARIETY)" == "di"
+CFLAGS=$(CFLAGSCOMMONPRE) $(CFDI) $(CFLAGSCOMMONPOST)
+LINKFLAGS=$(LINKFLAGSCOMMON) $(LFDI)
+LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSDI)
+MPMOBJ0 = $(MPM:<=w3almv\di\)
+MPMOBJ = $(MPMOBJ0:>=.obj)
+PLINTHOBJ0 = $(PLINTH:<=w3almv\di\)
+PLINTHOBJ = $(PLINTHOBJ0:>=.obj)
+SWOBJ0 = $(SW:<=w3almv\di\)
+SWOBJ = $(SWOBJ0:>=.obj)
+AMSOBJ0 = $(AMS:<=w3almv\di\)
+AMSOBJ = $(AMSOBJ0:>=.obj)
+AMCOBJ0 = $(AMC:<=w3almv\di\)
+AMCOBJ = $(AMCOBJ0:>=.obj)
+AWLOBJ0 = $(AWL:<=w3almv\di\)
+AWLOBJ = $(AWLOBJ0:>=.obj)
+LOOBJ0 = $(LO:<=w3almv\di\)
+LOOBJ = $(LOOBJ0:>=.obj)
+SNCOBJ0 = $(SNC:<=w3almv\di\)
+SNCOBJ = $(SNCOBJ0:>=.obj)
+DWOBJ0 = $(DW:<=w3almv\di\)
+DWOBJ = $(DWOBJ0:>=.obj)
+FMTTESTOBJ0 = $(FMTTEST:<=w3almv\di\)
+FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
+POOLNOBJ0 = $(POOLN:<=w3almv\di\)
+POOLNOBJ = $(POOLNOBJ0:>=.obj)
+TESTLIBOBJ0 = $(TESTLIB:<=w3almv\di\)
+TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
+
 !ELSEIF "$(VARIETY)" == "ci"
 CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST)
 LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI)
diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk
index 9d18c7a32a9..fc9509cd87b 100644
--- a/mps/code/w3i3mv.nmk
+++ b/mps/code/w3i3mv.nmk
@@ -141,6 +141,35 @@ POOLNOBJ = $(POOLNOBJ0:>=.obj)
 TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\hi\)
 TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
 
+!ELSEIF "$(VARIETY)" == "di"
+CFLAGS=$(CFLAGSCOMMONPRE) $(CFDI) $(CFLAGSCOMMONPOST)
+LINKFLAGS=$(LINKFLAGSCOMMON) $(LFDI)
+LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSDI)
+MPMOBJ0 = $(MPM:<=w3i3mv\di\)
+MPMOBJ = $(MPMOBJ0:>=.obj)
+PLINTHOBJ0 = $(PLINTH:<=w3i3mv\di\)
+PLINTHOBJ = $(PLINTHOBJ0:>=.obj)
+SWOBJ0 = $(SW:<=w3i3mv\di\)
+SWOBJ = $(SWOBJ0:>=.obj)
+AMSOBJ0 = $(AMS:<=w3i3mv\di\)
+AMSOBJ = $(AMSOBJ0:>=.obj)
+AMCOBJ0 = $(AMC:<=w3i3mv\di\)
+AMCOBJ = $(AMCOBJ0:>=.obj)
+AWLOBJ0 = $(AWL:<=w3i3mv\di\)
+AWLOBJ = $(AWLOBJ0:>=.obj)
+LOOBJ0 = $(LO:<=w3i3mv\di\)
+LOOBJ = $(LOOBJ0:>=.obj)
+SNCOBJ0 = $(SNC:<=w3i3mv\di\)
+SNCOBJ = $(SNCOBJ0:>=.obj)
+DWOBJ0 = $(DW:<=w3i3mv\di\)
+DWOBJ = $(DWOBJ0:>=.obj)
+FMTTESTOBJ0 = $(FMTTEST:<=w3i3mv\di\)
+FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
+POOLNOBJ0 = $(POOLN:<=w3i3mv\di\)
+POOLNOBJ = $(POOLNOBJ0:>=.obj)
+TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\di\)
+TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
+
 !ELSEIF "$(VARIETY)" == "ci"
 CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST)
 LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI)
diff --git a/mps/code/w3ppmv.nmk b/mps/code/w3ppmv.nmk
index 4c684d5e610..28b565e6254 100644
--- a/mps/code/w3ppmv.nmk
+++ b/mps/code/w3ppmv.nmk
@@ -138,6 +138,35 @@ POOLNOBJ = $(POOLNOBJ0:>=.obj)
 TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\hi\)
 TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
 
+!ELSEIF "$(VARIETY)" == "di"
+CFLAGS=$(CFLAGSCOMMONPRE) $(CFDI) $(CFLAGSCOMMONPOST)
+LINKFLAGS=$(LINKFLAGSCOMMON) $(LFDI)
+LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSDI)
+MPMOBJ0 = $(MPM:<=w3ppmv\di\)
+MPMOBJ = $(MPMOBJ0:>=.obj)
+PLINTHOBJ0 = $(PLINTH:<=w3ppmv\di\)
+PLINTHOBJ = $(PLINTHOBJ0:>=.obj)
+SWOBJ0 = $(SW:<=w3ppmv\di\)
+SWOBJ = $(SWOBJ0:>=.obj)
+AMSOBJ0 = $(AMS:<=w3ppmv\di\)
+AMSOBJ = $(AMSOBJ0:>=.obj)
+AMCOBJ0 = $(AMC:<=w3ppmv\di\)
+AMCOBJ = $(AMCOBJ0:>=.obj)
+AWLOBJ0 = $(AWL:<=w3ppmv\di\)
+AWLOBJ = $(AWLOBJ0:>=.obj)
+LOOBJ0 = $(LO:<=w3ppmv\di\)
+LOOBJ = $(LOOBJ0:>=.obj)
+SNCOBJ0 = $(SNC:<=w3ppmv\di\)
+SNCOBJ = $(SNCOBJ0:>=.obj)
+DWOBJ0 = $(DW:<=w3ppmv\di\)
+DWOBJ = $(DWOBJ0:>=.obj)
+FMTTESTOBJ0 = $(FMTTEST:<=w3ppmv\di\)
+FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
+POOLNOBJ0 = $(POOLN:<=w3ppmv\di\)
+POOLNOBJ = $(POOLNOBJ0:>=.obj)
+TESTLIBOBJ0 = $(TESTLIB:<=w3ppmv\di\)
+TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
+
 !ELSEIF "$(VARIETY)" == "ci"
 CFLAGS=$(CFLAGSCOMMONPRE) $(CFCI) $(CFLAGSCOMMONPOST)
 LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCI)

From 4c017784e250e72ee655f8cb0be1f9edb2919ef0 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 27 Apr 2007 17:23:21 +0100
Subject: [PATCH 16/53] Mps br/diag: diag-out text + arenadescribe every
 vmarenaextend,

(instead of every VMChunkCreate, which includes when making initial arena)

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

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index b50c0513846..b9a84026246 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -301,9 +301,6 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
   AVERT(VMArena, vmArena);
   AVER(size > 0);
 
-  DIAG_WRITEF(( DIAG_STREAM, "\n** VMChunkCreate $U\n", size, NULL ));
-  DIAG( ArenaDescribe(VMArena2Arena(vmArena), DIAG_STREAM); );
-
   res = VMCreate(&vm, size);
   if (res != ResOK)
     goto failVMCreate;
@@ -1054,6 +1051,10 @@ static Res vmArenaExtend(VMArena vmArena, Size size)
   /* more than vmArena->extendBy (because there will be fewer than */
   /* size bytes free in the new chunk).  Fix this. */
   chunkSize = vmArena->extendBy + size;
+
+  DIAG_WRITEF(( DIAG_STREAM, "\n** vmArenaExtend $U\n", chunkSize, NULL ));
+  DIAG( ArenaDescribe(VMArena2Arena(vmArena), DIAG_STREAM); );
+
   res = VMChunkCreate(&newChunk, vmArena, chunkSize);
   /* .improve.chunk-create.fail: If we fail we could try again */
   /* (with a smaller size, say).  We don't do this. */

From 050b0a7165e6a9b47a5d50587814ac3163d8483f Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Mon, 21 May 2007 15:45:12 +0100
Subject: [PATCH 17/53] Mps br/diag: amcss.c: revert previous change

(make initial-size to mps_arena_create comically small,
   to prompt VMChunkCreates and occasional MPS_RESERVE_BLOCK: 7's, ie.
   commit-limit),
   so mps_arena_create asks for 2*testArenaSIZE as before.

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

diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index b3c55a0a812..76a5088360f 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -294,7 +294,7 @@ int main(int argc, char **argv)
 
   randomize(argc, argv);
 
-  die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE/8),
+  die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
       "arena_create");
   mps_message_type_enable(arena, mps_message_type_gc());
   mps_message_type_enable(arena, mps_message_type_gc_start());

From e3c37ff15ec0937fb19f2bd211c0552b68ce4dca Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Mon, 21 May 2007 16:28:50 +0100
Subject: [PATCH 18/53] Mps br/diag: diag-out with writef and diag_stream does
 not work in cet.

Hope to fix in time, but for now I need DIAG-out to work, so switch
to printf (yes, really, I know, sorry).
Also, only do DIAG-out in variety.di, to avoid damage to .ci.
So for now, remove DIAG_WRITEF and DIAG from arenavm and trace.
To test, add DIAG_PRINTF in trace.

Copied from Perforce
 Change: 162387
 ServerID: perforce.ravenbrook.com
---
 mps/code/arenavm.c |  3 ---
 mps/code/config.h  |  7 +++++++
 mps/code/diag.c    | 12 ++----------
 mps/code/mpm.h     | 38 ++++++++++++++++++++++++++++++++------
 mps/code/trace.c   |  3 +--
 5 files changed, 42 insertions(+), 21 deletions(-)

diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index b9a84026246..5f4921bdbc3 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -1052,9 +1052,6 @@ static Res vmArenaExtend(VMArena vmArena, Size size)
   /* size bytes free in the new chunk).  Fix this. */
   chunkSize = vmArena->extendBy + size;
 
-  DIAG_WRITEF(( DIAG_STREAM, "\n** vmArenaExtend $U\n", chunkSize, NULL ));
-  DIAG( ArenaDescribe(VMArena2Arena(vmArena), DIAG_STREAM); );
-
   res = VMChunkCreate(&newChunk, vmArena, chunkSize);
   /* .improve.chunk-create.fail: If we fail we could try again */
   /* (with a smaller size, say).  We don't do this. */
diff --git a/mps/code/config.h b/mps/code/config.h
index 7fa0b89c8a4..07531878614 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -45,6 +45,13 @@
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
 #define CONFIG_DEBUG
+/* Choose a DIAG_WITH_... output method.
+ * (We need to choose because the DIAG output system is under 
+ * development.  When it works, this will simply be the same as 
+ * "CONFIG_DEBUG".  RHSK 2007-05-21).
+ */
+/* #define DIAG_WITH_STREAM_AND_WRITEF -- this does not work in CET */
+#define DIAG_WITH_PRINTF
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_CI) || defined(CONFIG_VAR_CE) /* Cool varieties */
diff --git a/mps/code/diag.c b/mps/code/diag.c
index b48dbf5ff27..02592edb9ff 100644
--- a/mps/code/diag.c
+++ b/mps/code/diag.c
@@ -10,7 +10,7 @@
 #include "mpm.h"
 #include "mpslib.h" /* for mps_lib_stdout */
 
-#if defined(DIAGNOSTICS)
+#if defined(DIAG_WITH_STREAM_AND_WRITEF)
 
 Bool DiagEnabledGlobal = TRUE;
 
@@ -19,24 +19,16 @@ Bool DiagIsOn(void)
   return DiagEnabledGlobal;
 }
 
-
 mps_lib_FILE *DiagStream(void)
 {
   return mps_lib_stdout;
 }
 
-
-#elif defined(DIAGNOSTICS_NONE)
-
-#else
-
-#error "No diagnostics configured."
-
 #endif
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2003 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2007 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index f10d491076b..404d0bac54a 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -934,6 +934,23 @@ extern void StackProbe(Size depth);
 #define STATISTIC_STAT(gather) BEGIN gather; END
 #define STATISTIC_WRITE(format, arg) (format), (arg),
 
+#elif defined(DIAGNOSTICS_NONE)
+
+#define STATISTIC(gather) DISCARD(((gather), 0))
+#define STATISTIC_STAT(gather) DISCARD_STAT(gather)
+#define STATISTIC_WRITE(format, arg)
+
+#else
+
+#error "No diagnostics configured."
+
+#endif
+
+
+/* ------------ DIAG_WITH_STREAM_AND_WRITEF --------------- */
+
+#if defined(DIAG_WITH_STREAM_AND_WRITEF)
+
 /* Diagnostic Calculation and Output */
 Bool DiagIsOn(void);
 mps_lib_FILE *DiagStream(void);
@@ -953,19 +970,28 @@ mps_lib_FILE *DiagStream(void);
   } \
 )
 
-#elif defined(DIAGNOSTICS_NONE)
-
-#define STATISTIC(gather) DISCARD(((gather), 0))
-#define STATISTIC_STAT(gather) DISCARD_STAT(gather)
-#define STATISTIC_WRITE(format, arg)
+#else
 
 /* Diagnostic Calculation and Output */
 #define DIAG(s) BEGIN END
 #define DIAG_WRITEF(args) BEGIN END
 
+#endif
+
+/* ------------ DIAG_WITH_PRINTF --------------- */
+
+#if defined(DIAG_WITH_PRINTF)
+
+#include <stdio.h>
+
+#define DIAG_PRINTF(args) BEGIN\
+  printf args ; \
+  END
+
 #else
 
-#error "No diagnostics configured."
+#define DIAG_PRINTF(args) BEGIN\
+  END
 
 #endif
 
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 914ccd368d8..f48908916c4 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1570,10 +1570,9 @@ void TraceStart(Trace trace, double mortality,
 
   arena = trace->arena;
 
-  DIAG_WRITEF(( DIAG_STREAM,  "\n** TraceStart: $S\n", (WriteFS)trace->startMessage.why, NULL ));
   if (why != TraceStartWhyCHAIN_GEN0CAP) {
     /* a non-minor collection */
-    DIAG( ArenaDescribe(arena, DIAG_STREAM); );
+    DIAG_PRINTF(( "\n>MPS> TraceStart non-minor: %s\n", trace->startMessage.why ));
   }
 
   message = TraceStartMessageMessage(&trace->startMessage);

From 079c82256e1bc5a038808fd2378ad1b8e29eeb5d Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Tue, 22 May 2007 17:49:20 +0100
Subject: [PATCH 19/53] Mps br/diag: trace: always diag_printf-out the reason
 why this

trace started.  This is just to test the DIAG-out mechanism; it
only affects variety.di.

Copied from Perforce
 Change: 162389
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index f48908916c4..f304b48857c 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1567,13 +1567,11 @@ void TraceStart(Trace trace, double mortality,
   AVER(0.0 <= mortality);
   AVER(mortality <= 1.0);
   AVER(finishingTime >= 0.0);
+  UNUSED(why);
 
   arena = trace->arena;
 
-  if (why != TraceStartWhyCHAIN_GEN0CAP) {
-    /* a non-minor collection */
-    DIAG_PRINTF(( "\n>MPS> TraceStart non-minor: %s\n", trace->startMessage.why ));
-  }
+  DIAG_PRINTF(( "\nMPS: TraceStart: %s\n", trace->startMessage.why ));
 
   message = TraceStartMessageMessage(&trace->startMessage);
   /* Attempt to re-use message.

From 5189c6c12ed9cbfd530e9975c58e126d220c95a3 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 23 May 2007 14:28:10 +0100
Subject: [PATCH 20/53] Mps br/diag: version.c: release = @162393

Copied from Perforce
 Change: 162393
 ServerID: perforce.ravenbrook.com
---
 mps/code/version.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/mps/code/version.c b/mps/code/version.c
index a9f5ed08e00..2e41ca3f937 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -1,7 +1,7 @@
 /* version.c: VERSION INSPECTION
  *
  * $Id$
- * Copyright (c) 2001, 2006 Ravenbrook Limited.  
+ * Copyright (c) 2001, 2006, 2007 Ravenbrook Limited.  
  * See end of file for license.
  *
  * PURPOSE
@@ -29,7 +29,7 @@ SRCID(version, "$Id$");
  * (Note: before 2006-02-01 the style was "release.epcore.chub")
  */
 
-#define MPS_RELEASE "release/1.107.0"
+#define MPS_RELEASE "@162393"
 
 
 /* MPSCopyrightNotice -- copyright notice for the binary
@@ -39,7 +39,7 @@ SRCID(version, "$Id$");
  */
 
 char MPSCopyrightNotice[] =
-  "Portions copyright (c) 2006 Ravenbrook Limited and Global Graphics Software.";
+  "Portions copyright (c) 2007 Ravenbrook Limited and Global Graphics Software.";
 
 
 /* MPSVersion -- return version string
@@ -63,7 +63,7 @@ char *MPSVersion(void)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2002, 2006 Ravenbrook Limited 
+ * Copyright (C) 2001-2002, 2006, 2007 Ravenbrook Limited 
  * <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.

From 6c68e810990f80cfd071519ca3aea9d5e0555dc0 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 23 May 2007 15:45:32 +0100
Subject: [PATCH 21/53] Mps br/diag: release exp-162395:

Switch from DIAG_WITH_PRINTF to _WITH_STREAM_WRITEF.
(Still just from TraceStart).

Copied from Perforce
 Change: 162395
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h  | 4 ++--
 mps/code/trace.c   | 2 +-
 mps/code/version.c | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 07531878614..89c243a62a0 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -50,8 +50,8 @@
  * development.  When it works, this will simply be the same as 
  * "CONFIG_DEBUG".  RHSK 2007-05-21).
  */
-/* #define DIAG_WITH_STREAM_AND_WRITEF -- this does not work in CET */
-#define DIAG_WITH_PRINTF
+#define DIAG_WITH_STREAM_AND_WRITEF
+/*#define DIAG_WITH_PRINTF*/
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_CI) || defined(CONFIG_VAR_CE) /* Cool varieties */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index f304b48857c..0cc1cc6be3b 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1571,7 +1571,7 @@ void TraceStart(Trace trace, double mortality,
 
   arena = trace->arena;
 
-  DIAG_PRINTF(( "\nMPS: TraceStart: %s\n", trace->startMessage.why ));
+  DIAG_WRITEF(( DIAG_STREAM, "\nMPS: TraceStart: $S\n", (WriteFS)trace->startMessage.why, NULL ));
 
   message = TraceStartMessageMessage(&trace->startMessage);
   /* Attempt to re-use message.
diff --git a/mps/code/version.c b/mps/code/version.c
index 2e41ca3f937..d2fb89ecee1 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -29,7 +29,7 @@ SRCID(version, "$Id$");
  * (Note: before 2006-02-01 the style was "release.epcore.chub")
  */
 
-#define MPS_RELEASE "@162393"
+#define MPS_RELEASE "exp-162395"
 
 
 /* MPSCopyrightNotice -- copyright notice for the binary

From dad98183fca36f25b40a87aff261cb1d1a122265 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 23 May 2007 16:39:26 +0100
Subject: [PATCH 22/53] Mps br/diag: back to diag_with_printf again.

Copied from Perforce
 Change: 162397
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h | 4 ++--
 mps/code/trace.c  | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 89c243a62a0..07531878614 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -50,8 +50,8 @@
  * development.  When it works, this will simply be the same as 
  * "CONFIG_DEBUG".  RHSK 2007-05-21).
  */
-#define DIAG_WITH_STREAM_AND_WRITEF
-/*#define DIAG_WITH_PRINTF*/
+/* #define DIAG_WITH_STREAM_AND_WRITEF -- this does not work in CET */
+#define DIAG_WITH_PRINTF
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_CI) || defined(CONFIG_VAR_CE) /* Cool varieties */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 0cc1cc6be3b..f304b48857c 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1571,7 +1571,7 @@ void TraceStart(Trace trace, double mortality,
 
   arena = trace->arena;
 
-  DIAG_WRITEF(( DIAG_STREAM, "\nMPS: TraceStart: $S\n", (WriteFS)trace->startMessage.why, NULL ));
+  DIAG_PRINTF(( "\nMPS: TraceStart: %s\n", trace->startMessage.why ));
 
   message = TraceStartMessageMessage(&trace->startMessage);
   /* Attempt to re-use message.

From ac1f4fe729bdac19bdf9416d8cbf1367bd2d2fc4 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 23 May 2007 16:54:25 +0100
Subject: [PATCH 23/53] Mps br/diag: diag in tracestart: show
 arena->chunkserial, and

output why as number (for conciseness).

Copied from Perforce
 Change: 162398
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index f304b48857c..2d4a6bf1083 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1567,11 +1567,11 @@ void TraceStart(Trace trace, double mortality,
   AVER(0.0 <= mortality);
   AVER(mortality <= 1.0);
   AVER(finishingTime >= 0.0);
-  UNUSED(why);
+  UNUSED(why);  /* except perhaps in DIAG varieties */
 
   arena = trace->arena;
 
-  DIAG_PRINTF(( "\nMPS: TraceStart: %s\n", trace->startMessage.why ));
+  DIAG_PRINTF(( "\nMPS: TraceStart why: %d; arena->Chunks: %u\n", why, arena->chunkSerial ));
 
   message = TraceStartMessageMessage(&trace->startMessage);
   /* Attempt to re-use message.

From 2e979e4340705fab11858123d6d1c3ac99315d25 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 23 May 2007 16:56:01 +0100
Subject: [PATCH 24/53] Mps br/diag: release exp-162399

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

diff --git a/mps/code/version.c b/mps/code/version.c
index d2fb89ecee1..340ed5c3293 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -29,7 +29,7 @@ SRCID(version, "$Id$");
  * (Note: before 2006-02-01 the style was "release.epcore.chub")
  */
 
-#define MPS_RELEASE "exp-162395"
+#define MPS_RELEASE "exp-162399"
 
 
 /* MPSCopyrightNotice -- copyright notice for the binary

From 919cb4e84c2364e44c8a863853f8b412627594cb Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 20 Jun 2007 13:42:01 +0100
Subject: [PATCH 25/53] Mps br/diag finalcv and fmtdytst: (comments only) add
 comments.

Copied from Perforce
 Change: 162608
 ServerID: perforce.ravenbrook.com
---
 mps/code/finalcv.c  | 21 ++++++++++++++++++++-
 mps/code/fmtdytst.c | 10 ++++++++++
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index 0c8956d2133..e9bff644ddd 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -60,6 +60,7 @@ static mps_word_t dylan_int_int(mps_word_t x)
 }
 
 
+/* note: static, so auto-initialised to NULL */
 static void *root[rootCOUNT];
 
 
@@ -117,6 +118,11 @@ static void *test(void *arg, size_t s)
       "root_create\n");
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
 
+  /* Make registered-for-finalization objects. */
+  /* .references-to-obj-0: Note that the first root ref (root[0]) is */
+  /* passed to dylan_init each time, so the root[0] object (only) */
+  /* may be referred to by other registered-for-finalization */
+  /* objects. */
   /* <design/poolmrg/#test.promise.ut.alloc> */
   for(i = 0; i < rootCOUNT; ++i) {
     do {
@@ -134,22 +140,35 @@ static void *test(void *arg, size_t s)
 
   /* <design/poolmrg/#test.promise.ut.churn> */
   while (mps_collections(arena) < collectionCOUNT) {
+    
+    /* Allocate a lot of stuff (unreachable garbage, so it will */
+    /* probably only ever cause a minor collection). */
     churn(ap);
+    
+    /* Maybe make some objects ready-to-finalize */
     /* <design/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 */
+          /* for this object, either... */
           if (rnd() % 2 == 0) {
+            /* ...definalize it, or */
             die(mps_definalize(arena, &root[i]), "definalize\n");
             state[i] = deadSTATE;
           } else {
+            /* ...expect it to be finalized soon */
             state[i] = finalizableSTATE;
           }
+          /* Drop the root reference to it; this probably* makes it */
+          /* non-E-reachable: so either dead, or ready-to-finalize. */
+          /* (*: the exception is the root[0] object, see  */
+          /* .references-to-obj-0.) */
           root[i] = NULL;
         }
       }
     }
+
+    /* Test any finalized objects, and perhaps resurrect some */
     while (mps_message_poll(arena)) {
       mps_word_t *obj;
       mps_word_t objind;
diff --git a/mps/code/fmtdytst.c b/mps/code/fmtdytst.c
index ede84f679e8..0442ebd1a13 100644
--- a/mps/code/fmtdytst.c
+++ b/mps/code/fmtdytst.c
@@ -82,6 +82,16 @@ static mps_res_t dylan_make_wrapper_wrapper(void)
 }
 
 
+/* dylan_init -- turn raw memory into initialised dylan-vector (or pad)
+ *
+ * If the raw memory is large enough, initialises it to a dylan-vector,
+ * whose slots are initialised to either dylan-ints, or valid refs, at 
+ * random.
+ * Caller must supply an array of (at least 1) valid refs to copy, via
+ * the "refs" and "nr_refs" arguments.
+ * (Makes a pad if the raw memory is too small to hold a dylan-vector)
+ */
+
 mps_res_t dylan_init(mps_addr_t addr, size_t size,
                      mps_addr_t *refs, size_t nr_refs)
 {

From a3c3edf4f628f9bf43568f6ac16f8268330d9d92 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 20 Jun 2007 14:44:16 +0100
Subject: [PATCH 26/53] Mps br/diag finalcv: (comments only) add comments.

Copied from Perforce
 Change: 162611
 ServerID: perforce.ravenbrook.com
---
 mps/code/finalcv.c | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index e9bff644ddd..cc7af27f9ac 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -64,6 +64,8 @@ static mps_word_t dylan_int_int(mps_word_t x)
 static void *root[rootCOUNT];
 
 
+/* churn -- allocate a lot of stuff (unreachable garbage, so it will */
+/* probably only ever cause a minor collection). */
 static void churn(mps_ap_t ap)
 {
   int i;
@@ -141,8 +143,7 @@ static void *test(void *arg, size_t s)
   /* <design/poolmrg/#test.promise.ut.churn> */
   while (mps_collections(arena) < collectionCOUNT) {
     
-    /* Allocate a lot of stuff (unreachable garbage, so it will */
-    /* probably only ever cause a minor collection). */
+    /* Perhaps cause (minor) collection */
     churn(ap);
     
     /* Maybe make some objects ready-to-finalize */

From ae7db286471daa36f932f75c366f6ad4a6447f02 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 20 Jun 2007 14:58:31 +0100
Subject: [PATCH 27/53] Mps br/diag fint1658.c: new finalization test, with
 guardians on

more than one seg.

Copied from Perforce
 Change: 162612
 ServerID: perforce.ravenbrook.com
---
 mps/code/fint1658.c | 269 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 269 insertions(+)
 create mode 100644 mps/code/fint1658.c

diff --git a/mps/code/fint1658.c b/mps/code/fint1658.c
new file mode 100644
index 00000000000..cc7af27f9ac
--- /dev/null
+++ b/mps/code/fint1658.c
@@ -0,0 +1,269 @@
+/* finalcv.c: FINALIZATION COVERAGE TEST
+ *
+ * $Id$
+ * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
+ * Portions copyright (C) 2002 Global Graphics Software.
+ *
+ * DESIGN
+ *
+ * See <design/poolmrg/#test>.
+ *
+ * DEPENDENCIES
+ *
+ * This test uses the dylan object format, but the reliance on this
+ * particular format is not great and could be removed.
+ *
+ * NOTES
+ *
+ * This code was created by first copying <code/weakcv.c>
+ */
+
+#include "testlib.h"
+#include "mps.h"
+#include "mpscamc.h"
+#include "mpsavm.h"
+#include "fmtdy.h"
+#include "fmtdytst.h"
+#include "mpstd.h"
+#ifdef MPS_OS_W3
+#include "mpsw3.h"
+#endif
+#include <stdlib.h>
+
+
+#define testArenaSIZE   ((size_t)16<<20)
+#define rootCOUNT 20
+#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
+
+/* testChain -- generation parameters for the test */
+
+static mps_gen_param_s testChain[genCOUNT] = {
+  { 150, 0.85 }, { 170, 0.45 } };
+
+
+/* tags an integer according to dylan format */
+static mps_word_t dylan_int(mps_word_t x)
+{
+  return (x << 2)|1;
+}
+
+
+/* converts a dylan format int to an int (untags) */
+static mps_word_t dylan_int_int(mps_word_t x)
+{
+  return x >> 2;
+}
+
+
+/* note: static, so auto-initialised to NULL */
+static void *root[rootCOUNT];
+
+
+/* churn -- allocate a lot of stuff (unreachable garbage, so it will */
+/* probably only ever cause a minor collection). */
+static void churn(mps_ap_t ap)
+{
+  int i;
+  mps_addr_t p;
+  mps_res_t e;
+
+  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));
+  }
+  p = NULL;
+}
+
+
+enum {
+  rootSTATE,
+  deadSTATE,
+  finalizableSTATE,
+  finalizedSTATE
+};
+
+
+static void *test(void *arg, size_t s)
+{
+  int i;                        /* index */
+  mps_ap_t ap;
+  mps_fmt_t fmt;
+  mps_chain_t chain;
+  mps_pool_t amc;
+  mps_res_t e;
+  mps_root_t mps_root[2];
+  int state[rootCOUNT];
+  mps_arena_t arena;
+  void *p = NULL;
+  mps_message_t message;
+
+  arena = (mps_arena_t)arg;
+  (void)s;
+
+  die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n");
+  die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
+  die(mps_pool_create(&amc, arena, mps_class_amc(), fmt, chain),
+      "pool_create amc\n");
+  die(mps_root_create_table(&mps_root[0], arena, MPS_RANK_EXACT, (mps_rm_t)0,
+                            root, (size_t)rootCOUNT),
+      "root_create\n");
+  die(mps_root_create_table(&mps_root[1], arena, MPS_RANK_EXACT, (mps_rm_t)0,
+                            &p, (size_t)1),
+      "root_create\n");
+  die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
+
+  /* Make registered-for-finalization objects. */
+  /* .references-to-obj-0: Note that the first root ref (root[0]) is */
+  /* passed to dylan_init each time, so the root[0] object (only) */
+  /* may be referred to by other registered-for-finalization */
+  /* objects. */
+  /* <design/poolmrg/#test.promise.ut.alloc> */
+  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));
+    ((mps_word_t *)p)[2] = dylan_int(i);
+    die(mps_finalize(arena, &p), "finalize\n");
+    root[i] = p; state[i] = rootSTATE;
+  }
+  p = NULL;
+
+  mps_message_type_enable(arena, mps_message_type_finalization());
+
+  /* <design/poolmrg/#test.promise.ut.churn> */
+  while (mps_collections(arena) < collectionCOUNT) {
+    
+    /* Perhaps cause (minor) collection */
+    churn(ap);
+    
+    /* Maybe make some objects ready-to-finalize */
+    /* <design/poolmrg/#test.promise.ut.drop> */
+    for (i = 0; i < rootCOUNT; ++i) {
+      if (root[i] != NULL && state[i] == rootSTATE) {
+        if (rnd() % finalizationRATE == 0) {
+          /* for this object, either... */
+          if (rnd() % 2 == 0) {
+            /* ...definalize it, or */
+            die(mps_definalize(arena, &root[i]), "definalize\n");
+            state[i] = deadSTATE;
+          } else {
+            /* ...expect it to be finalized soon */
+            state[i] = finalizableSTATE;
+          }
+          /* Drop the root reference to it; this probably* makes it */
+          /* non-E-reachable: so either dead, or ready-to-finalize. */
+          /* (*: the exception is the root[0] object, see  */
+          /* .references-to-obj-0.) */
+          root[i] = NULL;
+        }
+      }
+    }
+
+    /* Test any finalized objects, and perhaps resurrect some */
+    while (mps_message_poll(arena)) {
+      mps_word_t *obj;
+      mps_word_t objind;
+      mps_addr_t objaddr;
+
+      /* <design/poolmrg/#test.promise.ut.message> */
+      cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
+           "get");
+      mps_message_finalization_ref(&objaddr, arena, message);
+      obj = objaddr;
+      objind = dylan_int_int(obj[2]);
+      printf("Finalizing: object %lu at %p\n", objind, objaddr);
+      /* <design/poolmrg/#test.promise.ut.final.check> */
+      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);
+    }
+  }
+
+  /* @@@@ <design/poolmrg/#test.promise.ut.nofinal.check> missing */
+
+  mps_ap_destroy(ap);
+  mps_root_destroy(mps_root[1]);
+  mps_root_destroy(mps_root[0]);
+  mps_pool_destroy(amc);
+  mps_chain_destroy(chain);
+  mps_fmt_destroy(fmt);
+
+  return NULL;
+}
+
+
+int main(int argc, char **argv)
+{
+  mps_arena_t arena;
+  mps_thr_t thread;
+  void *r;
+
+  randomize(argc, argv);
+
+  die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
+      "arena_create\n");
+  die(mps_thread_reg(&thread, arena), "thread_reg\n");
+  mps_tramp(&r, test, arena, 0);
+  mps_thread_dereg(thread);
+  mps_arena_destroy(arena);
+
+  fflush(stdout); /* synchronize */
+  fprintf(stderr, "\nConclusion:  Failed to find any defects.\n");
+  return 0;
+}
+
+
+/* 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.
+ */

From 800ad828ea8dba3e465ee08fa9ede44cf7cca046 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 20 Jun 2007 15:41:18 +0100
Subject: [PATCH 28/53] Mps br/diag: (whitespace only) remove tabs from
 poolmrg.c

Copied from Perforce
 Change: 162614
 ServerID: perforce.ravenbrook.com
---
 mps/code/poolmrg.c | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 1493991b775..1ff3a51405a 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -596,18 +596,18 @@ static Res MRGRefSegScan(ScanState ss, MRGRefSeg refseg, MRG mrg)
 
       /* free guardians are not scanned */
       if (linkOfIndex(linkseg, i)->state != MRGGuardianFREE) {
-	ss->wasMarked = TRUE;
-	/* .ref.direct: We can access the reference directly */
-	/* because we are in a scan and the shield is exposed. */
-	if (TRACE_FIX1(ss, refPart->ref)) {
-	  res = TRACE_FIX2(ss, &(refPart->ref));
-	  if (res != ResOK)
-	    return res;
-	
-	  if (ss->rank == RankFINAL && !ss->wasMarked) { /* .improve.rank */
-	    MRGFinalize(arena, linkseg, i);
-	  }
-	}
+        ss->wasMarked = TRUE;
+        /* .ref.direct: We can access the reference directly */
+        /* because we are in a scan and the shield is exposed. */
+        if (TRACE_FIX1(ss, refPart->ref)) {
+          res = TRACE_FIX2(ss, &(refPart->ref));
+          if (res != ResOK)
+            return res;
+
+          if (ss->rank == RankFINAL && !ss->wasMarked) { /* .improve.rank */
+            MRGFinalize(arena, linkseg, i);
+          }
+        }
       }
     }
   } TRACE_SCAN_END(ss);

From 56a68939f47bf79a4c0ebbb26ea62688971556ef Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 20 Jun 2007 15:49:07 +0100
Subject: [PATCH 29/53] mps br/diag: (whitespace only) remove tabs from trace.c

Copied from Perforce
 Change: 162615
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 44 ++++++++++++++++++++++----------------------
 1 file changed, 22 insertions(+), 22 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 2d4a6bf1083..eb632de9920 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1617,13 +1617,13 @@ void TraceStart(Trace trace, double mortality,
           PoolGrey(SegPool(seg), trace, seg);
           if (TraceSetIsMember(SegGrey(seg), trace)) {
             trace->foundation += size;
-	  }
+          }
         }
 
         if ((SegPool(seg)->class->attr & AttrGC)
             && !TraceSetIsMember(SegWhite(seg), trace)) {
           trace->notCondemned += size;
-	}
+        }
       }
     } while (SegNext(&seg, arena, base));
   }
@@ -1951,21 +1951,21 @@ void ArenaExposeRemember(Globals globals, int remember)
     do {
       base = SegBase(seg);
       if(IsSubclassPoly(ClassOfSeg(seg), GCSegClassGet())) {
-	if(remember) {
-	  RefSet summary;
+        if(remember) {
+          RefSet summary;
 
-	  summary = SegSummary(seg);
-	  if(summary != RefSetUNIV) {
-	    Res res = arenaRememberSummaryOne(globals, base, summary);
-	    if(res != ResOK) {
-	      /* If we got an error then stop trying to remember any
-	      protections. */
-	      remember = 0;
-	    }
-	  }
-	}
-	SegSetSummary(seg, RefSetUNIV);
-	AVER(SegSM(seg) == AccessSetEMPTY);
+          summary = SegSummary(seg);
+          if(summary != RefSetUNIV) {
+            Res res = arenaRememberSummaryOne(globals, base, summary);
+            if(res != ResOK) {
+              /* If we got an error then stop trying to remember any
+              protections. */
+              remember = 0;
+            }
+          }
+        }
+        SegSetSummary(seg, RefSetUNIV);
+        AVER(SegSM(seg) == AccessSetEMPTY);
       }
     } while(SegNext(&seg, arena, base));
   }
@@ -1989,17 +1989,17 @@ void ArenaRestoreProtection(Globals globals)
       Bool b;
 
       if(block->the[i].base == (Addr)0) {
-	AVER(block->the[i].summary == RefSetUNIV);
-	continue;
+        AVER(block->the[i].summary == RefSetUNIV);
+        continue;
       }
       b = SegOfAddr(&seg, arena, block->the[i].base);
       if(b && SegBase(seg) == block->the[i].base) {
         AVER(IsSubclassPoly(ClassOfSeg(seg), GCSegClassGet()));
-	SegSetSummary(seg, block->the[i].summary);
+        SegSetSummary(seg, block->the[i].summary);
       } else {
-	/* Either seg has gone or moved, both of which are
-	   client errors. */
-	NOTREACHED;
+        /* Either seg has gone or moved, both of which are
+           client errors. */
+        NOTREACHED;
       }
     }
   }

From 22b7aa10171bb0ee0bc42eef562a386095ddcdd6 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 14:23:03 +0100
Subject: [PATCH 30/53] Mps br/diag: new fint1658.c: test for job001658,
 finalization promptness

Copied from Perforce
 Change: 162624
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk     |  7 +++++--
 mps/code/commpost.nmk | 10 ++++++++--
 mps/code/fint1658.c   |  8 ++++++--
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 93c77b2a9e4..148d6adb842 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -271,7 +271,7 @@ endif
 
 all: mpmss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
      mpsicv lockcov poolncv locv qs apss \
-     finalcv finaltest arenacv bttest teletest \
+     finalcv fint1658 finaltest arenacv bttest teletest \
      abqtest cbstest btcv mv2test messtest steptest \
      eventcnv walkt0 libcbt \
      mps.a mpsplan.a
@@ -296,7 +296,7 @@ testrun: mpmss apss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
 
 mpmss sacss amcss amcssth amcsshe amsss amssshe segsmss awlut awlutth \
   awluthe mpsicv lockcov poolncv locv qs apss \
-  finalcv finaltest arenacv bttest teletest \
+  finalcv fint1658 finaltest arenacv bttest teletest \
   expt825 \
   libcbt \
   abqtest cbstest btcv mv2test \
@@ -357,6 +357,9 @@ ifdef VARIETY
 $(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \
 	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
 
+$(PFM)/$(VARIETY)/fint1658: $(PFM)/$(VARIETY)/fint1658.o \
+	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
+
 $(PFM)/$(VARIETY)/finaltest: $(PFM)/$(VARIETY)/finaltest.o \
 	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
 
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 7ac31eef857..80fbd709b03 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -16,7 +16,8 @@
 
 all: mpmss.exe amcss.exe amsss.exe amssshe.exe segsmss.exe awlut.exe awluthe.exe\
      mpsicv.exe lockutw3.exe lockcov.exe poolncv.exe locv.exe qs.exe apss.exe \
-     finalcv.exe finaltest.exe arenacv.exe bttest.exe teletest.exe \
+     finalcv.exe fint1658.exe finaltest.exe \
+     arenacv.exe bttest.exe teletest.exe \
      abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe steptest.exe \
      locbwcss.exe locusss.exe \
      eventcnv.exe \
@@ -32,7 +33,8 @@ swall: mmsw.lib 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 finaltest.exe arenacv.exe bttest.exe teletest.exe \
+     finalcv.exe fint1658.exe finaltest.exe \
+     arenacv.exe bttest.exe teletest.exe \
      expt825.exe \
      abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe steptest.exe \
      walkt0.exe locbwcss.exe locusss.exe \
@@ -111,6 +113,10 @@ $(PFM)\$(VARIETY)\finalcv.exe: $(PFM)\$(VARIETY)\finalcv.obj \
 	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
 	$(MRGOBJ) $(TESTLIBOBJ)
 
+$(PFM)\$(VARIETY)\fint1658.exe: $(PFM)\$(VARIETY)\fint1658.obj \
+	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
+	$(MRGOBJ) $(TESTLIBOBJ)
+
 $(PFM)\$(VARIETY)\finaltest.exe: $(PFM)\$(VARIETY)\finaltest.obj \
 	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
 	$(MRGOBJ) $(TESTLIBOBJ)
diff --git a/mps/code/fint1658.c b/mps/code/fint1658.c
index cc7af27f9ac..0ef56131fe5 100644
--- a/mps/code/fint1658.c
+++ b/mps/code/fint1658.c
@@ -1,4 +1,4 @@
-/* finalcv.c: FINALIZATION COVERAGE TEST
+/* fint1658.c: Test for suspected defect described in job001658
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
@@ -15,7 +15,11 @@
  *
  * NOTES
  *
- * This code was created by first copying <code/weakcv.c>
+ * This code was created by first copying <code/finalcv.c>.
+ *
+ * The modifications are to make lots of guardians, such that they 
+ * don't all fit on one segment, in order to test for the (suspected) 
+ * finalization promptness defect described in job001658.
  */
 
 #include "testlib.h"

From 8d8b674765173fd3b211b7e09f02e3796f580ba2 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 14:25:31 +0100
Subject: [PATCH 31/53] mps br/diag: new fint1658.c: (comment) it doesn't work
 yet!

Copied from Perforce
 Change: 162625
 ServerID: perforce.ravenbrook.com
---
 mps/code/fint1658.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/mps/code/fint1658.c b/mps/code/fint1658.c
index 0ef56131fe5..ccf66a87e22 100644
--- a/mps/code/fint1658.c
+++ b/mps/code/fint1658.c
@@ -20,6 +20,9 @@
  * The modifications are to make lots of guardians, such that they 
  * don't all fit on one segment, in order to test for the (suspected) 
  * finalization promptness defect described in job001658.
+ *
+ *****  NOTE: It doesn't do that yet!  Currently it's just a copy of 
+ *****  finalcv.c.  RHSK 2007-06-21
  */
 
 #include "testlib.h"

From 798f8b14fc0d64cf8fbb87c25bd292e792f157ee Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 15:59:33 +0100
Subject: [PATCH 32/53] Mps br/diag: start to demonstrate job001658 defect:

Show that after finding one RankFINAL segment, traceFindGrey then
goes back to RankEXACT segs before tracing the next RankFINAL segment.

Copied from Perforce
 Change: 162626
 ServerID: perforce.ravenbrook.com
---
 mps/code/fint1658.c |  9 +++++----
 mps/code/poolmrg.c  |  3 +++
 mps/code/trace.c    | 28 ++++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/mps/code/fint1658.c b/mps/code/fint1658.c
index ccf66a87e22..33269c0906c 100644
--- a/mps/code/fint1658.c
+++ b/mps/code/fint1658.c
@@ -20,9 +20,6 @@
  * The modifications are to make lots of guardians, such that they 
  * don't all fit on one segment, in order to test for the (suspected) 
  * finalization promptness defect described in job001658.
- *
- *****  NOTE: It doesn't do that yet!  Currently it's just a copy of 
- *****  finalcv.c.  RHSK 2007-06-21
  */
 
 #include "testlib.h"
@@ -39,7 +36,11 @@
 
 
 #define testArenaSIZE   ((size_t)16<<20)
-#define rootCOUNT 20
+
+/* usually (ArenaAlign / sizeof(Ref)) = 1024 */
+/* so choose 2050 to force 3 segments of guardians */
+#define rootCOUNT 2050
+
 #define churnFACTOR 10
 #define finalizationRATE 6
 #define gcINTERVAL ((size_t)150 * 1024)
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 1ff3a51405a..b197aeca4d7 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -634,6 +634,9 @@ static Res MRGInit(Pool pool, va_list args)
   mrg->sig = MRGSig;
 
   AVERT(MRG, mrg);
+  DIAG_PRINTF(( "mrg->extendBy = %u, MRGGuardiansPerSeg = %u\n", 
+                (unsigned int) mrg->extendBy, 
+                (unsigned int) MRGGuardiansPerSeg(mrg) ));
   EVENT_PPP(PoolInit, pool, PoolArena(pool), ClassOfPool(pool));
   return ResOK;
 }
diff --git a/mps/code/trace.c b/mps/code/trace.c
index eb632de9920..a12adf12a83 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -993,8 +993,36 @@ static void traceReclaim(Trace trace)
  * which does not have a higher rank than any other such segment (i.e.,
  * a next segment to scan).  */
 
+static Bool traceFindGreyORIGINAL(Seg *segReturn, Rank *rankReturn,
+                                  Arena arena, TraceId ti);
+/* wrap debugging around original traceFindGrey */
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
                           Arena arena, TraceId ti)
+{
+  Bool found;
+  char this;
+
+  found = traceFindGreyORIGINAL(segReturn, rankReturn, arena, ti);
+
+  this = !found ? '0'
+         : (*rankReturn == RankAMBIG) ? 'A'
+         : (*rankReturn == RankEXACT) ? 'E'
+         : (*rankReturn == RankFINAL) ? 'F'
+         : (*rankReturn == RankWEAK) ? 'W'
+         : '?';
+
+  DIAG_PRINTF(( "%c", this ));
+  if(!found) {
+    /* that's the end of the trace */
+    DIAG_PRINTF(( "\n" ));
+  }
+  
+  return found;
+}
+
+/* original traceFindGrey */
+static Bool traceFindGreyORIGINAL(Seg *segReturn, Rank *rankReturn,
+                                  Arena arena, TraceId ti)
 {
   Rank rank;
   Trace trace;

From 55a137983863f9eb8756d1478ae24b040d309cec Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 17:02:28 +0100
Subject: [PATCH 33/53] mps br/diag finalcv: (clarify only) improve hash-def
 names and comments.

Copied from Perforce
 Change: 162627
 ServerID: perforce.ravenbrook.com
---
 mps/code/finalcv.c | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index cc7af27f9ac..8e5deaf0030 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -37,7 +37,11 @@
 #define finalizationRATE 6
 #define gcINTERVAL ((size_t)150 * 1024)
 #define collectionCOUNT 3
-#define slotSIZE (3*sizeof(mps_word_t))
+
+/* 3 words:  wrapper  |  vector-len  |  first-slot */
+#define vectorSIZE (3*sizeof(mps_word_t))
+#define vectorSLOT 2
+
 #define genCOUNT 2
 
 /* testChain -- generation parameters for the test */
@@ -100,6 +104,7 @@ static void *test(void *arg, size_t s)
   mps_pool_t amc;
   mps_res_t e;
   mps_root_t mps_root[2];
+  mps_addr_t nullref = NULL;
   int state[rootCOUNT];
   mps_arena_t arena;
   void *p = NULL;
@@ -121,18 +126,17 @@ static void *test(void *arg, size_t s)
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
 
   /* Make registered-for-finalization objects. */
-  /* .references-to-obj-0: Note that the first root ref (root[0]) is */
-  /* passed to dylan_init each time, so the root[0] object (only) */
-  /* may be referred to by other registered-for-finalization */
-  /* objects. */
   /* <design/poolmrg/#test.promise.ut.alloc> */
   for(i = 0; i < rootCOUNT; ++i) {
     do {
-      MPS_RESERVE_BLOCK(e, p, ap, slotSIZE);
+      MPS_RESERVE_BLOCK(e, p, ap, vectorSIZE);
       die(e, "MPS_RES_OK");
-      die(dylan_init(p, slotSIZE, root, 1), "dylan_init");
-    } while (!mps_commit(ap, p, slotSIZE));
-    ((mps_word_t *)p)[2] = dylan_int(i);
+      die(dylan_init(p, vectorSIZE, &nullref, 1), "dylan_init");
+    } while (!mps_commit(ap, p, vectorSIZE));
+
+    /* store index in vector's slot */
+    ((mps_word_t *)p)[vectorSLOT] = dylan_int(i);
+
     die(mps_finalize(arena, &p), "finalize\n");
     root[i] = p; state[i] = rootSTATE;
   }
@@ -160,10 +164,8 @@ static void *test(void *arg, size_t s)
             /* ...expect it to be finalized soon */
             state[i] = finalizableSTATE;
           }
-          /* Drop the root reference to it; this probably* makes it */
+          /* Drop the root reference to it; this makes it */
           /* non-E-reachable: so either dead, or ready-to-finalize. */
-          /* (*: the exception is the root[0] object, see  */
-          /* .references-to-obj-0.) */
           root[i] = NULL;
         }
       }
@@ -180,7 +182,7 @@ static void *test(void *arg, size_t s)
            "get");
       mps_message_finalization_ref(&objaddr, arena, message);
       obj = objaddr;
-      objind = dylan_int_int(obj[2]);
+      objind = dylan_int_int(obj[vectorSLOT]);
       printf("Finalizing: object %lu at %p\n", objind, objaddr);
       /* <design/poolmrg/#test.promise.ut.final.check> */
       cdie(root[objind] == NULL, "finalized live");

From 5677fd8d9dcb55f6b40330b3536cefc756492a6d Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 17:06:13 +0100
Subject: [PATCH 34/53] Mps br/diag: fint1658.c:  (from finalcv) (clarify only)
 improve

hash-def names and comments.

Copied from Perforce
 Change: 162628
 ServerID: perforce.ravenbrook.com
---
 mps/code/fint1658.c | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/mps/code/fint1658.c b/mps/code/fint1658.c
index 33269c0906c..8de7f2ab398 100644
--- a/mps/code/fint1658.c
+++ b/mps/code/fint1658.c
@@ -45,7 +45,11 @@
 #define finalizationRATE 6
 #define gcINTERVAL ((size_t)150 * 1024)
 #define collectionCOUNT 3
-#define slotSIZE (3*sizeof(mps_word_t))
+
+/* 3 words:  wrapper  |  vector-len  |  first-slot */
+#define vectorSIZE (3*sizeof(mps_word_t))
+#define vectorSLOT 2
+
 #define genCOUNT 2
 
 /* testChain -- generation parameters for the test */
@@ -108,6 +112,7 @@ static void *test(void *arg, size_t s)
   mps_pool_t amc;
   mps_res_t e;
   mps_root_t mps_root[2];
+  mps_addr_t nullref = NULL;
   int state[rootCOUNT];
   mps_arena_t arena;
   void *p = NULL;
@@ -129,18 +134,17 @@ static void *test(void *arg, size_t s)
   die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
 
   /* Make registered-for-finalization objects. */
-  /* .references-to-obj-0: Note that the first root ref (root[0]) is */
-  /* passed to dylan_init each time, so the root[0] object (only) */
-  /* may be referred to by other registered-for-finalization */
-  /* objects. */
   /* <design/poolmrg/#test.promise.ut.alloc> */
   for(i = 0; i < rootCOUNT; ++i) {
     do {
-      MPS_RESERVE_BLOCK(e, p, ap, slotSIZE);
+      MPS_RESERVE_BLOCK(e, p, ap, vectorSIZE);
       die(e, "MPS_RES_OK");
-      die(dylan_init(p, slotSIZE, root, 1), "dylan_init");
-    } while (!mps_commit(ap, p, slotSIZE));
-    ((mps_word_t *)p)[2] = dylan_int(i);
+      die(dylan_init(p, vectorSIZE, &nullref, 1), "dylan_init");
+    } while (!mps_commit(ap, p, vectorSIZE));
+
+    /* store index in vector's slot */
+    ((mps_word_t *)p)[vectorSLOT] = dylan_int(i);
+
     die(mps_finalize(arena, &p), "finalize\n");
     root[i] = p; state[i] = rootSTATE;
   }
@@ -168,10 +172,8 @@ static void *test(void *arg, size_t s)
             /* ...expect it to be finalized soon */
             state[i] = finalizableSTATE;
           }
-          /* Drop the root reference to it; this probably* makes it */
+          /* Drop the root reference to it; this makes it */
           /* non-E-reachable: so either dead, or ready-to-finalize. */
-          /* (*: the exception is the root[0] object, see  */
-          /* .references-to-obj-0.) */
           root[i] = NULL;
         }
       }
@@ -188,7 +190,7 @@ static void *test(void *arg, size_t s)
            "get");
       mps_message_finalization_ref(&objaddr, arena, message);
       obj = objaddr;
-      objind = dylan_int_int(obj[2]);
+      objind = dylan_int_int(obj[vectorSLOT]);
       printf("Finalizing: object %lu at %p\n", objind, objaddr);
       /* <design/poolmrg/#test.promise.ut.final.check> */
       cdie(root[objind] == NULL, "finalized live");

From fb7d9768b8cd5eaf1b04fc188aaa34df7b4c3cd7 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 17:12:59 +0100
Subject: [PATCH 35/53] Mps br/diag: new fin1658a.c -- second test for
 job001658

Copied from Perforce
 Change: 162629
 ServerID: perforce.ravenbrook.com
---
 mps/code/fin1658a.c | 279 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 279 insertions(+)
 create mode 100644 mps/code/fin1658a.c

diff --git a/mps/code/fin1658a.c b/mps/code/fin1658a.c
new file mode 100644
index 00000000000..8de7f2ab398
--- /dev/null
+++ b/mps/code/fin1658a.c
@@ -0,0 +1,279 @@
+/* fint1658.c: Test for suspected defect described in job001658
+ *
+ * $Id$
+ * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
+ * Portions copyright (C) 2002 Global Graphics Software.
+ *
+ * DESIGN
+ *
+ * See <design/poolmrg/#test>.
+ *
+ * DEPENDENCIES
+ *
+ * This test uses the dylan object format, but the reliance on this
+ * particular format is not great and could be removed.
+ *
+ * NOTES
+ *
+ * This code was created by first copying <code/finalcv.c>.
+ *
+ * The modifications are to make lots of guardians, such that they 
+ * don't all fit on one segment, in order to test for the (suspected) 
+ * finalization promptness defect described in job001658.
+ */
+
+#include "testlib.h"
+#include "mps.h"
+#include "mpscamc.h"
+#include "mpsavm.h"
+#include "fmtdy.h"
+#include "fmtdytst.h"
+#include "mpstd.h"
+#ifdef MPS_OS_W3
+#include "mpsw3.h"
+#endif
+#include <stdlib.h>
+
+
+#define testArenaSIZE   ((size_t)16<<20)
+
+/* usually (ArenaAlign / sizeof(Ref)) = 1024 */
+/* so choose 2050 to force 3 segments of guardians */
+#define rootCOUNT 2050
+
+#define churnFACTOR 10
+#define finalizationRATE 6
+#define gcINTERVAL ((size_t)150 * 1024)
+#define collectionCOUNT 3
+
+/* 3 words:  wrapper  |  vector-len  |  first-slot */
+#define vectorSIZE (3*sizeof(mps_word_t))
+#define vectorSLOT 2
+
+#define genCOUNT 2
+
+/* testChain -- generation parameters for the test */
+
+static mps_gen_param_s testChain[genCOUNT] = {
+  { 150, 0.85 }, { 170, 0.45 } };
+
+
+/* tags an integer according to dylan format */
+static mps_word_t dylan_int(mps_word_t x)
+{
+  return (x << 2)|1;
+}
+
+
+/* converts a dylan format int to an int (untags) */
+static mps_word_t dylan_int_int(mps_word_t x)
+{
+  return x >> 2;
+}
+
+
+/* note: static, so auto-initialised to NULL */
+static void *root[rootCOUNT];
+
+
+/* churn -- allocate a lot of stuff (unreachable garbage, so it will */
+/* probably only ever cause a minor collection). */
+static void churn(mps_ap_t ap)
+{
+  int i;
+  mps_addr_t p;
+  mps_res_t e;
+
+  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));
+  }
+  p = NULL;
+}
+
+
+enum {
+  rootSTATE,
+  deadSTATE,
+  finalizableSTATE,
+  finalizedSTATE
+};
+
+
+static void *test(void *arg, size_t s)
+{
+  int i;                        /* index */
+  mps_ap_t ap;
+  mps_fmt_t fmt;
+  mps_chain_t chain;
+  mps_pool_t amc;
+  mps_res_t e;
+  mps_root_t mps_root[2];
+  mps_addr_t nullref = NULL;
+  int state[rootCOUNT];
+  mps_arena_t arena;
+  void *p = NULL;
+  mps_message_t message;
+
+  arena = (mps_arena_t)arg;
+  (void)s;
+
+  die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n");
+  die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
+  die(mps_pool_create(&amc, arena, mps_class_amc(), fmt, chain),
+      "pool_create amc\n");
+  die(mps_root_create_table(&mps_root[0], arena, MPS_RANK_EXACT, (mps_rm_t)0,
+                            root, (size_t)rootCOUNT),
+      "root_create\n");
+  die(mps_root_create_table(&mps_root[1], arena, MPS_RANK_EXACT, (mps_rm_t)0,
+                            &p, (size_t)1),
+      "root_create\n");
+  die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n");
+
+  /* Make registered-for-finalization objects. */
+  /* <design/poolmrg/#test.promise.ut.alloc> */
+  for(i = 0; i < rootCOUNT; ++i) {
+    do {
+      MPS_RESERVE_BLOCK(e, p, ap, vectorSIZE);
+      die(e, "MPS_RES_OK");
+      die(dylan_init(p, vectorSIZE, &nullref, 1), "dylan_init");
+    } while (!mps_commit(ap, p, vectorSIZE));
+
+    /* store index in vector's slot */
+    ((mps_word_t *)p)[vectorSLOT] = dylan_int(i);
+
+    die(mps_finalize(arena, &p), "finalize\n");
+    root[i] = p; state[i] = rootSTATE;
+  }
+  p = NULL;
+
+  mps_message_type_enable(arena, mps_message_type_finalization());
+
+  /* <design/poolmrg/#test.promise.ut.churn> */
+  while (mps_collections(arena) < collectionCOUNT) {
+    
+    /* Perhaps cause (minor) collection */
+    churn(ap);
+    
+    /* Maybe make some objects ready-to-finalize */
+    /* <design/poolmrg/#test.promise.ut.drop> */
+    for (i = 0; i < rootCOUNT; ++i) {
+      if (root[i] != NULL && state[i] == rootSTATE) {
+        if (rnd() % finalizationRATE == 0) {
+          /* for this object, either... */
+          if (rnd() % 2 == 0) {
+            /* ...definalize it, or */
+            die(mps_definalize(arena, &root[i]), "definalize\n");
+            state[i] = deadSTATE;
+          } else {
+            /* ...expect it to be finalized soon */
+            state[i] = finalizableSTATE;
+          }
+          /* Drop the root reference to it; this makes it */
+          /* non-E-reachable: so either dead, or ready-to-finalize. */
+          root[i] = NULL;
+        }
+      }
+    }
+
+    /* Test any finalized objects, and perhaps resurrect some */
+    while (mps_message_poll(arena)) {
+      mps_word_t *obj;
+      mps_word_t objind;
+      mps_addr_t objaddr;
+
+      /* <design/poolmrg/#test.promise.ut.message> */
+      cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
+           "get");
+      mps_message_finalization_ref(&objaddr, arena, message);
+      obj = objaddr;
+      objind = dylan_int_int(obj[vectorSLOT]);
+      printf("Finalizing: object %lu at %p\n", objind, objaddr);
+      /* <design/poolmrg/#test.promise.ut.final.check> */
+      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);
+    }
+  }
+
+  /* @@@@ <design/poolmrg/#test.promise.ut.nofinal.check> missing */
+
+  mps_ap_destroy(ap);
+  mps_root_destroy(mps_root[1]);
+  mps_root_destroy(mps_root[0]);
+  mps_pool_destroy(amc);
+  mps_chain_destroy(chain);
+  mps_fmt_destroy(fmt);
+
+  return NULL;
+}
+
+
+int main(int argc, char **argv)
+{
+  mps_arena_t arena;
+  mps_thr_t thread;
+  void *r;
+
+  randomize(argc, argv);
+
+  die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
+      "arena_create\n");
+  die(mps_thread_reg(&thread, arena), "thread_reg\n");
+  mps_tramp(&r, test, arena, 0);
+  mps_thread_dereg(thread);
+  mps_arena_destroy(arena);
+
+  fflush(stdout); /* synchronize */
+  fprintf(stderr, "\nConclusion:  Failed to find any defects.\n");
+  return 0;
+}
+
+
+/* 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.
+ */

From ed2710c1208bc8ce491faf40850797393d8ce36a Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 17:23:01 +0100
Subject: [PATCH 36/53] Mps br/diag: trace.c: (fix w3 build) cast integer
 character constant to char

Copied from Perforce
 Change: 162630
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index a12adf12a83..11166fded25 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1004,12 +1004,12 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
 
   found = traceFindGreyORIGINAL(segReturn, rankReturn, arena, ti);
 
-  this = !found ? '0'
-         : (*rankReturn == RankAMBIG) ? 'A'
-         : (*rankReturn == RankEXACT) ? 'E'
-         : (*rankReturn == RankFINAL) ? 'F'
-         : (*rankReturn == RankWEAK) ? 'W'
-         : '?';
+  this = (char) ( !found ? '0'
+                  : (*rankReturn == RankAMBIG) ? 'A'
+                  : (*rankReturn == RankEXACT) ? 'E'
+                  : (*rankReturn == RankFINAL) ? 'F'
+                  : (*rankReturn == RankWEAK) ? 'W'
+                  : '?' );
 
   DIAG_PRINTF(( "%c", this ));
   if(!found) {

From 1f9a9f811896bf44889b34db35fd325a249e0dba Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 21 Jun 2007 19:26:00 +0100
Subject: [PATCH 37/53] Mps br/diag: fin1658a: confirms defect described in
 job001658.

Copied from Perforce
 Change: 162631
 ServerID: perforce.ravenbrook.com
---
 mps/code/comm.gmk     |   7 +-
 mps/code/commpost.nmk |   8 +-
 mps/code/fin1658a.c   | 168 +++++++++++++++++++-----------------------
 3 files changed, 88 insertions(+), 95 deletions(-)

diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 148d6adb842..d89ff964cdb 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -271,7 +271,7 @@ endif
 
 all: mpmss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
      mpsicv lockcov poolncv locv qs apss \
-     finalcv fint1658 finaltest arenacv bttest teletest \
+     finalcv fint1658 fin1658a finaltest arenacv bttest teletest \
      abqtest cbstest btcv mv2test messtest steptest \
      eventcnv walkt0 libcbt \
      mps.a mpsplan.a
@@ -296,7 +296,7 @@ testrun: mpmss apss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \
 
 mpmss sacss amcss amcssth amcsshe amsss amssshe segsmss awlut awlutth \
   awluthe mpsicv lockcov poolncv locv qs apss \
-  finalcv fint1658 finaltest arenacv bttest teletest \
+  finalcv fint1658 fin1658a finaltest arenacv bttest teletest \
   expt825 \
   libcbt \
   abqtest cbstest btcv mv2test \
@@ -360,6 +360,9 @@ $(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \
 $(PFM)/$(VARIETY)/fint1658: $(PFM)/$(VARIETY)/fint1658.o \
 	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
 
+$(PFM)/$(VARIETY)/fin1658a: $(PFM)/$(VARIETY)/fin1658a.o \
+	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
+
 $(PFM)/$(VARIETY)/finaltest: $(PFM)/$(VARIETY)/finaltest.o \
 	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
 
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 80fbd709b03..31bc4cdabd2 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -16,7 +16,7 @@
 
 all: mpmss.exe amcss.exe amsss.exe amssshe.exe segsmss.exe awlut.exe awluthe.exe\
      mpsicv.exe lockutw3.exe lockcov.exe poolncv.exe locv.exe qs.exe apss.exe \
-     finalcv.exe fint1658.exe finaltest.exe \
+     finalcv.exe fint1658.exe fin1658a.exe finaltest.exe \
      arenacv.exe bttest.exe teletest.exe \
      abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe steptest.exe \
      locbwcss.exe locusss.exe \
@@ -33,7 +33,7 @@ swall: mmsw.lib 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 fint1658.exe finaltest.exe \
+     finalcv.exe fint1658.exe fin1658a.exe finaltest.exe \
      arenacv.exe bttest.exe teletest.exe \
      expt825.exe \
      abqtest.exe cbstest.exe btcv.exe mv2test.exe messtest.exe steptest.exe \
@@ -117,6 +117,10 @@ $(PFM)\$(VARIETY)\fint1658.exe: $(PFM)\$(VARIETY)\fint1658.obj \
 	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
 	$(MRGOBJ) $(TESTLIBOBJ)
 
+$(PFM)\$(VARIETY)\fin1658a.exe: $(PFM)\$(VARIETY)\fin1658a.obj \
+	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
+	$(MRGOBJ) $(TESTLIBOBJ)
+
 $(PFM)\$(VARIETY)\finaltest.exe: $(PFM)\$(VARIETY)\finaltest.obj \
 	$(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(FMTTESTOBJ) \
 	$(MRGOBJ) $(TESTLIBOBJ)
diff --git a/mps/code/fin1658a.c b/mps/code/fin1658a.c
index 8de7f2ab398..0d75292dd37 100644
--- a/mps/code/fin1658a.c
+++ b/mps/code/fin1658a.c
@@ -1,4 +1,4 @@
-/* fint1658.c: Test for suspected defect described in job001658
+/* fin1658a.c: Test for suspected defect described in job001658
  *
  * $Id$
  * Copyright (c) 2001 Ravenbrook Limited.  See end of file for license.
@@ -16,10 +16,6 @@
  * NOTES
  *
  * This code was created by first copying <code/finalcv.c>.
- *
- * The modifications are to make lots of guardians, such that they 
- * don't all fit on one segment, in order to test for the (suspected) 
- * finalization promptness defect described in job001658.
  */
 
 #include "testlib.h"
@@ -38,22 +34,20 @@
 #define testArenaSIZE   ((size_t)16<<20)
 
 /* usually (ArenaAlign / sizeof(Ref)) = 1024 */
-/* so choose 2050 to force 3 segments of guardians */
-#define rootCOUNT 2050
+/* so choose 3000 to force 3 segments of guardians */
+#define rootCOUNT 3000
 
 #define churnFACTOR 10
 #define finalizationRATE 6
 #define gcINTERVAL ((size_t)150 * 1024)
-#define collectionCOUNT 3
 
-/* 3 words:  wrapper  |  vector-len  |  first-slot */
-#define vectorSIZE (3*sizeof(mps_word_t))
-#define vectorSLOT 2
+/* dylan vector:  wrapper  |  vector-len  |  slot-0  |  ... */
+#define vectorSIZE(nslots) ((2 + (nslots)) * sizeof(mps_word_t))
+#define vectorSLOT(i) (2 + (i))
 
 #define genCOUNT 2
 
 /* testChain -- generation parameters for the test */
-
 static mps_gen_param_s testChain[genCOUNT] = {
   { 150, 0.85 }, { 170, 0.45 } };
 
@@ -74,25 +68,7 @@ static mps_word_t dylan_int_int(mps_word_t x)
 
 /* note: static, so auto-initialised to NULL */
 static void *root[rootCOUNT];
-
-
-/* churn -- allocate a lot of stuff (unreachable garbage, so it will */
-/* probably only ever cause a minor collection). */
-static void churn(mps_ap_t ap)
-{
-  int i;
-  mps_addr_t p;
-  mps_res_t e;
-
-  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));
-  }
-  p = NULL;
-}
+static int state[rootCOUNT];
 
 
 enum {
@@ -103,20 +79,56 @@ enum {
 };
 
 
+/* report -- collect messages, report, and check objects were */
+/* legally finalized. */
+static void report(mps_arena_t arena, int expect)
+{
+  int found = 0;
+
+  /* Test any finalized objects */
+  while (mps_message_poll(arena)) {
+    mps_message_t message;
+    mps_word_t *obj;
+    mps_word_t objind;
+    mps_addr_t objaddr;
+
+    cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
+         "get");
+
+    found += 1;
+    mps_message_finalization_ref(&objaddr, arena, message);
+    obj = objaddr;
+    objind = dylan_int_int(obj[vectorSLOT(0)]);
+    printf("Finalizing: object %lu at %p\n", objind, objaddr);
+    cdie(root[objind] == NULL, "finalized live");
+    cdie(state[objind] == finalizableSTATE, "not finalizable");
+    state[objind] = finalizedSTATE;
+    mps_message_discard(arena, message);
+  }
+  
+  if(found < expect) {
+    printf("...expected %d finalizations, but got fewer: only %d!\n", 
+           expect, found);
+  } else if(found > expect) {
+    printf("...expected %d finalizations, but got more: %d!\n", 
+           expect, found);
+  }
+}
+
+
 static void *test(void *arg, size_t s)
 {
-  int i;                        /* index */
-  mps_ap_t ap;
+  mps_arena_t arena;
   mps_fmt_t fmt;
   mps_chain_t chain;
   mps_pool_t amc;
-  mps_res_t e;
   mps_root_t mps_root[2];
+  mps_ap_t ap;
+  mps_res_t e;
+  int i;
   mps_addr_t nullref = NULL;
-  int state[rootCOUNT];
-  mps_arena_t arena;
   void *p = NULL;
-  mps_message_t message;
+  int N = rootCOUNT - 1;
 
   arena = (mps_arena_t)arg;
   (void)s;
@@ -137,13 +149,14 @@ static void *test(void *arg, size_t s)
   /* <design/poolmrg/#test.promise.ut.alloc> */
   for(i = 0; i < rootCOUNT; ++i) {
     do {
-      MPS_RESERVE_BLOCK(e, p, ap, vectorSIZE);
+      MPS_RESERVE_BLOCK(e, p, ap, vectorSIZE(2));
       die(e, "MPS_RES_OK");
-      die(dylan_init(p, vectorSIZE, &nullref, 1), "dylan_init");
-    } while (!mps_commit(ap, p, vectorSIZE));
+      die(dylan_init(p, vectorSIZE(2), &nullref, 1), "dylan_init");
+    } while (!mps_commit(ap, p, vectorSIZE(2)));
 
-    /* store index in vector's slot */
-    ((mps_word_t *)p)[vectorSLOT] = dylan_int(i);
+    /* set vector's slots */
+    ((mps_word_t *)p)[vectorSLOT(0)] = dylan_int(i);
+    ((mps_word_t *)p)[vectorSLOT(1)] = (mps_word_t)NULL;
 
     die(mps_finalize(arena, &p), "finalize\n");
     root[i] = p; state[i] = rootSTATE;
@@ -152,56 +165,29 @@ static void *test(void *arg, size_t s)
 
   mps_message_type_enable(arena, mps_message_type_finalization());
 
-  /* <design/poolmrg/#test.promise.ut.churn> */
-  while (mps_collections(arena) < collectionCOUNT) {
-    
-    /* Perhaps cause (minor) collection */
-    churn(ap);
-    
-    /* Maybe make some objects ready-to-finalize */
-    /* <design/poolmrg/#test.promise.ut.drop> */
-    for (i = 0; i < rootCOUNT; ++i) {
-      if (root[i] != NULL && state[i] == rootSTATE) {
-        if (rnd() % finalizationRATE == 0) {
-          /* for this object, either... */
-          if (rnd() % 2 == 0) {
-            /* ...definalize it, or */
-            die(mps_definalize(arena, &root[i]), "definalize\n");
-            state[i] = deadSTATE;
-          } else {
-            /* ...expect it to be finalized soon */
-            state[i] = finalizableSTATE;
-          }
-          /* Drop the root reference to it; this makes it */
-          /* non-E-reachable: so either dead, or ready-to-finalize. */
-          root[i] = NULL;
-        }
-      }
-    }
+  mps_arena_collect(arena);
+  report(arena, 0);
 
-    /* Test any finalized objects, and perhaps resurrect some */
-    while (mps_message_poll(arena)) {
-      mps_word_t *obj;
-      mps_word_t objind;
-      mps_addr_t objaddr;
+  /* make 0 and N finalizable */
+  root[0] = NULL;
+  state[0] = finalizableSTATE;
+  root[N] = NULL;
+  state[N] = finalizableSTATE;
+  mps_arena_collect(arena);
+  report(arena, 2);
 
-      /* <design/poolmrg/#test.promise.ut.message> */
-      cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
-           "get");
-      mps_message_finalization_ref(&objaddr, arena, message);
-      obj = objaddr;
-      objind = dylan_int_int(obj[vectorSLOT]);
-      printf("Finalizing: object %lu at %p\n", objind, objaddr);
-      /* <design/poolmrg/#test.promise.ut.final.check> */
-      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);
-    }
-  }
+  /* make 1 and N-1 refer to each other and finalizable */
+  ((mps_word_t *)root[1])[vectorSLOT(1)] = (mps_word_t)root[N-1];
+  ((mps_word_t *)root[N-1])[vectorSLOT(1)] = (mps_word_t)root[1];
+  root[1] = NULL;
+  state[1] = finalizableSTATE;
+  root[N-1] = NULL;
+  state[N-1] = finalizableSTATE;
+  mps_arena_collect(arena);
+  report(arena, 2);
+
+  mps_arena_collect(arena);
+  report(arena, 0);
 
   /* @@@@ <design/poolmrg/#test.promise.ut.nofinal.check> missing */
 
@@ -232,7 +218,7 @@ int main(int argc, char **argv)
   mps_arena_destroy(arena);
 
   fflush(stdout); /* synchronize */
-  fprintf(stderr, "\nConclusion:  Failed to find any defects.\n");
+  fprintf(stderr, "\nConclusion:  See results above.\n");
   return 0;
 }
 

From 6b9c65e9e98c222749da829c670977ce7971bce6 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 22 Jun 2007 16:05:52 +0100
Subject: [PATCH 38/53] mps br/diag: trace.c: tracefindgrey diag-out:

Represent runs of the same rank as "Rx" where R is rank and x is
 0..9, a..z (x10), or *.  This makes output smaller.
 Accumulate report, and only output at end of trace.
 Represent "no more grey segs" as ".".

Copied from Perforce
 Change: 162644
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 43 ++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 38 insertions(+), 5 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 11166fded25..a95d761e293 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1001,22 +1001,55 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
 {
   Bool found;
   char this;
+  static char prev = '.';
+  static int segcount;
+  static char report_array[10000];
+  static char *report_lim;
 
   found = traceFindGreyORIGINAL(segReturn, rankReturn, arena, ti);
 
-  this = (char) ( !found ? '0'
+  this = (char) ( !found ? '.'
                   : (*rankReturn == RankAMBIG) ? 'A'
                   : (*rankReturn == RankEXACT) ? 'E'
                   : (*rankReturn == RankFINAL) ? 'F'
                   : (*rankReturn == RankWEAK) ? 'W'
                   : '?' );
 
-  DIAG_PRINTF(( "%c", this ));
-  if(!found) {
-    /* that's the end of the trace */
-    DIAG_PRINTF(( "\n" ));
+  if (prev == '.') {
+    /* First seg of new trace */
+    prev = this;
+    segcount = 0;
+    report_lim = report_array;
+  }
+
+  if (this == prev) {
+    segcount += 1;
+  } else {
+    /* Change of rank: */
+    /* add prev rank to report */
+    *report_lim++ = prev;
+    /* add segcount [0..9, a..z (x10), or *] to report */
+    if(segcount < 10) {
+      *report_lim++ = '0' + segcount;
+    } else if(segcount < 260) {
+      *report_lim++ = ('a' - 1) + (segcount / 10);
+    } else {
+      *report_lim++ = '*';
+    }
+    /* begin new rank */
+    prev = this;
+    segcount = 1;
   }
   
+  if (!found) {
+    /* No more grey in this trace: output report */
+    AVER(this == '.');
+    AVER(segcount == 1);  /* single failed attempt to find a seg */
+    *report_lim++ = this;
+    *report_lim++ = '\0';
+    DIAG_PRINTF(( " MPS: traceFindGrey rank sequence: %s\n",
+                  report_array ));
+  }
   return found;
 }
 

From d17cc973fecde3895252a45e54ab214b6ee1d4d0 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 22 Jun 2007 17:19:23 +0100
Subject: [PATCH 39/53] mps br/diag: trace.c: (fix w3 build) cast integer
 character constant to char

w3build.bat: prepare for experimental release exp-162647

Copied from Perforce
 Change: 162647
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index a95d761e293..b01ecfba89f 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1008,21 +1008,21 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
 
   found = traceFindGreyORIGINAL(segReturn, rankReturn, arena, ti);
 
-  this = (char) ( !found ? '.'
-                  : (*rankReturn == RankAMBIG) ? 'A'
-                  : (*rankReturn == RankEXACT) ? 'E'
-                  : (*rankReturn == RankFINAL) ? 'F'
-                  : (*rankReturn == RankWEAK) ? 'W'
-                  : '?' );
+  this = (char)(!found ? '.'
+                : (*rankReturn == RankAMBIG) ? 'A'
+                : (*rankReturn == RankEXACT) ? 'E'
+                : (*rankReturn == RankFINAL) ? 'F'
+                : (*rankReturn == RankWEAK) ? 'W'
+                : '?');
 
-  if (prev == '.') {
+  if(prev == '.') {
     /* First seg of new trace */
     prev = this;
     segcount = 0;
     report_lim = report_array;
   }
 
-  if (this == prev) {
+  if(this == prev) {
     segcount += 1;
   } else {
     /* Change of rank: */
@@ -1030,9 +1030,9 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
     *report_lim++ = prev;
     /* add segcount [0..9, a..z (x10), or *] to report */
     if(segcount < 10) {
-      *report_lim++ = '0' + segcount;
+      *report_lim++ = (char)('0' + segcount);
     } else if(segcount < 260) {
-      *report_lim++ = ('a' - 1) + (segcount / 10);
+      *report_lim++ = (char)(('a' - 1) + (segcount / 10));
     } else {
       *report_lim++ = '*';
     }
@@ -1041,7 +1041,7 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
     segcount = 1;
   }
   
-  if (!found) {
+  if(!found) {
     /* No more grey in this trace: output report */
     AVER(this == '.');
     AVER(segcount == 1);  /* single failed attempt to find a seg */

From ff934c36ec6a6e0998d44761962d0f0ec1f1716b Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Thu, 28 Jun 2007 16:13:13 +0100
Subject: [PATCH 40/53] Mps br/diag: trace.c: rearrange diag output into new

traceFindGrey_diag() function (preparatory to leaving it in when
integrating to master).

Copied from Perforce
 Change: 162676
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 86 +++++++++++++++++++++++-------------------------
 1 file changed, 41 insertions(+), 45 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index b01ecfba89f..9fd7b37886b 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -12,9 +12,6 @@
 
 SRCID(trace, "$Id$");
 
-/* Forward declarations */
-static void TraceStartMessageInit(Arena arena, TraceStartMessage tsMessage);
-
 /* Types */
 
 enum {
@@ -32,10 +29,13 @@ struct RememberedSummaryBlockStruct {
   } the[RememberedSummaryBLOCK];
 };
 
-/* Forward Declarations -- avoid compiler warning. */
+/* Forward declarations */
+
+static void TraceStartMessageInit(Arena arena, TraceStartMessage tsMessage);
 Res arenaRememberSummaryOne(Globals global, Addr base, RefSet summary);
 void arenaForgetProtection(Globals globals);
 void rememberedSummaryBlockInit(struct RememberedSummaryBlockStruct *block);
+static void traceFindGrey_diag(Bool found, Rank rank);
 
 
 /* TraceMessage -- type of GC end messages */
@@ -991,28 +991,53 @@ static void traceReclaim(Trace trace)
  *
  * This function finds a segment which is grey for the trace given and
  * which does not have a higher rank than any other such segment (i.e.,
- * a next segment to scan).  */
+ * a next segment to scan).
+ */
 
-static Bool traceFindGreyORIGINAL(Seg *segReturn, Rank *rankReturn,
-                                  Arena arena, TraceId ti);
-/* wrap debugging around original traceFindGrey */
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
                           Arena arena, TraceId ti)
 {
-  Bool found;
+  Rank rank;
+  Trace trace;
+  Ring node, nextNode;
+
+  AVER(segReturn != NULL);
+  AVER(TraceIdCheck(ti));
+
+  trace = ArenaTrace(arena, ti);
+
+  for(rank = 0; rank < RankLIMIT; ++rank) {
+    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+      Seg seg = SegOfGreyRing(node);
+      AVERT(Seg, seg);
+      AVER(SegGrey(seg) != TraceSetEMPTY);
+      AVER(RankSetIsMember(SegRankSet(seg), rank));
+      if (TraceSetIsMember(SegGrey(seg), trace)) {
+        *segReturn = seg; *rankReturn = rank;
+        traceFindGrey_diag(TRUE, rank);
+        return TRUE;
+      }
+    }
+  }
+
+  traceFindGrey_diag(FALSE, rank);
+  return FALSE; /* There are no grey segments for this trace. */
+}
+
+/* diagnostic output for traceFindGrey */
+static void traceFindGrey_diag(Bool found, Rank rank)
+{
   char this;
   static char prev = '.';
   static int segcount;
   static char report_array[10000];
   static char *report_lim;
 
-  found = traceFindGreyORIGINAL(segReturn, rankReturn, arena, ti);
-
   this = (char)(!found ? '.'
-                : (*rankReturn == RankAMBIG) ? 'A'
-                : (*rankReturn == RankEXACT) ? 'E'
-                : (*rankReturn == RankFINAL) ? 'F'
-                : (*rankReturn == RankWEAK) ? 'W'
+                : (rank == RankAMBIG) ? 'A'
+                : (rank == RankEXACT) ? 'E'
+                : (rank == RankFINAL) ? 'F'
+                : (rank == RankWEAK) ? 'W'
                 : '?');
 
   if(prev == '.') {
@@ -1050,36 +1075,7 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
     DIAG_PRINTF(( " MPS: traceFindGrey rank sequence: %s\n",
                   report_array ));
   }
-  return found;
-}
-
-/* original traceFindGrey */
-static Bool traceFindGreyORIGINAL(Seg *segReturn, Rank *rankReturn,
-                                  Arena arena, TraceId ti)
-{
-  Rank rank;
-  Trace trace;
-  Ring node, nextNode;
-
-  AVER(segReturn != NULL);
-  AVER(TraceIdCheck(ti));
-
-  trace = ArenaTrace(arena, ti);
-
-  for(rank = 0; rank < RankLIMIT; ++rank) {
-    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
-      Seg seg = SegOfGreyRing(node);
-      AVERT(Seg, seg);
-      AVER(SegGrey(seg) != TraceSetEMPTY);
-      AVER(RankSetIsMember(SegRankSet(seg), rank));
-      if (TraceSetIsMember(SegGrey(seg), trace)) {
-        *segReturn = seg; *rankReturn = rank;
-        return TRUE;
-      }
-    }
-  }
-
-  return FALSE; /* There are no grey segments for this trace. */
+  return;
 }
 
 

From b44832b7f607e36a59820743e5b06fa854a6b8b4 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 29 Jun 2007 14:08:00 +0100
Subject: [PATCH 41/53] Mps br/diag: rename #def "diagnostics" as "statistics",
 as all the

macros it controls are called "STATISTIC_blah", and same replacement
in comments.  The term "diagnostic" means something else now: see
design/diag/.

Copied from Perforce
 Change: 162692
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h   | 19 ++++++++++++-------
 mps/code/meter.h    |  6 +++---
 mps/code/mpm.h      | 10 +++++-----
 mps/code/mpmtypes.h |  6 +++---
 4 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 07531878614..2f753eb1e11 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -32,13 +32,13 @@
 #if defined(CONFIG_VAR_WI) || defined(CONFIG_VAR_WE) /* White-hot varieties */
 /* no asserts */
 /* ... so CHECKLEVEL_INITIAL is irrelevant */
-/* no debug diagnostic statistic meters */
+/* no debug statistic meters */
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_HI) || defined(CONFIG_VAR_HE) /* Hot varieties */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-/* no debug diagnostic statistic meters */
+/* no debug statistic meters */
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_DI) /* Diagnostic variety */
@@ -69,7 +69,7 @@
 #elif defined(CONFIG_VAR_II)    /* Ice, Internal; variety.ii (HotLog) */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-/* no debug diagnostic statistic meters */
+/* no debug statistic meters */
 #define CONFIG_LOG
 #endif
 
@@ -89,12 +89,17 @@
 
 
 #if defined(CONFIG_DEBUG)
-/* DEBUG = DIAGNOSTICS = STATISTICs = METERs */
-/* WARNING: this changes the size and fields of MPS structs */
-#define DIAGNOSTICS
+/* CONFIG_DEBUG = STATISTICS = METERs */
+/* Note: the STATISTICS define used to be called "DIAGNOSTICS" (even */
+/* though it controls the STATISTIC system), but the term */
+/* "diagnostic" means something else now: see design/diag/. */
+/* RHSK 2007-06-28 */
+/* WARNING: this may change the size and fields of MPS structs */
+/* (...but see STATISTIC_DECL, which is invariant) */
+#define STATISTICS
 #define MPS_DEBUG_STRING "debug"
 #else
-#define DIAGNOSTICS_NONE
+#define STATISTICS_NONE
 #define MPS_DEBUG_STRING "nondebug"
 #endif
 
diff --git a/mps/code/meter.h b/mps/code/meter.h
index 3e8902a6497..6912ca7afc0 100644
--- a/mps/code/meter.h
+++ b/mps/code/meter.h
@@ -44,12 +44,12 @@ extern void MeterEmit(Meter meter);
 /* Hack: owner is typically only used for MeterInit */
 #define METER_ACC(meter, delta) \
   STATISTIC(MeterAccumulate(&(meter), delta))
-#if defined(DIAGNOSTICS)
+#if defined(STATISTICS)
 #define METER_WRITE(meter, stream) MeterWrite(&(meter), stream)
-#elif defined(DIAGNOSTICS_NONE)
+#elif defined(STATISTICS_NONE)
 #define METER_WRITE(meter, stream) (ResOK)
 #else
-#error "Diagnostics not configured."
+#error "No statistics configured."
 #endif
 #define METER_EMIT(meter) STATISTIC(MeterEmit(meter))
 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 404d0bac54a..44b045b0c1d 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -911,7 +911,7 @@ extern Size VMMapped(VM vm);
 extern void StackProbe(Size depth);
 
 
-/* STATISTIC -- gather diagnostics (in some varieties)
+/* STATISTIC -- gather statistics (in some varieties)
  *
  * The argument of STATISTIC is an expression; the expansion followed by
  * a semicolon is syntactically a statement.
@@ -920,7 +920,7 @@ extern void StackProbe(Size depth);
  * a semicolon is syntactically a statement.
  *
  * STATISTIC_WRITE is inserted in WriteF arguments to output the values
- * of diagnostic fields.
+ * of statistic fields.
  *
  * .statistic.whitehot: The implementation of STATISTIC for
  * non-statistical varieties passes the parameter to DISCARD to ensure
@@ -928,13 +928,13 @@ extern void StackProbe(Size depth);
  * passed as part of a comma-expression so that its type is not
  * important.  This permits an expression of type void.  */
 
-#if defined(DIAGNOSTICS)
+#if defined(STATISTICS)
 
 #define STATISTIC(gather) BEGIN (gather); END
 #define STATISTIC_STAT(gather) BEGIN gather; END
 #define STATISTIC_WRITE(format, arg) (format), (arg),
 
-#elif defined(DIAGNOSTICS_NONE)
+#elif defined(STATISTICS_NONE)
 
 #define STATISTIC(gather) DISCARD(((gather), 0))
 #define STATISTIC_STAT(gather) DISCARD_STAT(gather)
@@ -942,7 +942,7 @@ extern void StackProbe(Size depth);
 
 #else
 
-#error "No diagnostics configured."
+#error "No statistics configured."
 
 #endif
 
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index f7da1f58d7c..868bfa283ae 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -454,12 +454,12 @@ typedef double WriteFD;
  * leave them in, see design.mps.metrics.
  */
 
-#if defined(DIAGNOSTICS)
+#if defined(STATISTICS)
 #define STATISTIC_DECL(field) field
-#elif defined(DIAGNOSTICS_NONE)
+#elif defined(STATISTICS_NONE)
 #define STATISTIC_DECL(field) field
 #else
-#error "No diagnostics configured."
+#error "No statistics configured."
 #endif
 
 

From 7d5719014dc24488771d986431580edf880c6791 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 29 Jun 2007 14:26:50 +0100
Subject: [PATCH 42/53] Mps br/diag: config.h: translate config_debug to
 config_stats,

because that's what it means.  It's got nothing to do with debugging!
Note: this affects MPS_VARIETY_STRING, and version.c#MPSVersionString.

Copied from Perforce
 Change: 162693
 ServerID: perforce.ravenbrook.com
---
 mps/code/config.h | 41 +++++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 16 deletions(-)

diff --git a/mps/code/config.h b/mps/code/config.h
index 2f753eb1e11..1336d9d5bb2 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -21,9 +21,19 @@
 
 /* Variety Configuration */
 
-/* First deal with old-style CONFIG_VAR_* build directives.  These
+/* First translate GG build directives into better ones.
+ */
+
+#ifdef CONFIG_DEBUG
+/* Translate CONFIG_DEBUG to CONFIG_STATS, because that's what it */
+/* means.  It's got nothing to do with debugging!  RHSK 2007-06-29 */
+#define CONFIG_STATS
+#endif
+
+
+/* Then deal with old-style CONFIG_VAR_* build directives.  These
  * must be translated into the new directives CONFIG_ASSERT,
- * CONFIG_DEBUG, and CONFIG_LOG.
+ * CONFIG_STATS, and CONFIG_LOG.
  *
  * One day the old build system may be converted to use the new
  * directives.
@@ -32,23 +42,22 @@
 #if defined(CONFIG_VAR_WI) || defined(CONFIG_VAR_WE) /* White-hot varieties */
 /* no asserts */
 /* ... so CHECKLEVEL_INITIAL is irrelevant */
-/* no debug statistic meters */
+/* no statistic meters */
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_HI) || defined(CONFIG_VAR_HE) /* Hot varieties */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-/* no debug statistic meters */
+/* no statistic meters */
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_DI) /* Diagnostic variety */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-#define CONFIG_DEBUG
-/* Choose a DIAG_WITH_... output method.
+#define CONFIG_STATS
+/* For diagnostics, choose a DIAG_WITH_... output method.
  * (We need to choose because the DIAG output system is under 
- * development.  When it works, this will simply be the same as 
- * "CONFIG_DEBUG".  RHSK 2007-05-21).
+ * development.  RHSK 2007-05-21).
  */
 /* #define DIAG_WITH_STREAM_AND_WRITEF -- this does not work in CET */
 #define DIAG_WITH_PRINTF
@@ -57,19 +66,19 @@
 #elif defined(CONFIG_VAR_CI) || defined(CONFIG_VAR_CE) /* Cool varieties */
 #define CONFIG_ASSERT
 /* ... let PRODUCT determine CHECKLEVEL_INITIAL */
-#define CONFIG_DEBUG
+#define CONFIG_STATS
 /* no telemetry log events */
 
 #elif defined(CONFIG_VAR_TI)    /* Telemetry, Internal; variety.ti */
 #define CONFIG_ASSERT
 /* ... let PRODUCT determine CHECKLEVEL_INITIAL */
-#define CONFIG_DEBUG
+#define CONFIG_STATS
 #define CONFIG_LOG
 
 #elif defined(CONFIG_VAR_II)    /* Ice, Internal; variety.ii (HotLog) */
 #define CONFIG_ASSERT
 #define CHECKLEVEL_INITIAL CheckLevelMINIMAL
-/* no debug statistic meters */
+/* no statistic meters */
 #define CONFIG_LOG
 #endif
 
@@ -88,8 +97,8 @@
 #endif
 
 
-#if defined(CONFIG_DEBUG)
-/* CONFIG_DEBUG = STATISTICS = METERs */
+#if defined(CONFIG_STATS)
+/* CONFIG_STATS = STATISTICS = METERs */
 /* Note: the STATISTICS define used to be called "DIAGNOSTICS" (even */
 /* though it controls the STATISTIC system), but the term */
 /* "diagnostic" means something else now: see design/diag/. */
@@ -97,10 +106,10 @@
 /* WARNING: this may change the size and fields of MPS structs */
 /* (...but see STATISTIC_DECL, which is invariant) */
 #define STATISTICS
-#define MPS_DEBUG_STRING "debug"
+#define MPS_STATS_STRING "stats"
 #else
 #define STATISTICS_NONE
-#define MPS_DEBUG_STRING "nondebug"
+#define MPS_STATS_STRING "nonstats"
 #endif
 
 
@@ -115,7 +124,7 @@
 
 
 #define MPS_VARIETY_STRING \
-  MPS_ASSERT_STRING "." MPS_LOG_STRING "." MPS_DEBUG_STRING
+  MPS_ASSERT_STRING "." MPS_LOG_STRING "." MPS_STATS_STRING
 
 
 /* Platform Configuration */

From 16ddbe30bcdf6597b52e0ce5e186994a5ecaa1d5 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Fri, 29 Jun 2007 17:17:00 +0100
Subject: [PATCH 43/53] Mps br/diag: trace: new field in tracestruct: traceband
 band for

current band (eg via-F) of trace.  Fix for job001658.

Copied from Perforce
 Change: 162696
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpmst.h    |  1 +
 mps/code/mpmtypes.h | 15 +++++++
 mps/code/trace.c    | 97 ++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 107 insertions(+), 6 deletions(-)

diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 695bb8c82db..b112e4a1d5d 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -514,6 +514,7 @@ typedef struct TraceStruct {
   ZoneSet white;                /* zones in the white set */
   ZoneSet mayMove;              /* zones containing possibly moving objs */
   TraceState state;             /* current state of trace */
+  TraceBand band;               /* current band (eg via-F) of trace */
   Bool emergency;               /* ran out of memory during trace */
   Chain chain;                  /* chain being incrementally collected */
   Size condemned;               /* condemned bytes */
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 868bfa283ae..e11beab58b2 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -50,6 +50,7 @@ typedef Size Epoch;                     /* design.mps.ld */
 typedef unsigned TraceId;               /* <design/trace/> */
 typedef unsigned TraceSet;              /* <design/trace/> */
 typedef unsigned TraceState;            /* <design/trace/> */
+typedef unsigned TraceBand;             /* <http://info.ravenbrook.com/mail/2007/06/29/13-52-24/0.txt> */
 typedef unsigned AccessSet;             /* <design/type/#access-set> */
 typedef unsigned Attr;                  /* <design/type/#attr> */
 typedef unsigned FormatVariety;        
@@ -405,6 +406,20 @@ enum {
   TraceFINISHED
 };
 
+
+/* TraceBands -- see <http://info.ravenbrook.com/mail/2007/06/29/13-52-24/0.txt> */
+
+enum {
+  TraceBandBASE = 1,
+  TraceBandA = TraceBandBASE,  /* via-RankAMBIG */
+  TraceBandE,   /* via-RankEXACT */
+  TraceBandFf,  /* via-RankFINAL rootside boundary = F-guardians */
+  TraceBandFe,  /* via-RankFINAL others (all exact) */
+  TraceBandW,   /* via-RankWEAK rootside boundary */
+  TraceBandLIMIT /* not a TraceBand, the limit of the 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. */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 9fd7b37886b..1df3639c3f7 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -413,6 +413,8 @@ Bool TraceCheck(Trace trace)
   default:
     NOTREACHED;
   }
+  CHECKL(trace->band >= TraceBandBASE);
+  CHECKL(trace->band < TraceBandLIMIT);
   CHECKL(BoolCheck(trace->emergency));
   if (trace->chain != NULL)
     CHECKU(Chain, trace->chain);
@@ -806,6 +808,7 @@ found:
   trace->mayMove = ZoneSetEMPTY;
   trace->ti = ti;
   trace->state = TraceINIT;
+  trace->band = TraceBandA;  /* the via-RankAMBIG band */
   trace->emergency = FALSE;
   trace->chain = NULL;
   trace->condemned = (Size)0;   /* nothing condemned yet */
@@ -997,31 +1000,113 @@ static void traceReclaim(Trace trace)
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
                           Arena arena, TraceId ti)
 {
-  Rank rank;
+  Rank rank = RankLIMIT;
   Trace trace;
   Ring node, nextNode;
+  Seg seg;
 
   AVER(segReturn != NULL);
   AVER(TraceIdCheck(ti));
 
   trace = ArenaTrace(arena, ti);
+  
+  AVER(trace->band >= TraceBandBASE);
+  AVER(trace->band < TraceBandLIMIT);
 
-  for(rank = 0; rank < RankLIMIT; ++rank) {
+  if(trace->band == TraceBandA) {
+    rank = RankAMBIG;
     RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
-      Seg seg = SegOfGreyRing(node);
+      seg = SegOfGreyRing(node);
       AVERT(Seg, seg);
       AVER(SegGrey(seg) != TraceSetEMPTY);
       AVER(RankSetIsMember(SegRankSet(seg), rank));
       if (TraceSetIsMember(SegGrey(seg), trace)) {
-        *segReturn = seg; *rankReturn = rank;
-        traceFindGrey_diag(TRUE, rank);
-        return TRUE;
+        goto foundGrey;
       }
     }
+    trace->band = TraceBandE;
+  }
+
+  if(trace->band == TraceBandE) {
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    rank = RankEXACT;
+    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+      seg = SegOfGreyRing(node);
+      AVERT(Seg, seg);
+      AVER(SegGrey(seg) != TraceSetEMPTY);
+      AVER(RankSetIsMember(SegRankSet(seg), rank));
+      if (TraceSetIsMember(SegGrey(seg), trace)) {
+        goto foundGrey;
+      }
+    }
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankEXACT)));
+    trace->band = TraceBandFf;
+  }
+
+  if(trace->band == TraceBandFf) {
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    rank = RankFINAL;
+    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+      seg = SegOfGreyRing(node);
+      AVERT(Seg, seg);
+      AVER(SegGrey(seg) != TraceSetEMPTY);
+      AVER(RankSetIsMember(SegRankSet(seg), rank));
+      if (TraceSetIsMember(SegGrey(seg), trace)) {
+        goto foundGrey;
+      }
+    }
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankFINAL)));
+    trace->band = TraceBandFe;
+  }
+
+  if(trace->band == TraceBandFe) {
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankFINAL)));
+    rank = RankEXACT;
+    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+      seg = SegOfGreyRing(node);
+      AVERT(Seg, seg);
+      AVER(SegGrey(seg) != TraceSetEMPTY);
+      AVER(RankSetIsMember(SegRankSet(seg), rank));
+      if (TraceSetIsMember(SegGrey(seg), trace)) {
+        goto foundGrey;
+      }
+    }
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankEXACT)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankFINAL)));
+    trace->band = TraceBandW;
+  }
+
+  if(trace->band == TraceBandW) {
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankEXACT)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankFINAL)));
+    rank = RankWEAK;
+    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+      seg = SegOfGreyRing(node);
+      AVERT(Seg, seg);
+      AVER(SegGrey(seg) != TraceSetEMPTY);
+      AVER(RankSetIsMember(SegRankSet(seg), rank));
+      if (TraceSetIsMember(SegGrey(seg), trace)) {
+        goto foundGrey;
+      }
+    }
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankEXACT)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankFINAL)));
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankWEAK)));
   }
 
   traceFindGrey_diag(FALSE, rank);
   return FALSE; /* There are no grey segments for this trace. */
+  
+foundGrey:
+  *segReturn = seg; *rankReturn = rank;
+  traceFindGrey_diag(TRUE, rank);
+  return TRUE;
 }
 
 /* diagnostic output for traceFindGrey */

From 4419b49dc0d47b2fdf8de5a894ed5771b0bc0aa5 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Mon, 2 Jul 2007 15:21:04 +0100
Subject: [PATCH 44/53] Mps: more correct c style in trace.c immediately prior
 to

editing it.

Copied from Perforce
 Change: 162716
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 70 +++++++++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 30 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 948df5fde40..36a30274522 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1,7 +1,8 @@
 /* trace.c: GENERIC TRACER IMPLEMENTATION
  *
  * $Id$
- * Copyright (c) 2001-2003, 2006 Ravenbrook Limited.  See end of file for license.
+ * Copyright (c) 2001-2003, 2006, 2007 Ravenbrook Limited.
+ * See end of file for license.
  * Portions copyright (C) 2002 Global Graphics Software.
  *
  * .design: <design/trace/>.  */
@@ -1008,17 +1009,20 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
   for(rank = 0; rank < RankLIMIT; ++rank) {
     RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
       Seg seg = SegOfGreyRing(node);
+
       AVERT(Seg, seg);
       AVER(SegGrey(seg) != TraceSetEMPTY);
       AVER(RankSetIsMember(SegRankSet(seg), rank));
-      if (TraceSetIsMember(SegGrey(seg), trace)) {
-        *segReturn = seg; *rankReturn = rank;
+
+      if(TraceSetIsMember(SegGrey(seg), trace)) {
+        *segReturn = seg;
+        *rankReturn = rank;
         return TRUE;
       }
     }
   }
 
-  return FALSE; /* There are no grey segments for this trace. */
+  return FALSE;                 /* No grey segments for this trace. */
 }
 
 
@@ -1674,30 +1678,32 @@ static void traceQuantum(Trace trace)
   pollEnd = traceWorkClock(trace) + trace->rate;
   do {
     switch(trace->state) {
-    case TraceUNFLIPPED:
-      /* all traces are flipped in TraceStart at the moment */
-      NOTREACHED;
-      break;
-    case TraceFLIPPED: {
-      Arena arena = trace->arena;
-      Seg seg;
-      Rank rank;
+      case TraceUNFLIPPED:
+        /* all traces are flipped in TraceStart at the moment */
+        NOTREACHED;
+        break;
+      case TraceFLIPPED: {
+        Arena arena = trace->arena;
+        Seg seg;
+        Rank rank;
 
-      if (traceFindGrey(&seg, &rank, arena, trace->ti)) {
-        AVER((SegPool(seg)->class->attr & AttrSCAN) != 0);
-        traceScanSeg(TraceSetSingle(trace), rank, arena, seg);
-      } else
-        trace->state = TraceRECLAIM;
-    } break;
-    case TraceRECLAIM:
-      traceReclaim(trace);
-      break;
-    default:
-      NOTREACHED;
-      break;
+        if(traceFindGrey(&seg, &rank, arena, trace->ti)) {
+          AVER((SegPool(seg)->class->attr & AttrSCAN) != 0);
+          traceScanSeg(TraceSetSingle(trace), rank, arena, seg);
+        } else {
+          trace->state = TraceRECLAIM;
+        }
+        break;
+      }
+      case TraceRECLAIM:
+        traceReclaim(trace);
+        break;
+      default:
+        NOTREACHED;
+        break;
     }
-  } while (trace->state != TraceFINISHED
-           && (trace->emergency || traceWorkClock(trace) < pollEnd));
+  } while(trace->state != TraceFINISHED
+          && (trace->emergency || traceWorkClock(trace) < pollEnd));
 }
 
 /* traceStartCollectAll: start a trace which condemns everything in
@@ -1807,15 +1813,17 @@ Size TracePoll(Globals globals)
   } /* (arena->busyTraces == TraceSetEMPTY) */
 
   /* If there is a trace, do one quantum of work. */
-  if (arena->busyTraces != TraceSetEMPTY) {
+  if(arena->busyTraces != TraceSetEMPTY) {
     Size oldScanned;
+
     trace = ArenaTrace(arena, (TraceId)0);
     AVER(arena->busyTraces == TraceSetSingle(trace));
     oldScanned = traceWorkClock(trace);
     traceQuantum(trace);
     scannedSize = traceWorkClock(trace) - oldScanned;
-    if (trace->state == TraceFINISHED)
+    if(trace->state == TraceFINISHED) {
       TraceDestroy(trace);
+    }
   }
   return scannedSize;
 
@@ -1864,8 +1872,9 @@ void ArenaPark(Globals globals)
     /* Poll active traces to make progress. */
     TRACE_SET_ITER(ti, trace, arena->busyTraces, arena)
       traceQuantum(trace);
-      if (trace->state == TraceFINISHED)
+      if(trace->state == TraceFINISHED) {
         TraceDestroy(trace);
+      }
     TRACE_SET_ITER_END(ti, trace, arena->busyTraces, arena);
   }
 }
@@ -2063,7 +2072,8 @@ Res ArenaCollect(Globals globals, int why)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2003, 2006 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2003, 2006, 2007 Ravenbrook Limited
+ * <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

From 7fea55b7c8f58707d9019c4b234d9b1d28c84cc0 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Mon, 2 Jul 2007 15:43:34 +0100
Subject: [PATCH 45/53] Mps: added band field to tracestruct.  unused.

Copied from Perforce
 Change: 162717
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpmst.h |  1 +
 mps/code/trace.c | 50 +++++++++++++++++++++++++++---------------------
 2 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 695bb8c82db..c82325da828 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -514,6 +514,7 @@ typedef struct TraceStruct {
   ZoneSet white;                /* zones in the white set */
   ZoneSet mayMove;              /* zones containing possibly moving objs */
   TraceState state;             /* current state of trace */
+  Rank band;                    /* current band */
   Bool emergency;               /* ran out of memory during trace */
   Chain chain;                  /* chain being incrementally collected */
   Size condemned;               /* condemned bytes */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 36a30274522..961df33fefe 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -387,36 +387,41 @@ Bool TraceCheck(Trace trace)
   CHECKL(ZoneSetSub(trace->mayMove, trace->white));
   /* Use trace->state to check more invariants. */
   switch(trace->state) {
-  case TraceINIT:
-    /* @@@@ What can be checked here? */
-    break;
+    case TraceINIT:
+      /* @@@@ What can be checked here? */
+      break;
 
-  case TraceUNFLIPPED:
-    CHECKL(!TraceSetIsMember(trace->arena->flippedTraces, trace));
-    /* @@@@ Assert that mutator is grey for trace. */
-    break;
+    case TraceUNFLIPPED:
+      CHECKL(!TraceSetIsMember(trace->arena->flippedTraces, trace));
+      /* @@@@ Assert that mutator is grey for trace. */
+      break;
 
-  case TraceFLIPPED:
-    CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
-    /* @@@@ Assert that mutator is black for trace. */
-    break;
+    case TraceFLIPPED:
+      CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
+      /* @@@@ Assert that mutator is black for trace. */
+      break;
 
-  case TraceRECLAIM:
-    CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
-    /* @@@@ Assert that grey set is empty for trace. */
-    break;
+    case TraceRECLAIM:
+      CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
+      /* @@@@ Assert that grey set is empty for trace. */
+      break;
 
-  case TraceFINISHED:
-    CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
-    /* @@@@ Assert that grey and white sets is empty for trace. */
-    break;
+    case TraceFINISHED:
+      CHECKL(TraceSetIsMember(trace->arena->flippedTraces, trace));
+      /* @@@@ Assert that grey and white sets is empty for trace. */
+      break;
 
-  default:
-    NOTREACHED;
+    default:
+      NOTREACHED;
+  }
+  /* Valid values for band depend on state. */
+  if(trace->state == TraceFLIPPED) {
+    CHECKL(RankCheck(trace->band));
   }
   CHECKL(BoolCheck(trace->emergency));
-  if (trace->chain != NULL)
+  if(trace->chain != NULL) {
     CHECKU(Chain, trace->chain);
+  }
   /* @@@@ checks for counts missing */
   CHECKD(TraceStartMessage, &trace->startMessage);
   return TRUE;
@@ -807,6 +812,7 @@ found:
   trace->mayMove = ZoneSetEMPTY;
   trace->ti = ti;
   trace->state = TraceINIT;
+  trace->band = RankAMBIG;      /* Required to be the earliest rank. */
   trace->emergency = FALSE;
   trace->chain = NULL;
   trace->condemned = (Size)0;   /* nothing condemned yet */

From 918820829cd477678296d73db47854f556d28b8f Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Mon, 2 Jul 2007 16:10:48 +0100
Subject: [PATCH 46/53] Mps: implements better band tracing.

Copied from Perforce
 Change: 162718
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 76 ++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 61 insertions(+), 15 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 961df33fefe..355067b6a33 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -15,6 +15,8 @@ SRCID(trace, "$Id$");
 
 /* Forward declarations */
 static void TraceStartMessageInit(Arena arena, TraceStartMessage tsMessage);
+Rank traceBand(Trace);
+Bool traceBandIncrement(Trace);
 
 /* Types */
 
@@ -427,6 +429,39 @@ Bool TraceCheck(Trace trace)
   return TRUE;
 }
 
+/* traceBand - current band of the trace.
+ *
+ * The current band is the band currently being discovered.  Each band
+ * corresponds to a rank.  The R band is all objects that are reachable
+ * only by tracing references of rank R or earlier _and_ are not in some
+ * earlier band (thus, the bands are disjoint).  Whilst a particular
+ * band is current all the objects that become marked are the objects in
+ * that band.
+ */
+Rank traceBand(Trace trace)
+{
+  AVERT(Trace, trace);
+
+  return trace->band;
+}
+
+/* traceBandIncrement - increment the current band.
+ *
+ * Increments the current band and returns TRUE if possible; otherwise
+ * there are no more bands, so resets the band state and returns FALSE.
+ */
+Bool traceBandIncrement(Trace trace)
+{
+  AVER(trace->state == TraceFLIPPED);
+
+  ++trace->band;
+  if(trace->band >= RankLIMIT) {
+    trace->band = RankAMBIG;
+    return FALSE;
+  }
+  return TRUE;
+}
+
 
 /* traceUpdateCounts - dumps the counts from a ScanState into the Trace */
 
@@ -996,9 +1031,9 @@ static void traceReclaim(Trace trace)
 
 /* traceFindGrey -- find a grey segment
  *
- * This function finds a segment which is grey for the trace given and
- * which does not have a higher rank than any other such segment (i.e.,
- * a next segment to scan).  */
+ * This function finds the next segment to scan.  It does this according
+ * to the current band of the trace.  See design/trace/
+ */
 
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
                           Arena arena, TraceId ti)
@@ -1012,23 +1047,34 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
 
   trace = ArenaTrace(arena, ti);
 
-  for(rank = 0; rank < RankLIMIT; ++rank) {
-    RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
-      Seg seg = SegOfGreyRing(node);
+  while(1) {
+    Rank band = traceBand(trace);
 
-      AVERT(Seg, seg);
-      AVER(SegGrey(seg) != TraceSetEMPTY);
-      AVER(RankSetIsMember(SegRankSet(seg), rank));
+    /* Within the R band we look for segments of rank R first,  */
+    /* then succesively earlier ones.  Slight hack: We never    */
+    /* expect to find any segments of RankAMBIG, so we use      */
+    /* this as a terminating condition for the loop.            */
+    for(rank = band; rank > RankAMBIG; --rank) {
+      RING_FOR(node, ArenaGreyRing(arena, rank), nextNode) {
+        Seg seg = SegOfGreyRing(node);
 
-      if(TraceSetIsMember(SegGrey(seg), trace)) {
-        *segReturn = seg;
-        *rankReturn = rank;
-        return TRUE;
+        AVERT(Seg, seg);
+        AVER(SegGrey(seg) != TraceSetEMPTY);
+        AVER(RankSetIsMember(SegRankSet(seg), rank));
+
+        if(TraceSetIsMember(SegGrey(seg), trace)) {
+          *segReturn = seg;
+          *rankReturn = rank;
+          return TRUE;
+        }
       }
     }
+    AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
+    if(!traceBandIncrement(trace)) {
+      /* No grey segments for this trace. */
+      return FALSE;
+    }
   }
-
-  return FALSE;                 /* No grey segments for this trace. */
 }
 
 

From 7773d6885283dea581a018700e102baa21aff29e Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Tue, 3 Jul 2007 14:00:20 +0100
Subject: [PATCH 47/53] Mps: tracebandincrement renamed to tracebandadvance.

Copied from Perforce
 Change: 162732
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 355067b6a33..d4b67ad0702 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -16,7 +16,7 @@ SRCID(trace, "$Id$");
 /* Forward declarations */
 static void TraceStartMessageInit(Arena arena, TraceStartMessage tsMessage);
 Rank traceBand(Trace);
-Bool traceBandIncrement(Trace);
+Bool traceBandAdvance(Trace);
 
 /* Types */
 
@@ -445,12 +445,14 @@ Rank traceBand(Trace trace)
   return trace->band;
 }
 
-/* traceBandIncrement - increment the current band.
+/* traceBandAdvance - advance to next band.
  *
- * Increments the current band and returns TRUE if possible; otherwise
- * there are no more bands, so resets the band state and returns FALSE.
+ * Advances (increments) the current band to the next band and returns TRUE
+ * if possible;
+ * otherwise, there are no more bands, so resets the band state and
+ * returns FALSE.
  */
-Bool traceBandIncrement(Trace trace)
+Bool traceBandAdvance(Trace trace)
 {
   AVER(trace->state == TraceFLIPPED);
 
@@ -1070,7 +1072,7 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
       }
     }
     AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
-    if(!traceBandIncrement(trace)) {
+    if(!traceBandAdvance(trace)) {
       /* No grey segments for this trace. */
       return FALSE;
     }

From 51bd477f2e69b13d9029afb15c7132a1c039d4f3 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Tue, 3 Jul 2007 14:32:52 +0100
Subject: [PATCH 48/53] Mps: comments on what checks we make in tracefindgrey. 
 no

checks yet.

Copied from Perforce
 Change: 162734
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index d4b67ad0702..9b22cda5476 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1035,6 +1035,45 @@ static void traceReclaim(Trace trace)
  *
  * This function finds the next segment to scan.  It does this according
  * to the current band of the trace.  See design/trace/
+ *
+ * This code also performs various checks about the ranks of the object
+ * graph.  Explanations of the checks would litter the code, so the
+ * explanations are here, and the code references these.
+ *
+ * .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
+ * 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.
+ *
+ * .check.band.begin: At the point where we start working on a new band
+ * of Rank R, there are no grey objects at earlier ranks.  If there
+ * were, we would've found them whilst the current band was the previous
+ * band.  We don't check this, but I rely on this fact in the next
+ * check, .check.weak.no-preserve.
+ *
+ * .check.weak.band: Weak references cannot cause objects to be
+ * newly preserved (marked).  Because of .check.band.begin all the
+ * scanning work performed when the current band is a weak rank will be
+ * scanning objects at that rank.  There is currently only one weak
+ * rank, RankWEAK.
+ *
+ * .check.final.one-pass: Because all the RankFINAL references are
+ * allocated in PoolMRG and effectively treated as roots, all the
+ * RankFINAL references will be scanned in one push (possibly split up,
+ * incrementally).  Once they have been scanned, no new RankFINAL
+ * references will be discovered (the mutator is not permitted to
+ * allocate RankFINAL references wherever they like).  In fact because
+ * of various coincidences (no Ambig segments so band Exact never
+ * discovers an Ambig segment and then more Exact segments; the only
+ * other rank is weak so never discovers any new segments) it is the
+ * case that for any band R there is an initial burst of scanning
+ * segments at rank R then after that we see no more rank R segments
+ * whilst working in this band.  That's what we check, although we
+ * expect to have to change the check if we introduce more ranks, or
+ * start changing the semantics of them.  A flag is used to implement
+ * this check.
  */
 
 static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,

From 7908d6aa57f5e8d96a38a6fbe206209a833e0248 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Tue, 3 Jul 2007 15:01:48 +0100
Subject: [PATCH 49/53] Mps: tracefindgrey checks as per its comment.

Copied from Perforce
 Change: 162736
 ServerID: perforce.ravenbrook.com
---
 mps/code/trace.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/mps/code/trace.c b/mps/code/trace.c
index 9b22cda5476..7e4fc8f193a 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -1104,12 +1104,15 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
         AVER(RankSetIsMember(SegRankSet(seg), rank));
 
         if(TraceSetIsMember(SegGrey(seg), trace)) {
+          /* .check.band.weak */
+          AVER(band != RankWEAK || rank == band);
           *segReturn = seg;
           *rankReturn = rank;
           return TRUE;
         }
       }
     }
+    /* .check.ambig.not */
     AVER(RingIsSingle(ArenaGreyRing(arena, RankAMBIG)));
     if(!traceBandAdvance(trace)) {
       /* No grey segments for this trace. */

From 21484f6da2955c663560019d793265fddba310cf Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Tue, 3 Jul 2007 15:44:24 +0100
Subject: [PATCH 50/53] Mps: more checking.

Copied from Perforce
 Change: 162742
 ServerID: perforce.ravenbrook.com
---
 mps/code/mpmst.h |  1 +
 mps/code/trace.c | 31 +++++++++++++++++++++++++++++++
 2 files changed, 32 insertions(+)

diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index c82325da828..35ff8ac6d9b 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -515,6 +515,7 @@ typedef struct TraceStruct {
   ZoneSet mayMove;              /* zones containing possibly moving objs */
   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 */
   Chain chain;                  /* chain being incrementally collected */
   Size condemned;               /* condemned bytes */
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 7e4fc8f193a..50f3812a31b 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -17,6 +17,8 @@ SRCID(trace, "$Id$");
 static void TraceStartMessageInit(Arena arena, TraceStartMessage tsMessage);
 Rank traceBand(Trace);
 Bool traceBandAdvance(Trace);
+Bool traceBandFirstStretch(Trace);
+void traceBandFirstStretchDone(Trace);
 
 /* Types */
 
@@ -457,6 +459,7 @@ Bool traceBandAdvance(Trace trace)
   AVER(trace->state == TraceFLIPPED);
 
   ++trace->band;
+  trace->firstStretch = TRUE;
   if(trace->band >= RankLIMIT) {
     trace->band = RankAMBIG;
     return FALSE;
@@ -464,6 +467,28 @@ Bool traceBandAdvance(Trace trace)
   return TRUE;
 }
 
+/* traceBandFirstStretch - whether in first stretch or not.
+ *
+ * For a band R (see traceBand) the first stretch is defined as all the
+ * scanning work done up until the first point where we run out of grey
+ * rank R segments (and either scan something of an earlier rank or
+ * change bands).
+ *
+ * This function returns TRUE whilst we are in the first stretch, FALSE
+ * otherwise.
+ *
+ * Entering the first stretch is automatically performed by
+ * traceBandAdvance, but finishing it is detected in traceFindGrey.
+ */
+Bool traceBandFirstStretch(Trace trace)
+{
+  return trace->firstStretch;
+}
+
+void traceBandFirstStretchDone(Trace trace)
+{
+  trace->firstStretch = FALSE;
+}
 
 /* traceUpdateCounts - dumps the counts from a ScanState into the Trace */
 
@@ -1106,6 +1131,12 @@ static Bool traceFindGrey(Seg *segReturn, Rank *rankReturn,
         if(TraceSetIsMember(SegGrey(seg), trace)) {
           /* .check.band.weak */
           AVER(band != RankWEAK || rank == band);
+          if(rank != band) {
+            traceBandFirstStretchDone(trace);
+          } else {
+            /* .check.final.one-pass */
+            AVER(traceBandFirstStretch(trace));
+          }
           *segReturn = seg;
           *rankReturn = rank;
           return TRUE;

From b92526bc92183988d3331cbefc0aa9a39bb3c834 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Wed, 4 Jul 2007 14:03:24 +0100
Subject: [PATCH 51/53] Mps: make test-runner cross platform.

Copied from Perforce
 Change: 162754
 ServerID: perforce.ravenbrook.com
---
 mps/tool/test-runner.py | 75 ++++++++++++++++++++++++++++++++++++++---
 1 file changed, 70 insertions(+), 5 deletions(-)

diff --git a/mps/tool/test-runner.py b/mps/tool/test-runner.py
index a06e29e66e4..05d3f3d7a13 100644
--- a/mps/tool/test-runner.py
+++ b/mps/tool/test-runner.py
@@ -19,19 +19,84 @@
 
 
 import os
+import platform
+import re
+
+def mpsplatformcode() :
+  """Makes a guess at the MPS platform code.  If it makes a full guess
+     then returns the string, otherwise it returns the pair (None,guess)
+     where guess is an MPS platform-like string with unknown parts set to
+     '??'.
+     """
+
+  # Uses the platform module which appears to be in Python 2.3, but not
+  # documented until Python 2.4.  See
+  # http://www.python.org/doc/2.4/lib/module-platform.html
+
+  os = '??' # operating system
+  try :
+    # 2007-07-03 DRJ : Darwin is tested, the other I have guessed at
+    # from the documentation for platform.system()
+    os = {'Darwin':'xc',
+          'Linux':'li',
+          'Windows':'w3',
+         }[platform.system()]
+  except :
+    pass
+
+  arch = '??' # CPU architecture
+  try :
+    # 2007-07-03 DRJ : 'Power Macintosh' and 'i386' are tested (but ppc
+    # under Rosetta, so I'm not confident it's right).
+    arch = {'Power Macintosh':'pp',
+            'i386':'i3',
+           }[platform.machine()]
+  except :
+    pass
+
+  compiler = '??' # C compiler tool chain
+  # There's no automagic way to determine this, some OS/Arch
+  # combinations support more than one C compiler.  Sometimes it really
+  # is up to the builder to choose what C compiler to use.
+  # Here, we simplify and get it right for Windows and Macs.
+  try :
+    compiler = {'xc':'gc',
+                'w3':'mv',
+               }[os]
+  except :
+    pass
+
+  plat = os + arch + compiler
+  if re.search(r'\?', plat) :
+    return None, plat
+  return plat
+
+mpsplatform = mpsplatformcode()
+
+make = ''
+if mpsplatform[4:6] == 'gc' :
+  make = "make -r -f %s.gmk VARIETY=%%s %%s >> %%s" % mpsplatform
+elif mpsplatform[4:6] == 'mv' :
+  make = "nmake /f %s.nmk VARIETY=%%s %%s.exe >>%%s" % mpsplatform
+
+run = ''
+if mpsplatform[:2] == 'xc' :
+  run = "./%s/%%s/%%s >> %%s" % mpsplatform
+elif mpsplatform[:2] == 'w3' :
+  run = r'.\%s\%%s\%%s.exe >>%%s' % mpsplatform
+
 testout = "./a1.txt"
 
 def runtest(test, variety, testout):
-  # appends to testout
+  """Appends to testout."""
+
   os.system("echo .")
   os.system("echo .")
   os.system("echo .")
   os.system("echo --- %s {%s} ---" % (test, variety) )
   os.system("echo --- %s {%s} --- >>%s" % (test, variety, testout) )
-  os.system("nmake /f w3i3mv.nmk VARIETY=%s %s.exe >>%s" % (variety, test, testout) )
-  os.system(".\w3i3mv\%s\%s.exe >>%s" % (variety, test, testout) )
-#  os.system("make -f xcppgc.gmk VARIETY=%s %s >>%s" % (variety, test, testout) )
-#  os.system("./xcppgc/%s/%s >>%s" % (variety, test, testout) )
+  os.system(make % (variety, test, testout) )
+  os.system(run % (variety, test, testout) )
 
 def runtestlist( lTest, lVariety, testout ):
   # clear testout

From 53b3f3a101ae592348e0b0bec5bbbad560bb0f67 Mon Sep 17 00:00:00 2001
From: Richard Kistruck <rhsk@ravenbrook.com>
Date: Wed, 4 Jul 2007 14:19:46 +0100
Subject: [PATCH 52/53] Mps br/band: exp-162756: version.c & w3build.bat

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

diff --git a/mps/code/version.c b/mps/code/version.c
index a9f5ed08e00..a54c2063496 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -29,7 +29,7 @@ SRCID(version, "$Id$");
  * (Note: before 2006-02-01 the style was "release.epcore.chub")
  */
 
-#define MPS_RELEASE "release/1.107.0"
+#define MPS_RELEASE "exp-162756"
 
 
 /* MPSCopyrightNotice -- copyright notice for the binary

From 60217b6466c145ce61ee3ffba5bc17dc3eab8e65 Mon Sep 17 00:00:00 2001
From: David Jones <drj@ravenbrook.com>
Date: Wed, 4 Jul 2007 14:41:32 +0100
Subject: [PATCH 53/53] Mps: workaround for test-runner.py on windows.

Copied from Perforce
 Change: 162757
 ServerID: perforce.ravenbrook.com
---
 mps/tool/test-runner.py | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/mps/tool/test-runner.py b/mps/tool/test-runner.py
index 05d3f3d7a13..197902eb6b7 100644
--- a/mps/tool/test-runner.py
+++ b/mps/tool/test-runner.py
@@ -52,7 +52,10 @@ def mpsplatformcode() :
             'i386':'i3',
            }[platform.machine()]
   except :
-    pass
+    # Windows specific hack.  On Python 2.4 and 2.5 platform.machine
+    # returns ''.
+    if platform.machine() == '' and os == 'w3' :
+      arch = 'i3'
 
   compiler = '??' # C compiler tool chain
   # There's no automagic way to determine this, some OS/Arch