diff --git a/mps/code/mps.h b/mps/code/mps.h
index f978a7bfae4..59884accae6 100644
--- a/mps/code/mps.h
+++ b/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);
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index b2193825c2d..3a356f5d50a 100644
--- a/mps/code/mpsi.c
+++ b/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 = 0;
+ 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
diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c
index dea398b4097..b7c315a7e65 100644
--- a/mps/code/mpsicv.c
+++ b/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,
diff --git a/mps/code/w3gen.def b/mps/code/w3gen.def
index 660b2ba94f5..aab9c32547f 100644
--- a/mps/code/w3gen.def
+++ b/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
diff --git a/mps/code/walkt0.c b/mps/code/walkt0.c
index bbecbcf19aa..44b7a38d1f4 100644
--- a/mps/code/walkt0.c
+++ b/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),
diff --git a/mps/design/poolamc/index.html b/mps/design/poolamc/index.html
index 3b2f2c7f6bf..ae004183ae0 100644
--- a/mps/design/poolamc/index.html
+++ b/mps/design/poolamc/index.html
@@ -47,7 +47,7 @@
AMC Seg States
-AMC Segs are in one of three states: "mobile", "boarded", or "stuck". This is new terminology, not used in the initial design, and not yet widespread in the source code. Segs are normally "mobile": all objects on the seg are un-nailed, and thus may be preserved by copying. An ambiguous reference to any address within an AMC seg makes that seg "boarded": a nailboard is allocated to record ambiguous refs ("nails"), but un-nailed objects on the seg are still preserved by copying. Stuck segments only occur in emergency tracing: a discovery fix to an object in a mobile segment is recorded in the only non-allocating way available: by making the entire segment "stuck".
+AMC Segs are in one of three states: "mobile", "boarded", or "stuck" [This is new terminology, not used in the initial design, and not yet widespread in the source code -- RHSK 2009-09-14]. Segs are normally "mobile": all objects on the seg are un-nailed, and thus may be preserved by copying. An ambiguous reference to any address within an AMC seg makes that seg "boarded": a nailboard is allocated to record ambiguous refs ("nails"), but un-nailed objects on the seg are still preserved by copying. Stuck segments only occur in emergency tracing: a discovery fix to an object in a mobile segment is recorded in the only non-allocating way available: by making the entire segment "stuck".
Pads
@@ -62,7 +62,7 @@
LSP pads (Large Segment Padding) are made by AMCBufferFill when the requested fill size is 'large' (see "The LSP payoff calculation" below). AMCBufferFill fills the buffer to exactly the size requested by the current buffer reserve operation; that is: it does not round up to the whole segment size. This prevents subsequent small objects being placed in the same segment as a single very large object. If the buffer fill size is less than the segment size, AMCBufferFill fills any remainder with an LSP pad.
-NMR pads (Non-Mobile Reclaim) are made by amcReclaimNailed, when performing reclaim on a boarded or stuck segment:
+NMR pads (Non-Mobile Reclaim) are made by amcReclaimNailed, when performing reclaim on a non-mobile (that is: either boarded or stuck) segment:
The more common NMR scenario is reclaim of a boarded seg after a non-emergency trace. Ambiguous refs into the seg are recorded as nails. Subsequent exact refs to a nailed object do nothing further, but exact refs that do not match a nail cause preserve-by-copy and leave a forwarding object. Unreachable objects are not touched during the scan+fix part of the trace. On reclaim, only nailed objects need to be preserved; others (namely forwarding pointers and unreachable objects) are replaced by an NMR pad. (Note that a BE or LSP pad appears to be an unreachable object, and is therefore overwritten by an NMR pad).
@@ -123,7 +123,7 @@
For large segments, we decide that the risk of using the remainder is just too great, and the benefit too small, so we throw it away as an LSP pad. This is equivalent to purchasing insurance: we choose to pay a known small cost every time, to avoid risking an occasional disaster.
-To decide what size of segment counts as "large", we must decide how much uninsured risk we can tolerate, versus how much insurance cost we can tolerate. The likelihood of ambiguous references retaining objects is entirely dependent on client behaviour. However, as a sufficient 'one size fits all' policy, I have judged that segments smaller than 8 pages long do not need to be treated as large: the insurance cost to 'play safe' would be considerable (wasting up to 1 page of remainder per 7 pages of allocation), and the fragmentation overhead risk is not that great (at most 8 times worse than the unavoidable minimum). So AMCLargeSegPAGES is defined as 8 in config.h. As long as the assumption that most segments are not ambiguously referenced remains correct, I expect this policy will be satisfactory.
+To decide what size of segment counts as "large", we must decide how much uninsured risk we can tolerate, versus how much insurance cost we can tolerate. The likelihood of ambiguous references retaining objects is entirely dependent on client behaviour. However, as a sufficient 'one size fits all' policy, I (RHSK 2009-09-14) have judged that segments smaller than 8 pages long do not need to be treated as large: the insurance cost to 'play safe' would be considerable (wasting up to 1 page of remainder per 7 pages of allocation), and the fragmentation overhead risk is not that great (at most 8 times worse than the unavoidable minimum). So AMCLargeSegPAGES is defined as 8 in config.h. As long as the assumption that most segments are not ambiguously referenced remains correct, I expect this policy will be satisfactory.
To verify that this threshold is acceptable for a given client, poolamc.c calculates metrics; see "Feedback about retained pages" below. If this one-size-fits-all approach is not satisfactory, AMCLargeSegPAGES could be made a client-tunable parameter.
diff --git a/mps/manual/reference/index.html b/mps/manual/reference/index.html
index 9217f008dbd..3ab3cf920b5 100644
--- a/mps/manual/reference/index.html
+++ b/mps/manual/reference/index.html
@@ -10689,6 +10689,8 @@ mps_arena_extend
mps_arena_retract
mps_fmt_create_fixed
mps_fmt_destroy
+mps_addr_pool
+mps_addr_fmt
mps_pool_create
mps_pool_create_v
mps_pool_destroy
@@ -10890,12 +10892,18 @@ MPS_PF_XCPPGC
mps_message_clock: add entry. |
+
+ | 2010-03-02 |
+ RHSK |
+ mps_addr_pool, mps_addr_fmt: as yet Undocumented. |
+
+
-This document is copyright © 1997-2002, 2003, 2006, 2007, 2008 Ravenbrook Limited. All rights reserved. This is an open source license. Contact Ravenbrook for commercial licensing options.
+This document is copyright © 1997-2002, 2003, 2006, 2007, 2008, 2010 Ravenbrook Limited. 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:
diff --git a/mps/tool/test-runner.py b/mps/tool/test-runner.py
index d3f5e2df932..939501fbe43 100755
--- a/mps/tool/test-runner.py
+++ b/mps/tool/test-runner.py
@@ -121,6 +121,7 @@ runtestlist([
"mpsicv",
"zcoll",
"zmess",
+ "walkt0",
"messtest",
], ["we", "hi", "di", "ci"], testout)