mps br/padding: mps_addr_pool(), mps_addr_fmt() -- new mps functions

mps.h, mpsicv.c: implementation
 mpsicv.c: new addr_pool_test(), to test them
 w3gen.def: export them
 walkt0.c: test them within mps_arena_formatted_objects_walk().  (Also checks against values passed to stepper function, and against what we expect).
 tool/test-runner.py: add walkt0

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

mps/code/mps.h

@@ -276,6 +276,8 @@ extern size_t mps_space_reserved(mps_space_t);
 extern size_t mps_space_committed(mps_space_t);
 
 extern mps_bool_t mps_arena_has_addr(mps_arena_t, mps_addr_t);
+extern mps_bool_t mps_addr_pool(mps_pool_t *, mps_arena_t, mps_addr_t);
+extern mps_bool_t mps_addr_fmt(mps_fmt_t *, mps_arena_t, mps_addr_t);
 
 /* Client memory arenas */
 extern mps_res_t mps_arena_extend(mps_arena_t, mps_addr_t, size_t);

mps/code/mpsi.c

@@ -501,6 +501,79 @@ mps_bool_t mps_arena_has_addr(mps_arena_t mps_arena, mps_addr_t p)
 }
 
 
+/* mps_addr_pool -- return the pool containing the given address
+ *
+ * Wrapper for PoolOfAddr.  Note: may return an MPS-internal pool.
+ */
+
+mps_bool_t mps_addr_pool(mps_pool_t *mps_pool_o,
+                         mps_arena_t mps_arena,
+                         mps_addr_t p)
+{
+    Bool b;
+    Pool pool;
+    Arena arena = (Arena)mps_arena;
+
+    AVER(mps_pool_o != NULL);
+    /* mps_arena -- will be checked by ArenaEnterRecursive */
+    /* p -- cannot be checked */
+
+    /* One of the few functions that can be called
+       during the call to an MPS function.  IE this function
+       can be called when walking the heap. */
+    ArenaEnterRecursive(arena);
+    b = PoolOfAddr(&pool, arena, (Addr)p);
+    ArenaLeaveRecursive(arena);
+
+    if(b)
+      *mps_pool_o = (mps_pool_t)pool;
+
+    return b;
+}
+
+
+/* mps_addr_fmt -- what format might this address have?
+ *
+ * .per-pool: There's no reason why all objects in a pool should have 
+ * the same format.  But currently, MPS internals support at most one 
+ * format per pool.
+ *
+ * If the address is in a pool and has a format, returns TRUE and 
+ * updates *mps_fmt_o to be that format.  Otherwise, returns FALSE 
+ * and does not update *mps_fmt_o.
+ *
+ * Note: may return an MPS-internal format.
+ */
+mps_bool_t mps_addr_fmt(mps_fmt_t *mps_fmt_o,
+                        mps_arena_t mps_arena,
+                        mps_addr_t p)
+{
+    Bool b;
+    Pool pool;
+    Format format;
+    Arena arena = (Arena)mps_arena;
+
+    AVER(mps_fmt_o != NULL);
+    /* mps_arena -- will be checked by ArenaEnterRecursive */
+    /* p -- cannot be checked */
+
+    /* One of the few functions that can be called
+       during the call to an MPS function.  IE this function
+       can be called when walking the heap. */
+    ArenaEnterRecursive(arena);
+    /* .per-pool */
+    b = PoolOfAddr(&pool, arena, (Addr)p);
+    if(b)
+      b = PoolFormat(&format, pool);
+    ArenaLeaveRecursive(arena);
+
+    if(b)
+      *mps_fmt_o = (mps_fmt_t)format;
+
+    return b;
+}
+
+
 /* mps_fmt_create_A -- create an object format of variant A
  *
  * .fmt.create.A.purpose: This function converts an object format spec

mps/code/mpsicv.c

@@ -229,6 +229,79 @@ static void ap_create_v_test(mps_pool_t pool, ...)
 }
 
 
+/* addr_pool_test
+ *
+ * intended to test:
+ *   mps_addr_pool
+ *   mps_addr_fmt
+ */
+
+static void addr_pool_test(mps_arena_t arena,
+                           mps_addr_t  obj1,   /* unformatted */
+                           mps_pool_t  pool1,
+                           mps_addr_t  obj2,   /* formatted */
+                           mps_pool_t  pool2,
+                           mps_fmt_t   fmt2)
+{
+  /* Things we might test.  An addr might be:
+   *   0- a valid reference to an MPS-managed object;
+   *   1- interior pointer to an MPS-managed object;
+   *   2- pointer into some other part of a Seg owned by a Pool;
+   *   ^^^(mps_addr_pool returns TRUE for these)
+   *   3- pointer to some MPS memory that's not a Seg;
+   *   4- pointer to unmapped memory;
+   *   5- pointer to memory not in any Chunk.
+   *   ^^^(mps_addr_pool returns FALSE for these)
+   *
+   * We actually test case 0 (for both unformatted and formatted 
+   * objects), and case 5.
+   */
+
+  mps_bool_t b;
+  mps_addr_t addr;
+  /* DISTInguished values are to observe overwrites. */
+  mps_pool_t poolDistinguished = (mps_pool_t)0x000d1521;
+  mps_pool_t pool = poolDistinguished;
+  mps_fmt_t fmtDistinguished = (mps_fmt_t)0x000d1521;
+  mps_fmt_t fmt = fmtDistinguished;
+
+  /* 0a -- obj1 in pool1 (unformatted) */
+  addr = obj1;
+  pool = poolDistinguished;
+  fmt = fmtDistinguished;
+  b = mps_addr_pool(&pool, arena, addr);
+  /* printf("b %d; pool %p; sig %lx\n", b, (void *)pool,
+            b ? ((mps_word_t*)pool)[0] : (mps_word_t)0); */
+  cdie(b == TRUE && pool == pool1, "mps_addr_pool 0a");
+  b = mps_addr_fmt(&fmt, arena, addr);
+  /* printf("b %d; fmt %p; sig %lx\n", b, (void *)fmt,
+            b ? ((mps_word_t*)fmt)[0] : (mps_word_t)0); */
+  cdie(b == FALSE && fmt == fmtDistinguished, "mps_addr_fmt 0a");
+
+  /* 0b -- obj2 in pool2, with fmt2 */
+  addr = obj2;
+  pool = poolDistinguished;
+  fmt = fmtDistinguished;
+  b = mps_addr_pool(&pool, arena, addr);
+  /* printf("b %d; pool %p; sig %lx\n", b, (void *)pool,
+            b ? ((mps_word_t*)pool)[0] : (mps_word_t)0); */
+  cdie(b == TRUE && pool == pool2, "mps_addr_pool 0b");
+  b = mps_addr_fmt(&fmt, arena, addr);
+  /* printf("b %d; fmt %p; sig %lx\n", b, (void *)fmt,
+            b ? ((mps_word_t*)fmt)[0] : (mps_word_t)0); */
+  cdie(b == TRUE && fmt == fmt2, "mps_addr_fmt 0b");
+
+  /* 5 */
+  addr = &pool;  /* point at stack, not in any chunk */
+  pool = poolDistinguished;
+  fmt = fmtDistinguished;
+  b = mps_addr_pool(&pool, arena, addr);
+  cdie(b == FALSE && pool == poolDistinguished, "mps_addr_pool 5");
+  b = mps_addr_fmt(&fmt, arena, addr);
+  cdie(b == FALSE && fmt == fmtDistinguished, "mps_addr_fmt 5");
+}
+
+
 static mps_res_t root_single(mps_ss_t ss, void *p, size_t s)
 {
   testlib_unused(s);
@@ -378,6 +451,8 @@ static void *test(void *arg, size_t s)
   die(dylan_init(alloced_obj, asize, exactRoots, exactRootsCOUNT),
       "dylan_init(alloced_obj)");
 
+  addr_pool_test(arena, alloced_obj, mv, make(), amcpool, format);
+
   die(mps_root_create_fmt(&fmtRoot, arena,
                           MPS_RANK_EXACT, (mps_rm_t)0,
                           dylan_fmt_A()->scan,

mps/code/w3gen.def

@@ -39,6 +39,8 @@ mps_fmt_create_B
 mps_fmt_create_A
 mps_arena_extend
 mps_arena_has_addr
+mps_addr_pool
+mps_addr_fmt
 mps_space_committed
 mps_space_reserved
 mps_arena_formatted_objects_walk

mps/code/walkt0.c

@@ -75,21 +75,53 @@ static mps_addr_t make(void)
     return p;
 }
 
-/* A stepper function.  Passed to mps_arena_formatted_objects_walk. */
+/* A stepper function.  Passed to mps_arena_formatted_objects_walk.
+ *
+ * Tests the (pool, format) values that MPS passes to it for each 
+ * object, by...
+ *
+ * ...1: making explicit queries with:
+ *   mps_arena_has_addr
+ *   mps_addr_pool
+ *   mps_addr_fmt
+ *
+ * ...2: comparing with what we expect for:
+ *   pool
+ *   fmt
+ */
+struct stepper_data {
+  mps_arena_t arena;
+  mps_pool_t expect_pool;
+  mps_fmt_t expect_fmt;
+  unsigned long count;
+};
+
 static void stepper(mps_addr_t object, mps_fmt_t format,
     mps_pool_t pool, void *p, size_t s)
 {
-    mps_arena_t arena = p;
+    struct stepper_data *sd;
+    mps_arena_t arena;
+    mps_bool_t b;
+    mps_pool_t query_pool;
+    mps_fmt_t query_fmt;
 
-    UNUSED(format);
-    UNUSED(pool);
-    UNUSED(pool);
-    UNUSED(s);
+    Insist(s == sizeof *sd);
+    sd = p;
+    arena = sd->arena;
 
-    if(!mps_arena_has_addr(arena, object)) {
-      printf("Stepper got called with object at address %p,\n"
-       "which is not managed by the arena!\n", (void *)object);
-    }
+    Insist(mps_arena_has_addr(arena, object));
+
+    b = mps_addr_pool(&query_pool, arena, object);
+    Insist(b);
+    Insist(query_pool == pool);
+    Insist(pool == sd->expect_pool);
+
+    b = mps_addr_fmt(&query_fmt, arena, object);
+    Insist(b);
+    Insist(query_fmt == format);
+    Insist(format == sd->expect_fmt);
+    
+    sd->count += 1;
     return;
 }
 
@@ -104,6 +136,7 @@ static void *test(void *arg, size_t s)
     mps_root_t exactRoot;
     size_t i;
     unsigned long objs;
+    struct stepper_data sdStruct, *sd;
 
     arena = (mps_arena_t)arg;
     (void)s; /* unused */
@@ -143,7 +176,14 @@ static void *test(void *arg, size_t s)
         ++objs;
     }
 
-    mps_arena_formatted_objects_walk(arena, stepper, arena, 0);
+    sd = &sdStruct;
+    sd->arena = arena;
+    sd->expect_pool = pool;
+    sd->expect_fmt = format;
+    sd->count = 0;
+    mps_arena_formatted_objects_walk(arena, stepper, sd, sizeof *sd);
+    /* Note: stepper finds more than we expect, due to pad objects */
+    /* printf("stepper found %ld objs\n", sd->count); */
 
     mps_ap_destroy(ap);
     mps_root_destroy(exactRoot);
@@ -160,8 +200,7 @@ int main(int argc, char **argv)
     mps_thr_t thread;
     void *r;
 
-    UNUSED(argc);
-    UNUSED(argv);
+    randomize(argc, argv);
 
     die(mps_arena_create(&arena, mps_arena_class_vm(),
                          testArenaSIZE),

mps/tool/test-runner.py

@@ -121,6 +121,7 @@ runtestlist([
     "mpsicv",
     "zcoll",
     "zmess",
+    "walkt0",
     "messtest",
  ], ["we", "hi", "di", "ci"], testout)