diff --git a/mps/qa/test/testlib/rankfmt.c b/mps/qa/test/testlib/rankfmt.c
new file mode 100644
index 00000000000..ce8691edc9f
--- /dev/null
+++ b/mps/qa/test/testlib/rankfmt.c
@@ -0,0 +1,563 @@
+/* rankfmt.c
+   See comments in header file for usage.
+*/
+
+#include "mps.h"
+#include "testlib.h"
+#include "rankfmt.h"
+#include <string.h>
+
+/* some options on the format are controlled by global
+   variables. Of course for efficiency we'd do it in the
+   pre-processor, but that would require recompilation...
+*/
+
+int formatcomments=0;
+int checkcomments=0;
+int countcomments=1;
+int alloccomments=0;
+int fixcomments=0;
+int deathcomments=0;
+int skipcomments=0;
+int splurgeassoc=0; /* write madly to associated objects */
+
+long int nextid=0x1000000;
+
+long int checkobjcount=0;
+
+mps_addr_t exfmt_root=NULL;
+
+int counters[PAD_COUNT+1] = {0};
+int prevcounters[PAD_COUNT+1] = {0};
+int maxcounters[PAD_COUNT+1] = {0};
+
+long int maxcopy = 0;
+int freeze=0;
+
+/* The AWL pool makes certain assumptions about the object format,
+   some necessary and some unnecessary but useful for detecting problems
+   when using fmtdy. We have to ensure that:
+
+   Each objects begins with a pointer to a wrapper. To tag objects,
+   use non-zero values for the low bits.
+   The second word in each object is a pointer to the associated object,
+   usual rules for references apply.
+
+   The wrapper begins with a wrapper-wrapper pointer, and the third word
+   of the wrapper object has bit 0 set and bit 1 clear and at least one higher
+   bit also set.
+
+   The wrapper-wrapper's first word points to itself.
+
+   Here I make the wrapper-wrapper equal to the wrapper for all objects,
+   and use the same wrapper for all objects.
+
+   The other pools don't care about the wrapper, of course.
+*/
+
+struct wrapper {
+ struct wrapper *ww;
+ mps_word_t tag;
+ mps_word_t fixedlen;
+};
+
+struct wrapper wrapobj = {
+ &wrapobj,
+ 0x36ABBE6,
+ 0x5 
+};
+
+mycell *wrapper = (mycell *) &wrapobj;
+
+#define INCCOUNT(c) do {if(!freeze) counters[c]+=1;} while (0)
+#define INCCOUNTIF(f, c) do {if(f) INCCOUNT(c);} while (0)
+
+/* a cell can be one of four things, depending on its type:
+  MCpad       - a pad item
+  MCheart     - a broken heart, aka forwarding object
+  MCdata      - a real object
+*/
+
+/* the scanning function doesn't try to fix null refs
+*/
+
+static mps_res_t myscan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit);
+static mps_addr_t myskip(mps_addr_t object);
+static void myfwd(mps_addr_t object, mps_addr_t to);
+static mps_addr_t myisfwd(mps_addr_t object);
+static void mycopy(mps_addr_t object, mps_addr_t to);
+static void mypad(mps_addr_t base, size_t size);
+
+struct mps_fmt_A_s fmtA =
+{
+ MPS_PF_ALIGN,
+ &myscan,
+ &myskip,
+ &mycopy,
+ &myfwd,
+ &myisfwd,
+ &mypad
+};
+
+/* in the following, size is the number of refs you want
+   the allocated object to have
+*/
+
+mycell *allocdumb(mps_ap_t ap, size_t size, mps_rank_t rank)
+{
+ mycell *q;
+ size_t bytes;
+ size_t alignment;
+
+ bytes = offsetof(struct data, ref) + size;
+
+ alignment = MPS_PF_ALIGN; /* needed to make it as wide as size_t */
+
+/* twiddle the value of size to make it aligned */
+ bytes = (bytes+alignment-1) & ~(alignment-1);
+
+ do
+ {
+  die(mps_reserve(&exfmt_root, ap, bytes), "Reserve: ");
+  INCCOUNT(RESERVE_COUNT);
+  q=exfmt_root;
+  q->data.tag = (mps_word_t) wrapper;
+  q->data.assoc = NULL;
+  q->data.id = nextid;
+  q->data.copycount = 0;
+  q->data.numrefs = 0;
+  q->data.checkedflag = 0;
+  q->data.rank = rank;
+  q->data.size = bytes;
+ }
+ while (!mps_commit(ap, exfmt_root, bytes));
+ INCCOUNT(ALLOC_COUNT);
+ commentif(alloccomments, "allocated id %li at %p.", nextid, q);
+ nextid += 1;
+
+ return q;
+}
+
+mycell *allocone(mps_ap_t ap, int size, mps_rank_t rank)
+{
+ mycell *q;
+ int i;
+ size_t bytes;
+ size_t alignment;
+
+ bytes = offsetof(struct data, ref) + size*sizeof(struct refitem);
+
+ alignment = MPS_PF_ALIGN; /* needed to make it as wide as size_t */
+
+/* twiddle the value of size to make it aligned */
+ bytes = (bytes+alignment-1) & ~(alignment-1);
+
+ do
+ {
+  die(mps_reserve(&exfmt_root, ap, bytes), "Reserve: ");
+  INCCOUNT(RESERVE_COUNT);
+  q=exfmt_root;
+  q->data.tag = MCdata + (mps_word_t) wrapper;
+  q->data.assoc = NULL;
+  q->data.id = nextid;
+  q->data.copycount = 0;
+  q->data.numrefs = size;
+  q->data.checkedflag = 0;
+  q->data.rank = rank;
+  q->data.size = bytes;
+
+  for(i=0; i<size; i+=1)
+  {
+   q->data.ref[i].addr = NULL;
+   q->data.ref[i].id   = 0;
+  }
+ }
+ while (!mps_commit(ap, exfmt_root, bytes));
+ INCCOUNT(ALLOC_COUNT);
+ commentif(alloccomments, "allocated id %li at %p.", nextid, q);
+ nextid += 1;
+
+ return q;
+}
+ 
+static mps_res_t myscan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit)
+{
+ int i;
+
+ INCCOUNT(SCANCALL_COUNT);
+ MPS_SCAN_BEGIN(ss)
+ {
+  while (base < limit)
+  {
+   mycell *obj = base;
+   mps_res_t res;
+   mps_addr_t p, q;
+   mps_rank_t rank;
+
+   switch (obj->tag & 0x3)
+   {
+    case MCpad:
+     INCCOUNT(SCANPAD_COUNT);
+     base = (mps_addr_t) (obj->pad.tag &~ (mps_word_t) 3);
+     break;
+    case MCdata:
+     /* actual scanning is done in here */
+     asserts(obj->tag == MCdata + (mps_word_t) wrapper, "scan on bad object");
+     asserts(obj->data.id != MCerrorid, "scan on error object");
+     rank = obj->data.rank;
+     INCCOUNT(SCANOBJ_COUNT);
+     commentif(formatcomments, "scan %li at %p.", obj->data.id, base);
+
+     /* make sure to fix the assoc pointer first */
+     p = obj->data.assoc;
+     if (p != NULL) {
+      commentif(fixcomments, "fix %li[assoc]", obj->data.id);
+      q = p;
+      res = MPS_FIX(ss, (mps_addr_t *) &p);
+      if (res != MPS_RES_OK) return res;
+      if (p == NULL) {
+       asserts(rank == MPS_RANK_WEAK,
+               "non-weak reference fixed to NULL at %p[assoc]", obj);
+       commentif(deathcomments, "fixed %p[assoc] to NULL", obj->data.id);
+       INCCOUNT(DYING_REFERENCE_COUNT);
+      } else if (p != q) {
+       asserts(rank != MPS_RANK_AMBIG,
+               "ambiguous reference changed by fix at %p[assoc]", obj);
+      }
+      obj->data.assoc = p;
+     }
+
+     for (i=0; i<(obj->data.numrefs); i++)
+     {
+      p = obj->data.ref[i].addr;
+      if (p != NULL)
+      {
+       /* copy ref to p for fixing, to avoid a pun (although
+          the pun would probably work fine almost everywhere)
+       */
+       commentif(fixcomments, "fix %li[%i] -> %li",
+                 obj->data.id, i, obj->data.ref[i].id);
+       q = p;
+       res = MPS_FIX(ss, (mps_addr_t *) &p);
+       if (p == NULL) {
+        asserts(rank == MPS_RANK_WEAK,
+                "non-weak reference fixed to NULL at %p[i]", obj);
+        commentif(deathcomments, "fixed %li[%i] to NULL", obj->data.id, i);
+        INCCOUNT(DYING_REFERENCE_COUNT);
+       } else if (p != q) {
+        asserts(rank != MPS_RANK_AMBIG,
+                "ambiguous reference changed by fix at %p[i]", obj);
+       }
+       if (res != MPS_RES_OK) return res;
+       obj->data.ref[i].addr = p;
+      }
+     }
+     base = (mps_addr_t) ((char *) obj + (obj->data.size));
+     break;
+    case MCheart:
+     INCCOUNT(SCANHEART_COUNT);
+     base = (mps_addr_t) ((char *) obj + (obj->heart.size));
+     break;
+    default:
+     asserts(0, "scan: bizarre obj tag at %p.", obj);
+   }
+  }
+ }
+ MPS_SCAN_END(ss);
+ return MPS_RES_OK;
+}
+
+static mps_addr_t myskip(mps_addr_t object)
+{
+ mycell *obj = object;
+
+ commentif(skipcomments, "skip %p.", object);
+ INCCOUNT(SKIP_COUNT);
+ switch(obj->tag & 0x3)
+ {
+  case MCpad:
+   return (mps_addr_t) (obj->pad.tag &~ (mps_word_t) 0x3);
+  case MCheart:
+   return (mps_addr_t) ((char *) obj + (obj->heart.size));
+  case MCdata:
+   asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+    "skip on bad obj at %p.", obj);
+   return (mps_addr_t) ((char *) obj + (obj->data.size));
+  default:
+   asserts(0, "skip: bizarre obj tag at %p.", obj);
+   return 0; /* not reached */
+ }
+}
+
+static void mycopy(mps_addr_t object, mps_addr_t to)
+{
+ mycell *boj = object;
+ mycell *toj = to;
+
+ asserts(boj->tag == MCdata + (mps_word_t) wrapper,
+  "copy: non-data object");
+
+ INCCOUNT(COPY_COUNT);
+ commentif(formatcomments, "copy: %li: %p -> %p\n",
+  boj->data.id, object, to);
+
+/* this line would be bad, because the objects might overlap,
+   and then C doesn't guarantee to do the right thing!
+
+   *toj = *boj;
+*/
+
+ memmove(to, object, boj->data.size);
+ if (!freeze)
+ {
+  toj->data.copycount = (toj->data.copycount)+1;
+  if (toj->data.copycount > maxcopy) maxcopy = toj->data.copycount;
+ }
+}
+
+/* pad stores not its size but a pointer to the next object,
+   because we know we'll never be asked to copy it
+*/
+
+static void mypad(mps_addr_t base, size_t size)
+{
+ mycell *obj = base;
+
+ asserts(size >= MPS_PF_ALIGN, "pad: size too small.");
+
+ INCCOUNT(PAD_COUNT);
+ obj->pad.tag = MCpad + (mps_word_t) ((char *) base + size);
+}
+
+static mps_addr_t myisfwd(mps_addr_t object)
+{
+ mycell *obj = object;
+
+ INCCOUNT(ISFWD_COUNT);
+ if ((obj->tag & 3) != MCheart)
+ {
+  return NULL;
+ }
+ else
+ {
+  return obj->heart.obj;
+ }
+}
+
+static void myfwd(mps_addr_t object, mps_addr_t to)
+{
+ mycell *obj = object;
+ size_t size;
+
+ asserts(((obj->tag & 3) == MCdata) || ((obj->tag & 3) == MCheart),
+  "fwd: unexpected object tag at %p.", obj);
+ INCCOUNT(FWD_COUNT);
+
+ if ((obj->tag & 3) == MCdata)
+ {
+  asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+   "fwd: bad obj at %p.", obj);
+  size = obj->data.size;
+ }
+ else /* obj->tag == MCheart */
+ {
+  size = obj->heart.size;
+ }
+ obj->data.tag = MCheart;
+ obj->heart.obj = to;
+ obj->heart.size = size;
+}
+
+
+/* ---------------------------------------------------------------
+   Access methods for mycell objects
+*/
+
+/* set the nth reference of obj to to (n from 0 to size-1) */
+
+void setref(mycell *obj, int n, mycell *to)
+{
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "setref: from non-data object at %p", obj);
+ asserts((to==NULL)||((to->tag & 3) == MCdata),
+  "setref: to non-data object at %p", to);
+ asserts(obj->data.numrefs > n, "setref: access beyond object size.");
+
+ obj->data.ref[n].addr = to;
+ obj->data.ref[n].id = (to==NULL ? 0 : to->data.id);
+}
+
+mycell *getref(mycell *obj, int n)
+{
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "getref: from non-data object.");
+ asserts(obj->data.numrefs > n, "getref: access beyond object size.");
+ return obj->data.ref[n].addr;
+}
+
+mps_addr_t getdata(mycell *obj)
+{
+ return (mps_addr_t) &(obj->data.ref[0]);
+}
+
+long int getid(mycell *obj)
+{
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "getid: non-data object.");
+ return obj->data.id;
+}
+
+long int getcopycount(mycell *obj)
+{
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "getcopycount: non-data object.");
+ return obj->data.copycount;
+}
+
+long int getsize(mycell *obj)
+{
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "getsize: non-data object.");
+ return obj->data.numrefs;
+}
+
+/* ---------------------------------------------------------------
+   Now the useful things specially for checking the graph
+*/
+
+/* recursively check the graph, starting at an object.
+   We do the check twice, so as to restore the
+   checkflags to zero.
+*/
+
+static void checkloop(mycell *obj, int dir)
+{
+ mycell *toj;
+ int tid;
+ int i;
+
+ asserts(obj->tag == MCdata + (mps_word_t) wrapper,
+  "checkfrom: non data object in graph at %p.", obj);
+
+ if (obj->data.checkedflag != dir)
+ {
+  commentif(checkcomments, "checking %p = %li", obj, obj->data.id);
+
+  checkobjcount += 1;
+
+  obj->data.checkedflag = dir;
+
+  if (obj->data.assoc != NULL) {
+   toj = obj->data.assoc;
+   checkloop(toj, dir);
+  }
+  for (i=0; i<(obj->data.numrefs); i+=1)
+  {
+   if (obj->data.ref[i].addr != NULL)
+   {
+    toj = (obj->data.ref[i].addr);
+    tid = (obj->data.ref[i].id);
+    asserts(toj->data.id == tid,
+     "checkfrom: corrupt graph at %p, %d.", obj, i);
+    checkloop(toj, dir);
+   }
+  }
+ }
+}
+
+void checkfrom(mycell *obj)
+{
+ int k;
+
+ freeze = 1; /* suspend counting while checking graph */
+ checkobjcount = 0;
+ checkloop(obj, 1);
+ comment("checkfrom: %li live objects checked", checkobjcount);
+ k = checkcomments;
+ checkcomments = 0;
+ checkloop(obj, 0);
+ checkcomments = k;
+ comment("checkfrom: graph ok from ID: %li.", obj->data.id);
+ freeze = 0; /* resume counting */
+}
+
+/* ----------------------------------------------------------
+   Now things to reset and display the counters
+*/
+
+void resetcounters(void)
+{
+ int i;
+ for (i=0; i < PAD_COUNT+1; i++)
+ {
+  counters[i]=0;
+  prevcounters[i]=0;
+  maxcounters[i]=0;
+ }
+ maxcopy = 0;
+}
+
+void updatecounters(void)
+{
+ int i;
+ for (i=0; i < PAD_COUNT+1; i++)
+ {
+  if (counters[i]-prevcounters[i] > maxcounters[i])
+  {
+   maxcounters[i]=counters[i]-prevcounters[i];
+  }
+  prevcounters[i]=counters[i];
+ }
+}
+
+
+static void d_c(int i, char *name)
+{
+ comment("%10d %s", counters[i], name);
+}
+
+static void d_mc(int i, char *name)
+{
+ comment("%10d %s", maxcounters[i], name);
+}
+
+void displaycounters(void)
+{
+ comment("--------");
+ comment("Counters:");
+ d_c(SCANCALL_COUNT, "scan calls");
+ d_c(SCANOBJ_COUNT, "object scans");
+ d_c(SCANHEART_COUNT, "heart scans");
+ d_c(SCANPAD_COUNT, "pad scans");
+ d_c(COPY_COUNT, "copys");
+ d_c(SKIP_COUNT, "skips");
+ d_c(FWD_COUNT, "fwds");
+ d_c(ISFWD_COUNT, "isfwds");
+ d_c(PAD_COUNT, "pads");
+ d_c(RESERVE_COUNT, "reserve calls");
+ d_c(ALLOC_COUNT, "allocations");
+ d_c(DYING_REFERENCE_COUNT, "references fixed to NULL");
+ comment("--------");
+}
+
+void displaymaxcounters(void)
+{
+ comment("--------");
+ comment("Maximum counter values:");
+ d_mc(SCANCALL_COUNT, "scan calls");
+ d_mc(SCANOBJ_COUNT, "object scans");
+ d_mc(SCANHEART_COUNT, "heart scans");
+ d_mc(SCANPAD_COUNT, "pad scans");
+ d_mc(COPY_COUNT, "copys");
+ d_mc(SKIP_COUNT, "skips");
+ d_mc(FWD_COUNT, "fwds");
+ d_mc(ISFWD_COUNT, "isfwds");
+ d_mc(RESERVE_COUNT, "reserve calls");
+ d_mc(ALLOC_COUNT, "allocations");
+ d_mc(DYING_REFERENCE_COUNT, "references fixed to NULL");
+ d_mc(PAD_COUNT, "pads");
+ comment("--------");
+ comment("max copies of a single object: %li.", maxcopy);
+ comment("--------");
+}
+
diff --git a/mps/qa/test/testlib/rankfmt.h b/mps/qa/test/testlib/rankfmt.h
new file mode 100644
index 00000000000..13c8ab21b96
--- /dev/null
+++ b/mps/qa/test/testlib/rankfmt.h
@@ -0,0 +1,126 @@
+/* rankfmt.h
+   Format like exfmt but with rank-checking built in.
+   This format will work without register roots, but to use it,
+   you must take precautions. You must register exfmt_root as
+   a root, and unless you register the
+   registers and stack, you must register it as ambiguous (or
+   it might change before you can write the address of a newly
+   allocated object into another root). When you call getref or
+   setref, you must make sure that the objects concerned are
+   referenced ambiguously somewhere (this guarantees that they
+   won't move -- I asked richard and drj).
+   
+*/
+
+#ifndef exfmt_h
+#define exfmt_h
+
+#include "mps.h"
+
+extern int formatcomments;
+extern int checkcomments;
+extern int countcomments;
+extern int alloccomments;
+extern int fixcomments;
+extern int deathcomments;
+extern int skipcomments;
+extern int splurgeassoc; /* write to associated objects (but don't change) */
+
+extern mps_addr_t exfmt_root;
+
+/* the counters are visible so that I can check whether things
+   get moved etc
+*/
+
+enum {
+ SCANCALL_COUNT,
+ SCANOBJ_COUNT, /* = read objects scanned */
+ SCANPAD_COUNT, /* = pads scanned */
+ SCANHEART_COUNT, /* = hearts scanned */
+ COPY_COUNT,
+ SKIP_COUNT,
+ FWD_COUNT,
+ ISFWD_COUNT,
+ RESERVE_COUNT,
+ ALLOC_COUNT,
+ DYING_REFERENCE_COUNT,
+ PAD_COUNT /* must come last or array sizes will be too small */
+};
+
+extern int counters[PAD_COUNT+1];
+extern int prevcounters[PAD_COUNT+1];
+extern int maxcounters[PAD_COUNT+1];
+
+long int maxcopy;
+int freeze;
+
+/* the object format is visible so tests that want to
+   can hack around with it
+*/
+
+#define MAXSIZE 10000
+
+enum {MCpad=(int) 0x1, MCheart=(int) 0x2, MCdata=(int) 0x0};
+
+enum {MCerrorid=(int) 0xE6606};
+
+/* n.b. MCerrorid < 0x1000000 so it won't clash with id of
+   any ordinary object
+*/
+
+typedef union mycell mycell;
+
+typedef mps_word_t tag;
+
+struct pad {tag tag;};
+
+struct heart {tag tag; mps_addr_t obj; size_t size;};
+
+struct data
+{
+ tag tag;
+ mycell *assoc;
+ size_t size;
+ long int id;
+ long int copycount;
+ long int numrefs;
+ int checkedflag;
+ mps_rank_t rank;
+ struct refitem {mycell *addr; long int id;} ref[MAXSIZE];
+};
+
+union mycell
+{
+ tag tag;
+ struct pad       pad;
+ struct heart     heart;
+ struct data      data;
+};
+
+extern struct mps_fmt_A_s fmtA;
+
+mycell *allocone(mps_ap_t ap, int size, mps_rank_t rank);
+mycell *allocdumb(mps_ap_t ap, size_t bytes, mps_rank_t rank);
+
+mps_addr_t getdata(mycell *obj);
+void setref(mycell *obj, int n, mycell *to);
+mycell *getref(mycell *obj, int n);
+
+long int getid(mycell *obj);
+long int getcopycount(mycell *obj);
+long int getsize(mycell *obj);
+
+void checkfrom(mycell *obj);
+
+#define RC resetcounters()
+#define UC updatecounters()
+#define DC displaycounters()
+#define DMC displaymaxcounters()
+
+void resetcounters(void);
+void updatecounters(void);
+void displaycounters(void);
+void displaymaxcounters(void);
+
+#endif
+