/* 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)
{
mps_pool_t poolamc, poolawl, poollo;
mps_thr_t thread;
mps_root_t root0, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl, aplo;
mycell *a, *b, *c, *d;
long int j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)1024*1024*30),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root0, arena, MPS_RANK_AMBIG, 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_root_create_table(&root1, arena, MPS_RANK_AMBIG, 0,
(mps_addr_t*)&exfmt_root, 1),
"create table root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format),
"create pool(awl)");
cdie(mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(mps_ap_create(&apawl, poolawl, MPS_RANK_WEAK),
"create ap(amc)");
cdie(mps_ap_create(&apamc, poolamc, MPS_RANK_EXACT),
"create ap(awl)");
cdie(mps_ap_create(&aplo, poollo, MPS_RANK_EXACT),
"create ap");
mps_message_type_enable(arena, mps_message_type_finalization());
/* register loads of objects for finalization (1000*4) */
a = allocone(apamc, 2, 1);
b = a;
for (j=0; j<1000; j++) {
a = allocone(apamc, 2, MPS_RANK_EXACT);
c = allocone(apawl, 2, MPS_RANK_WEAK);
d = allocone(aplo, 2, MPS_RANK_EXACT); /* rank irrelevant here! */
mps_finalize(arena, (mps_addr_t*)&a);
mps_finalize(arena, (mps_addr_t*)&c);
mps_finalize(arena, (mps_addr_t*)&d);
mps_finalize(arena, (mps_addr_t*)&d);
final_count += 4;
}
/* throw them all away and collect everything */
a = NULL;
b = NULL;
c = NULL;
d = NULL;
mps_root_destroy(root0);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_arena_collect(arena);
while(mps_message_poll(arena) == 0) {
a = allocdumb(apawl, 1024, MPS_RANK_WEAK);
a = allocdumb(apamc, 1024, MPS_RANK_EXACT);
a = allocdumb(aplo, 1024, MPS_RANK_EXACT);
mps_arena_collect(arena);
}
/* how many are left? (n.b. ideally this would be 0 but
there's no guarantee)
*/
/* now to test leaving messages open for a long time! */
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_pool_destroy(poollo);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void *stack_pointer)
{
mps_pool_t poolamc, poolawl, poollo;
mps_thr_t thread;
mps_root_t root0, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl, aplo;
mycell *a, *b, *c, *d, *z;
long int i,j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)1024*1024*30),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_thread(&root0, arena, thread, stack_pointer), "thread root");
cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0,
(mps_addr_t*)&exfmt_root, 1),
"create table root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool(awl)");
cdie(mmqa_pool_create_chain(&poollo, arena, mps_class_amcz(), format, chain),
"create pool(amcz)");
cdie(mps_ap_create(&apawl, poolawl, mps_rank_weak()),
"create ap(awl)");
cdie(mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap(amc)");
cdie(mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap(amcz)");
mps_message_type_enable(arena, mps_message_type_finalization());
/* register loads of objects for finalization (1000*4) */
a = allocone(apamc, 2, 1);
b = a;
for (j=0; j<1000; j++) {
a = allocone(apamc, 2, mps_rank_exact());
c = allocone(apawl, 2, mps_rank_weak());
d = allocone(aplo, 2, mps_rank_exact()); /* rank irrelevant here! */
mps_finalize(arena, (mps_addr_t*)&a);
mps_finalize(arena, (mps_addr_t*)&c);
mps_finalize(arena, (mps_addr_t*)&d);
mps_finalize(arena, (mps_addr_t*)&d);
final_count += 4;
}
/* throw them all away and collect everything */
comment("b = %p", b); /* suppress compiler warning about unused b */
a = NULL;
b = NULL;
c = NULL;
d = NULL;
mps_root_destroy(root0);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_arena_collect(arena);
i = 0;
while (final_count != 0 && i < 10) {
finalpoll(&z, FINAL_DISCARD);
if (mps_message_poll(arena) == 0) {
i++;
a = allocdumb(apawl, 1024, mps_rank_weak());
a = allocdumb(apamc, 1024, mps_rank_exact());
a = allocdumb(aplo, 1024, mps_rank_exact());
mps_arena_collect(arena);
comment(" %i", final_count);
}
}
/* how many are left? (Ideally, this would be 0 but there's no guarantee.) */
report("count", "%i", final_count);
report("iter", "%i", i);
/* now to test leaving messages open for a long time! */
mps_arena_park(arena);
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_pool_destroy(poollo);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void *test(void *arg, size_t s)
{
unsigned 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");
cdie(0 == mps_message_clock(arena, message),
"message clock should be 0 (unset) for finalization messages");
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;
}
static void *test(void *arg, size_t s)
{
mps_ap_t ap;
mps_fmt_t fmt;
mps_chain_t chain;
mps_word_t finals;
mps_pool_t amc;
mps_root_t mps_root;
mps_arena_t arena;
mps_message_t message;
size_t i;
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, arena, mps_rank_exact(), (mps_rm_t)0,
root, (size_t)rootCOUNT),
"root_create\n");
die(mps_ap_create(&ap, amc, mps_rank_exact()), "ap_create\n");
mps_message_type_enable(arena, mps_message_type_finalization());
mps_arena_park(arena);
object_count = 0;
printf("Making some finalized trees of objects.\n");
/* make some trees */
for(i = 0; i < rootCOUNT; ++i) {
root[i] = (void *)make_numbered_tree(maxtreeDEPTH, ap);
register_numbered_tree((mps_word_t)root[i], arena);
}
mps_arena_unsafe_expose_remember_protection(arena);
mps_arena_unsafe_restore_protection(arena);
printf("Losing all pointers to the trees.\n");
/* clean out the roots */
for(i = 0; i < rootCOUNT; ++i) {
root[i] = 0;
}
finals = 0;
while ((finals < object_count) &&
(mps_collections(arena) < collectionCOUNT)) {
mps_word_t final_this_time = 0;
printf("Collecting...");
(void)fflush(stdout);
die(mps_arena_collect(arena), "collect");
printf(" Done.\n");
while (mps_message_poll(arena)) {
mps_word_t obj;
mps_addr_t objaddr;
cdie(mps_message_get(&message, arena,
mps_message_type_finalization()),
"get");
mps_message_finalization_ref(&objaddr, arena, message);
obj = (mps_word_t)objaddr;
mps_message_discard(arena, message);
++ final_this_time;
testlib_unused(obj);
}
finals += final_this_time;
printf("%"PRIuLONGEST" objects finalized: total %"PRIuLONGEST
" of %"PRIuLONGEST"\n",
(ulongest_t)final_this_time, (ulongest_t)finals,
(ulongest_t)object_count);
}
object_count = 0;
printf("Making some indirectly finalized trees of objects.\n");
/* make some trees */
for(i = 0; i < rootCOUNT; ++i) {
root[i] = (void *)make_indirect_tree(maxtreeDEPTH, ap);
register_indirect_tree((mps_word_t)root[i], arena);
}
printf("Losing all pointers to the trees.\n");
/* clean out the roots */
for(i = 0; i < rootCOUNT; ++i) {
root[i] = 0;
}
finals = 0;
while ((finals < object_count) &&
(mps_collections(arena) < collectionCOUNT)) {
mps_word_t final_this_time = 0;
printf("Collecting...");
(void)fflush(stdout);
die(mps_arena_collect(arena), "collect");
printf(" Done.\n");
while (mps_message_poll(arena)) {
mps_word_t obj;
mps_addr_t objaddr;
cdie(mps_message_get(&message, arena,
mps_message_type_finalization()),
"get");
mps_message_finalization_ref(&objaddr, arena, message);
obj = (mps_word_t)objaddr;
mps_message_discard(arena, message);
++ final_this_time;
testlib_unused(obj);
}
finals += final_this_time;
printf("%"PRIuLONGEST" objects finalized: total %"PRIuLONGEST
" of %"PRIuLONGEST"\n",
(ulongest_t)final_this_time, (ulongest_t)finals,
(ulongest_t)object_count);
}
mps_ap_destroy(ap);
mps_root_destroy(mps_root);
mps_pool_destroy(amc);
mps_chain_destroy(chain);
mps_fmt_destroy(fmt);
return NULL;
}
static void test(void)
{
mps_pool_t poolamc, poolawl, poollo;
mps_thr_t thread;
mps_root_t root0, root1;
mps_chain_t chain;
mps_fmt_t format;
mps_ap_t apamc, apawl, aplo;
mycell *a, *b, *c, *d, *z;
long int j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)(1024*1024*40)),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root0, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0,
(mps_addr_t *)&exfmt_root, 1),
"create table root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool(amc)");
die(mmqa_pool_create_chain(&poollo, arena, mps_class_amcz(), format, chain),
"create pool(amcz)");
cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool(awl)");
cdie(mps_ap_create(&apawl, poolawl, mps_rank_weak()),
"create ap(awl)");
cdie(mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap(amc)");
cdie(mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap(amcz)");
mps_message_type_enable(arena, mps_message_type_finalization());
mps_message_type_enable(arena, mps_message_type_gc());
/* register loads of objects for finalization (1000*4) */
a = allocone(apamc, 2, 1);
for (j=0; j<1000; j++) {
b = allocone(apamc, 2, mps_rank_exact());
c = allocone(apawl, 2, mps_rank_weak());
d = allocone(aplo, 2, mps_rank_exact()); /* rank irrelevant here! */
mps_finalize(arena, (mps_addr_t*)&b);
mps_finalize(arena, (mps_addr_t*)&c);
mps_finalize(arena, (mps_addr_t*)&d);
mps_finalize(arena, (mps_addr_t*)&d);
final_count += 4;
setref(a, 0, b);
setref(a, 1, c);
setref(c, 1, d);
a = b;
}
/* throw them all away and collect everything */
a = NULL;
b = NULL;
c = NULL;
d = NULL;
exfmt_root = NULL;
for (j=0; j<5; j++) {
mps_arena_collect(arena);
while (mps_message_poll(arena)) {
messagepoll(&z, FINAL_DISCARD);
}
}
/* how many are left? (n.b. ideally this would be 0 but
there's no guarantee)
*/
report("count1", "%i", final_count);
/* now to test leaving messages open for a long time! */
for (j=0; j<10; j++) {
comment("%d of 10", j);
a = allocone(apamc, 10000, mps_rank_exact());
mps_finalize(arena, (mps_addr_t*)&a);
final_count +=1;
comment("finalize");
messagepoll(&z, FINAL_QUEUE);
}
comment("reregister");
for (j=0; j<10; j++) {
comment("%d of 10", j);
qpoll(&z, FINAL_REREGISTER);
}
b = a;
z = a;
for (j=0; j<10; j++) {
comment("%d of 10", j);
messagepoll(&z, FINAL_QUEUE);
qpoll(&z, FINAL_STORE);
a = allocone(apamc, 2, mps_rank_exact());
setref(z, 0, b);
setref(a, 1, z);
b = a;
}
for (j=0; j<10; j++) {
a = allocone(apamc, 2, mps_rank_exact());
qpoll(&z, FINAL_DISCARD);
messagepoll(&z, FINAL_DISCARD);
setref(a, 0, b);
b = a;
}
/* Force old objects to be killed */
while (qmt() == 0) {
qpoll(&z, FINAL_DISCARD);
}
while (mps_message_poll(arena)) {
messagepoll(&z, FINAL_DISCARD);
}
mps_arena_park(arena);
mps_root_destroy(root0);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
comment("Destroyed aps.");
mps_arena_collect(arena);
comment("Collected arena.");
while (mps_message_poll(arena)) {
messagepoll(&z, FINAL_DISCARD);
}
report("count2", "%d", final_count);
mps_arena_park(arena);
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_pool_destroy(poollo);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
