Mps integ from br/auto_header: job001784 amc + auto_header leak

poolamc.c: [job001784] fix ControlPool leak in amcSegDestroyNailboard;
arena.c, mpm.h: new ControlDescribe() diagnostic function, to describe arena control pool;
mpsicv.c, comm.gmk: use auto_header format half the time (rnd() & 1).
+ readme.txt: describe job001784 fix.

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

mps/code/arena.c

@@ -461,6 +461,21 @@ void ControlFree(Arena arena, void* base, size_t size)
 }
 
 
+/* ControlDescribe -- describe the arena's control pool */
+
+Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
+{
+  Res res;
+
+  if (!CHECKT(Arena, arena)) return ResFAIL;
+  if (stream == NULL) return ResFAIL;
+
+  res = PoolDescribe(ArenaControlPool(arena), stream);
+
+  return res;
+}
+
+
 /* ArenaAlloc -- allocate some tracts from the arena */
 
 Res ArenaAlloc(Addr *baseReturn, SegPref pref, Size size, Pool pool,

mps/code/comm.gmk

@@ -393,7 +393,7 @@ $(PFM)/$(VARIETY)/lockcov: $(PFM)/$(VARIETY)/lockcov.o \
 	$(MPMOBJ) $(PLINTHOBJ) $(TESTLIBOBJ)
 
 $(PFM)/$(VARIETY)/mpsicv: $(PFM)/$(VARIETY)/mpsicv.o \
-	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
+	$(FMTDYTSTOBJ) $(FMTHETSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)
 
 $(PFM)/$(VARIETY)/amcss: $(PFM)/$(VARIETY)/amcss.o \
 	$(FMTDYTSTOBJ) $(MPMOBJ) $(PLINTHOBJ) $(AMCOBJ) $(TESTLIBOBJ)

mps/code/mpm.h

@@ -501,6 +501,7 @@ extern void ControlFinish(Arena arena);
 extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
                         Bool withReservoirPermit);
 extern void ControlFree(Arena arena, void *base, size_t size);
+extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream);
 
 
 /* Peek/Poke

mps/code/mpsicv.c

@@ -9,6 +9,7 @@
 #include "mpscamc.h"
 #include "mpsavm.h"
 #include "mpscmv.h"
+#include "fmthe.h"
 #include "fmtdy.h"
 #include "fmtdytst.h"
 #include "mps.h"
@@ -38,6 +39,29 @@ static mps_gen_param_s testChain[genCOUNT] = {
 
 static mps_pool_t amcpool;
 static mps_ap_t ap;
+static size_t ap_headerSIZE = 0;
+/* For this ap.... */
+/* Auto_header format
+ *
+ *   [ auto_header ][===object===]
+ *   ^pMps          ^pCli
+ *   <-----------sizeMps--------->
+ *                  <---sizeCli-->
+ *
+ * Note: pMps < pCli; sizeMps > sizeCli.
+ */
+#define PtrMps2Cli(n) ((char*)n + ap_headerSIZE)
+#define PtrCli2Mps(n) ((char*)n - ap_headerSIZE)
+#define SizeMps2Cli(n) (n - ap_headerSIZE)
+#define SizeCli2Mps(n) (n + ap_headerSIZE)
+#define HeaderInit(pMps) do {                                          \
+  if(ap_headerSIZE != 0) {                                             \
+    mps_addr_t pMps_MACROCOPY = (pMps);  /* macro hygiene */           \
+    ((int*)pMps_MACROCOPY)[0] = realHeader;                            \
+    ((int*)pMps_MACROCOPY)[1] = 0xED0ED;                               \
+  }                                                                    \
+ } while(0)
+
 static mps_addr_t exactRoots[exactRootsCOUNT];
 static mps_addr_t ambigRoots[ambigRootsCOUNT];
 
@@ -103,18 +127,22 @@ static void alignmentTest(mps_arena_t arena)
 
 static mps_addr_t make(void)
 {
-  size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t);
-  mps_addr_t p;
+  size_t length = rnd() % 20;
+  size_t sizeCli = (length+2)*sizeof(mps_word_t);
+  size_t sizeMps = SizeCli2Mps(sizeCli);
+  mps_addr_t pMps, pCli;
   mps_res_t res;
 
   do {
-    MPS_RESERVE_BLOCK(res, p, ap, size);
+    MPS_RESERVE_BLOCK(res, pMps, ap, sizeMps);
     if (res != MPS_RES_OK) die(res, "MPS_RESERVE_BLOCK");
-    res = dylan_init(p, size, exactRoots, exactRootsCOUNT);
+    HeaderInit(pMps);
+    pCli = PtrMps2Cli(pMps);
+    res = dylan_init(pCli, sizeCli, exactRoots, exactRootsCOUNT);
     if (res != MPS_RES_OK) die(res, "dylan_init");
-  } while(!mps_commit(ap, p, size));
+  } while(!mps_commit(ap, pMps, sizeMps));
 
-  return p;
+  return pCli;
 }
 
 
@@ -122,18 +150,22 @@ static mps_addr_t make(void)
 
 static mps_addr_t make_with_permit(void)
 {
-  size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t);
-  mps_addr_t p;
+  size_t length = rnd() % 20;
+  size_t sizeCli = (length+2)*sizeof(mps_word_t);
+  size_t sizeMps = SizeCli2Mps(sizeCli);
+  mps_addr_t pMps, pCli;
   mps_res_t res;
 
   do {
-    MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, p, ap, size);
+    MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, pMps, ap, sizeMps);
     if (res != MPS_RES_OK) die(res, "MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK");
