static void tracegraph(mycell *obj)
{
int i;
if (obj == NULL) {
return;
}
asserts((obj->tag & 3) == MCdata, "odd check at %p (%p)", obj, obj->tag);
if (obj->data.checkedflag == oldstamp) {
obj->data.checkedflag = newstamp;
if (obj->data.assoc != NULL) {
tracegraph(obj->data.assoc);
}
for (i=0; i<(obj->data.numrefs); i++) {
if (obj->data.ref[i].addr != NULL) {
tracegraph(obj->data.ref[i].addr);
}
}
} else {
asserts(obj->data.checkedflag == newstamp,
"I. trace on old object at %p", obj);
}
}
static void test(void)
{
mycell *a[4], /* a is a table of exact roots */
*b[4]; /* b is a table of ambiguous roots */
int i, j, k;
mps_chain_t chain;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_table(&root, arena, mps_rank_exact(), 0,
(mps_addr_t *)&a[0], 4),
"create a root table");
cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0,
(mps_addr_t *)&b[0], 4),
"create b root table");
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)");
die(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool(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)");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap(awl)");
newstamp = 0;
for (i=0; i<4; i++) {
die(allocrdumb(&a[i], aplo, 64, mps_rank_exact()), "alloc failed");
a[i]->data.checkedflag = newstamp;
die(allocrone(&b[i], apawl, 5, mps_rank_exact()), "alloc failed");
b[i]->data.checkedflag = newstamp;
b[i]->data.ref[0].addr = a[i];
die(allocrone(&a[i], apamc, 5, mps_rank_exact()), "alloc failed");
a[i]->data.checkedflag = newstamp;
a[i]->data.ref[0].addr = b[i];
}
for (j=0; j<100; j++) {
comment("%i of 100", j);
for (i=0; i<10000; i++) {
k = ranint(4);
die(allocrdumb(&a[k], aplo, 64, mps_rank_exact()), "alloc failed");
a[k]->data.checkedflag = newstamp;
k = ranint(4);
die(allocrone(&b[k], apawl, 5, mps_rank_exact()), "alloc failed");
b[k]->data.checkedflag = newstamp;
b[k]->data.ref[0].addr = a[ranint(4)];
b[k]->data.ref[1].addr = b[ranint(4)];
die(allocrone(&a[k], apamc, 5, mps_rank_exact()), "alloc failed");
a[k]->data.checkedflag = newstamp;
a[k]->data.ref[2].addr = b[ranint(4)];
}
comment("walking...");
mps_arena_park(arena);
mps_arena_collect(arena);
oldstamp = newstamp;
newstamp += 1;
mps_arena_formatted_objects_walk(arena, stepper,
(void *)MAGICPOINT, MAGICSIZE);
mps_arena_release(arena);
comment("tracing...");
oldstamp = newstamp;
newstamp += 1;
tracegraph((mycell *) exfmt_root);
tracegraph(a[0]);
tracegraph(a[1]);
tracegraph(a[2]);
tracegraph(a[3]);
tracegraph(b[0]);
tracegraph(b[1]);
tracegraph(b[2]);
tracegraph(b[3]);
comment("ok");
}
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
mps_ap_destroy(apawl);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_root_destroy(root1);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
/* a is a table of exact roots
b a table of ambiguous roots
f a table of non-roots
*/
mycell *a[4], *b[4], *f[4];
mps_addr_t addr;
int i, j, k;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
addr = &a[0];
cdie(
mps_root_create_table(&root, arena, mps_rank_exact(), 0, addr, 4),
"create a root table");
addr = &b[0];
cdie(
mps_root_create_table(&root1, arena, mps_rank_ambig(), 0, addr, 4),
"create b root table");
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(
mps_pool_create(&poolamc, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool");
cdie(
mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap");
newstamp = 0;
for (i=0; i<4; i++) {
addr = &a[i];
die(allocrdumb(addr, aplo, 64, mps_rank_exact()), "alloc failed");
addr = &b[i];
die(allocrone(addr, apawl, 5, mps_rank_exact()), "alloc failed");
b[i]->data.ref[0].addr = a[i];
addr = &a[i];
die(allocrone(addr, apamc, 5, mps_rank_exact()), "alloc failed");
a[i]->data.ref[0].addr = b[i];
}
for (j=0; j<100; j++) {
comment("%i of 100", j);
for (i=0; i<10000; i++) {
k = ranint(4);
addr = &a[k];
die(allocrdumb(addr, aplo, 64, mps_rank_exact()), "alloc failed");
k = ranint(4);
addr = &b[k];
die(allocrone(addr, apawl, 5, mps_rank_exact()), "alloc failed");
b[k]->data.ref[0].addr = a[ranint(4)];
b[k]->data.ref[1].addr = b[ranint(4)];
addr = &a[k];
die(allocrone(addr, apamc, 5, mps_rank_exact()), "alloc failed");
f[k] = a[k]->data.ref[2].addr;
a[k]->data.ref[2].addr = b[ranint(4)];
}
comment("walking...");
mps_arena_park(arena);
mps_arena_collect(arena);
oldstamp = newstamp;
newstamp += 1;
mps_arena_formatted_objects_walk(arena, stepper,
(void *) MAGICPOINT, MAGICSIZE);
mps_arena_release(arena);
comment("tracing...");
oldstamp = newstamp;
newstamp += 1;
tracegraph((mycell *) exfmt_root);
tracegraph(a[0]);
tracegraph(a[1]);
tracegraph(a[2]);
tracegraph(a[3]);
tracegraph(b[0]);
tracegraph(b[1]);
tracegraph(b[2]);
tracegraph(b[3]);
comment("f[0] = %p", f[0]); /* avoid compiler warning about used f */
comment("ok");
}
mps_arena_park(arena);
mps_ap_destroy(apamc);
mps_ap_destroy(aplo);
mps_ap_destroy(apawl);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_chain_destroy(chain);
comment("Destroyed chain.");
mps_root_destroy(root);
mps_root_destroy(root1);
comment("Destroyed roots.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}