static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_fmt_t format;
mps_ap_t ap;
mps_addr_t p;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena");
cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
cdie(mps_pool_create_k(&pool, arena, mps_class_ams(), args),
"create pool");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_RANK, mps_rank_weak());
cdie(mps_ap_create_k(&ap, pool, args), "create ap");
} MPS_ARGS_END(args);
do {
cdie(mps_reserve(&p, ap, 0x100), "Reserve: ");
} while (!mps_commit(ap, p, 0x100));
comment("Committed.");
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
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)
{
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, getassociated),
"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)
{
mps_arena_t arena;
mps_pool_t poolamc, poolawl;
mps_thr_t thread;
mps_root_t root, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl;
size_t size0, size1;
mycell *a, *b, *c, *d, *e, *f, *g;
int i;
int j;
RC;
deathcomments = 0;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_reg(&root, 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, &exfmt_root, 1),
"create exfmt root");
die(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");
cdie(
mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_weak()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
b = allocone(apamc, 1, 1);
for (j=1; j<10; j++) {
comment("%i of 10.", j);
a = allocone(apawl, 5, 1);
setref(b, 0, a);
b = a;
c = a;
d = a;
e = a;
f = a;
g = a;
for (i=1; i<1000; i++) {
if (i%100 == 0) {
comment(" %i", i);
}
if (ranint(2)) {
c = allocone(apamc, 1000, 1);
} else {
c = allocone(apawl, 1000, 1);
}
if (ranint(8) == 0) d = c;
if (ranint(8) == 0) e = c;
if (ranint(8) == 0) f = c;
if (ranint(8) == 0) g = c;
setref(b, 0, c);
setref(c, 1, d);
setref(c, 2, e);
setref(c, 3, f);
setref(c, 4, g);
b = c;
}
if (j==3) {
DC;
comment("...collecting:");
RC;
size0 = arena_committed_and_used(arena);
mps_arena_collect(arena);
size1 = arena_committed_and_used(arena);
report("sizebefore0", "%lu", (unsigned long) size0);
report("sizeafter0", "%lu", (unsigned long) size1);
report("diff0", "%lu", (unsigned long) size0-size1);
DC;
mps_arena_release(arena);
comment("...released");
}
DC;
comment("clamping...");
mps_arena_park(arena);
RC;
for (i=1; i<1000; i++) {
if (i%100 == 0) {
comment(" %i", i);
}
if (ranint(2)) {
c = allocone(apamc, 1000, 1);
} else {
c = allocone(apawl, 1000, 1);
}
if (ranint(8) == 0) d = c;
if (ranint(8) == 0) e = c;
if (ranint(8) == 0) f = c;
if (ranint(8) == 0) g = c;
setref(b, 0, c);
setref(c, 1, d);
setref(c, 2, e);
setref(c, 3, f);
setref(c, 4, g);
b = c;
}
asserts(counters[COPY_COUNT]==0, "Eppur si muove!");
DC;
if (j==9) {
comment("collecting...");
size0 = arena_committed_and_used(arena);
mps_arena_collect(arena);
size1 = arena_committed_and_used(arena);
report("sizebefore1", "%lu", (unsigned long) size0);
report("sizeafter1", "%lu", (unsigned long) size1);
report("diff1", "%lu", (unsigned long) size0-size1);
DC;
}
mps_arena_release(arena);
comment("released.");
RC;
}
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
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)
{
mps_arena_t arena;
mps_pool_t poolamc, poolawl;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl, apweak;
mycell *a, *b;
RC;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
die(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, getassociated),
"create pool(awl)");
cdie(mps_ap_create(&apweak, poolawl, mps_rank_weak()),
"create ap(weak)");
cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap(awl)");
cdie(mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap(amc)");
b = allocone(apamc, 1, mps_rank_exact());
a = allocone(apweak, 1, mps_rank_weak());
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(apweak);
comment("Destroyed aps.");
/* buffered segments aren't condemned! */
setref(a, 0, b);
mps_arena_collect(arena);
asserts(getref(a, 0) == b, "Reference changed or was splatted.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t poolamc, poolawl;
mps_thr_t thread;
mps_root_t root, rootb;
mps_addr_t base;
mps_addr_t *addr;
mps_chain_t chain;
mps_fmt_t format;
mps_ap_t apamc, apawl;
mps_word_t i, c;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (60ul*1024*1024)), "create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
base = &b;
addr = base;
cdie(mps_root_create_table(&root, arena, mps_rank_ambig(), 0, addr, 1),
"creat root");
base = &exfmt_root;
addr = base;
cdie(mps_root_create_table(&rootb, arena, mps_rank_ambig(), 0, addr, 1),
"create root b");
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(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_weak()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
formatcomments = 0;
b = allocone(apamc, 1024, mps_rank_exact());
c = mps_collections(arena);
for (i=1; i<100; i++)
{
comment("%i of 100.", i);
while (mps_collections(arena) == c) {
a = allocone(apamc, 1024, mps_rank_exact());
if (ranint(5)) {
setref(a, 0, b);
}
b = a;
}
c = mps_collections(arena);
a = allocone(apawl, 1, mps_rank_weak());
a->data.id = 0;
setref(a, 0, b);
}
mps_arena_park(arena);
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
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(rootb);
comment("Destroyed roots.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
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.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t poolamc, poolawl;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl, apweak;
mycell *a, *b, *c, *d, *e, *f, *g;
int i;
int j;
RC;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
die(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");
cdie(
mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create pool");
cdie(
mps_ap_create(&apweak, poolawl, mps_rank_weak()),
"create ap");
cdie(
mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
b = allocone(apamc, 1, 1);
for (j=1; j<10; j++) {
comment("%i of 10.", j);
UC;
a = allocone(apawl, 5, mps_rank_exact());
setref(b, 0, a);
b = a;
c = a;
d = a;
e = a;
f = a;
g = a;
for (i=1; i<1000; i++) {
UC;
if (ranint(3) == 0) {
c = allocone(apawl, 500, mps_rank_exact());
} else if (ranint(2) == 0) {
c = allocone(apweak, 500, mps_rank_weak());
} else {
c = allocone(apamc, 500, mps_rank_exact());
}
if (ranint(8) == 0) d = c;
if (ranint(8) == 0) e = c;
if (ranint(8) == 0) f = c;
if (ranint(8) == 0) g = c;
UC;
setref(b, 0, c);
UC;
setref(c, 1, d);
UC;
setref(c, 2, e);
UC;
setref(c, 3, f);
UC;
setref(c, 4, g);
UC;
b = c;
}
DC;
DMC;
}
mps_arena_park(arena);
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_ap_destroy(apweak);
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