-    res = dylan_init(p, size, exactRoots, exactRootsCOUNT);
+    HeaderInit(pMps);
+    pCli = PtrMps2Cli(pMps);
+    res = dylan_init(pCli, sizeCli, exactRoots, exactRootsCOUNT);
     if (res != MPS_RES_OK) die(res, "dylan_init");
-  } while(!mps_commit(ap, p, size));
+  } while(!mps_commit(ap, pMps, sizeMps));
 
-  return p;
+  return pCli;
 }
 
 
@@ -141,18 +173,22 @@ static mps_addr_t make_with_permit(void)
 
 static mps_addr_t make_no_inline(void)
 {
-  size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t);
-  mps_addr_t p;
+  size_t length = rnd() % 20;
+  size_t sizeCli = (length+2)*sizeof(mps_word_t);
+  size_t sizeMps = SizeCli2Mps(sizeCli);
+  mps_addr_t pMps, pCli;
   mps_res_t res;
 
   do {
-    res = (mps_reserve)(&p, ap, size);
+    res = (mps_reserve)(&pMps, ap, sizeMps);
     if (res != MPS_RES_OK) die(res, "(mps_reserve)");
-    res = dylan_init(p, size, exactRoots, exactRootsCOUNT);
+    HeaderInit(pMps);
+    pCli = PtrMps2Cli(pMps);
+    res = dylan_init(pCli, sizeCli, exactRoots, exactRootsCOUNT);
     if (res != MPS_RES_OK) die(res, "dylan_init");
-  } while(!(mps_commit)(ap, p, size));
+  } while(!(mps_commit)(ap, pMps, sizeMps));
 
-  return p;
+  return pCli;
 }
 
 
@@ -290,7 +326,16 @@ static void *test(void *arg, size_t s)
   arena = (mps_arena_t)arg;
   testlib_unused(s);
 
-  die(dylan_fmt(&format, arena), "fmt_create");
+  if (rnd() & 1) {
+    printf("Using auto_header format.\n");
+    EnsureHeaderFormat(&format, arena);
+    ap_headerSIZE = headerSIZE;  /* from fmthe.h */
+  } else {
+    printf("Using normal format (no implicit object header: client pointers point at start of storage).\n");
+    die(dylan_fmt(&format, arena), "fmt_create");
+    ap_headerSIZE = 0;
+  }
+
   die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
 
   die(mps_pool_create(&mv, arena, mps_class_mv(), 0x10000, 32, 0x10000),
@@ -402,8 +447,8 @@ static void *test(void *arg, size_t s)
         cdie(rampCount > 0 ? res == MPS_RES_OK : res == MPS_RES_FAIL,
              "alloc_pattern_end");
         if (rampCount > 0) {
-	  --rampCount;
-	}
+          --rampCount;
+        }
         break;
       case 3:
         die(mps_ap_alloc_pattern_reset(ap), "alloc_pattern_reset");
@@ -483,7 +528,7 @@ int main(int argc, char **argv)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2002, 2008 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

mps/code/poolamc.c

@@ -736,7 +736,8 @@ static void amcSegDestroyNailboard(Seg seg, Pool pool)
   AVERT(amcNailboard, board);
 
   arena = PoolArena(pool);
-  bits = SegSize(seg) >> board->markShift;
+  /* See d.m.p.Nailboard.size. */
+  bits = (SegSize(seg) + pool->format->headerSize) >> board->markShift;
   ControlFree(arena, board->mark, BTSize(bits));
   board->sig = SigInvalid;
   ControlFree(arena, board, sizeof(amcNailboardStruct));
@@ -2280,7 +2281,7 @@ static Bool AMCCheck(AMC amc)
 
 /* C. COPYRIGHT AND LICENSE
  *
- * Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
+ * Copyright (C) 2001-2002, 2008 Ravenbrook Limited <http://www.ravenbrook.com/>.
  * All rights reserved.  This is an open source license.  Contact
  * Ravenbrook for commercial licensing options.
  * 

mps/readme.txt

@@ -53,13 +53,32 @@ record of changes.  In a release of the MPS-Kit, this section becomes
 the summary of what is new for that release.)
 
 [
-......Post 1.108.0 changes:
+......Post 1.108.1 changes:
 
 This is release A.BBB.C, made on YYYY-MM-DD.
 Changes from release A.BBB.C-1:
 
 Functional changes to MPS code:
 
+<http://www.ravenbrook.com/project/mps/issue/job001784/>
+Defect discovered:
+  - when using an auto_header format (mps_fmt_create_auto_header) 
+    with AMC pools (mps_class_amc), the MPS leaks a small amount of 
+    memory on each collection.
+Impact:
+  - the leak is likely to be a few bytes per collection, and at most 
+    one byte per page (typically 2^12 bytes) of the address-space 
+    currently in use for objects in AMC pools;
+  - the leak is of temporary memory that the MPS uses to process 
+    ambiguous references (typically references on the stack and in 
+    registers), so a larger stack when a collection starts will 
+    tend to cause a larger leak;
+  - the leaked bytes are widely-spaced single bytes which therefore 
+    also cause fragmentation;
+  - the leaked bytes are not reclaimed until the client calls 
+    mps_arena_destroy().
+Fixed: correctly release all of this temporary memory.
+
 Other changes:
 
 ]
@@ -449,7 +468,7 @@ B. DOCUMENT HISTORY
 
 C. COPYRIGHT AND LICENSE
 
-Copyright (C) 2001-2002, 2006-2007 Ravenbrook Limited.  
+Copyright (C) 2001-2002, 2006-2007, 2008 Ravenbrook Limited.  
 All rights reserved.  <http://www.ravenbrook.com/>.  
 This is an open source license.  
 Contact Ravenbrook for commercial licensing options.