static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
locell *a,*b,*c,*z;
int i;
alloclocomments = 0;
allowlocopies = 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");
die(mps_fmt_create_A(&format, arena, &fmtLO), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mmqa_pool_create_chain(&pool, arena, mps_class_amcz(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
a = string_ch("Hello there");
b = string_ch("Wibble wobble foo");
c = string_ch("Ba ");
for (i=0; i<10000; i++) {
a = conc(string_ch("B"), a);
c = conc(string_ch("Hello there"), string_ch(" folks!"));
z = alloclo(ap, 0x4000);
}
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *a;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(
mps_root_create_reg(&root, arena, MPS_RANK_AMBIG, 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, MPS_RANK_EXACT),
"create ap");
a = allocdumb(ap, 1024*1024*80);
mps_ap_destroy(ap);
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_ap_t ap;
mps_fmt_t format;
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_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain),
"create pool");
die(mps_ap_create(&ap, pool, mps_rank_exact()), "create ap");
while (mps_collections(arena) == 0) {
allocdumb(ap, 1024*256);
}
mps_ap_destroy(ap);
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
}
static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_root_t root2;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *z[100];
int i;
formatcomments = 1;
RC;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_table_masked(&root, arena, mps_rank_exact(),
0, (mps_addr_t*)&z[0], 100, 0x4),
"create table root");
die(mps_root_create_table(&root2, 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(&pool, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
for (i=0; i<100; i++) {
comment("%i of 10.", i);
UC;
z[i] = allocone(ap, 1, 1);
if (i % 8 == 0) { z[i] = (mycell *) ((mps_word_t)z[i] + 4); } /* error to scan this! */
}
for (i=0; i<1000; i++) {
z[0] = allocone(ap, 1000, 0);
}
DC;
DMC;
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_root_destroy(root2);
comment("Destroyed roots.");
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),
"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;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl;
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(amc)");
cdie(
mps_ap_create(&apawl, poolamc, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap(amc)");
b = allocone(apamc, 1, 1);
for (j = 1; j < 100; j++) {
comment("%i of 100.", j);
UC;
a = allocone(apamc, 5, 1);
b = a;
c = a;
d = a;
e = a;
f = a;
g = a;
for (i = 1; i < 5000; i++) {
UC;
c = allocone(apamc, 20, 1);
d = allocone(apawl, 20, 1);
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_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_pool_destroy(poolamc);
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_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_arena_t arena;
mps_pool_t poolamc, poolawl;
mps_thr_t thread;
mps_root_t root, root1, root2;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, apawl;
mycell *a[3];
int j;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
die(mps_thread_reg(&thread, arena), "register thread");
die(mps_root_create_table(&root, arena, mps_rank_exact(), 0,
(mps_addr_t*)&a[0], 2),
"create table root");
cdie(
mps_root_create_table(&root2, arena, mps_rank_ambig(), 0, (mps_addr_t*)&a[2], 1),
"ambig table 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_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
a[1] = allocone(apawl, 2, 1);
a[0] = allocone(apawl, 2, 1);
a[2] = allocone(apamc, 2, 1);
setref(a[0], 0, a[2]);
mps_ap_destroy(apawl);
comment("Destroyed awl ap");
for(j=0; j<100; j++) {
allocdumb(apamc, 1024*256, 1);
}
mps_ap_destroy(apamc);
comment("Destroyed amc ap.");
mps_root_destroy(root1);
mps_root_destroy(root2);
comment("Destroyed ambiguous roots.");
a[1] = a[0];
comment("Now to try arena_collect:");
mps_arena_collect(arena);
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)
{
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap, ap2;
mycell *a, *b;
mps_res_t res;
int i;
/* create an arena that can't grow beyond 30 M */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*40)),
"create arena");
mps_arena_commit_limit_set(arena, (size_t) (1024*1024*30));
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create 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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
/* allocate until full */
i = 0;
b = NULL;
while (allocrone(&a, ap, 128, mps_rank_exact()) == MPS_RES_OK) {
i++;
setref(a, 0, b);
b = a;
}
comment("%d objs allocated.", i);
report("committed", "%ld", mps_arena_committed(arena));
/* try to allocate 10 times */
cdie(mps_ap_create(&ap2, pool, mps_rank_exact()), "create second ap");
mps_ap_destroy(ap);
for (i = 0; i < 10; i++) {
res = allocrone(&a, ap2, 128, mps_rank_exact());
report("predie", "%s", err_text(res));
}
/* now let everything die, and try to allocate 10 times */
mps_root_destroy(root);
for (i = 0; i < 10; i++) {
res = allocrone(&a, ap2, 128, mps_rank_exact());
report("postdie", "%s", err_text(res));
}
mps_ap_destroy(ap2);
mps_pool_destroy(pool);
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;
mycell *a, *b, *c;
int i;
alloccomments = 1;
fixcomments = 1;
deathcomments = 1;
formatcomments = 1;
fixcomments = 1;
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(&apawl, poolawl, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
a = allocone(apawl, 1, 1);
b = allocone(apawl, 1, 1);
c = allocone(apawl, 1000, 1);
setref(b, 0, c);
setref(c, 0, b);
for(i=0; i<1000; i++) {
b = allocdumb(apamc, 0x400*1024, 0);
if (i % 50 == 0)
comment("%d of 1000.", i);
}
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");
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)
{
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, apran;
mycell *a[100], *c;
int i;
int j;
int k,z;
alloccomments = 1;
skipcomments = 1;
formatcomments = 1;
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),
"create pool");
cdie(
mps_ap_create(&apawl, poolawl, MPS_RANK_EXACT),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, MPS_RANK_EXACT),
"create ap");
for(i=0; i<100; i++) {
a[i] = allocone(apamc, 6, 1);
}
for(i=0; i<10000; i++) {
j = ranint(100);
k = 5 + ranint(500);
if (ranint(2)==1) {
apran = apawl;
} else {
apran = apamc;
}
c = a[j];
a[j] = allocone(apran, k, 1);
k = ranint(100);
z = ranint(2);
setref(a[k], 0, c);
setref(a[j], z, a[k]);
}
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_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mycell *cells;
int h,i,j,k,l;
mycell *pobj;
size_t bytes;
size_t alignment;
mps_addr_t q;
int nextid = 0x1000000;
/* turn on comments about copying and scanning */
formatcomments = BLAH;
fixcomments = BLAH;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root, arena, MPS_RANK_AMBIG, 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain),
"create pool");
for (i=0; i<NAPS; i++) {
die(mps_ap_create(&ap[i], pool, MPS_RANK_EXACT), "create ap");
ap_state[i] = 0;
}
cells = allocone(ap[0], NCELLS);
/* ap_state can have the following values:
0 before reserve
1 after reverse
2 after init
3 after I=A
0 after commit
*/
for(h=0; h<100; h++) {
comment("%i of 100", h);
for(j=0; j<1000; j++) {
i = ranint(NAPS);
switch (ap_state[i]) {
case 0:
nrefs[i] = NUMREFS;
bytes = offsetof(struct data, ref)+nrefs[i]*sizeof(struct refitem);
alignment = MPS_PF_ALIGN;
bytes = (bytes+alignment-1)&~(alignment-1);
s[i] = bytes;
die(mps_reserve(&q, ap[i], s[i]), "reserve: ");
p[i] = q;
p[i]->data.tag = 0xD033E2A6;
p[i]->data.id = nextid;
ap_state[i] = 1;
commentif(BLAH, "%i: reserve %li at %p", i, nextid, q);
nextid +=1;
break;
case 1:
commentif(BLAH, "%i: init %li", i, p[i]->data.id);
p[i]->data.tag = MCdata;
p[i]->data.numrefs = nrefs[i];
p[i]->data.size = s[i];
ap_state[i] = 2;
for (k=0; k<nrefs[i]; k++) {
if PNULL {
p[i]->data.ref[k].addr = NULL;
p[i]->data.ref[k].id = 0;
} else {
l = ranint(NCELLS);
pobj = getref(cells, l);
p[i]->data.ref[k].addr = pobj;
p[i]->data.ref[k].id = (pobj==NULL ? 0 : pobj->data.id);
}
commentif(BLAH, " ref %i -> %li", k, p[i]->data.ref[k].id);
}
break;
case 2:
commentif(BLAH, "%i: begin commit %li", i, p[i]->data.id);
ap[i]->init = ap[i]->alloc;
ap_state[i] = 3;
break;
case 3:
commentif(BLAH, "%i: end commit %li", i, p[i]->data.id);
q = p[i];
if (ap[i]->limit != 0 || mps_ap_trip(ap[i], p[i], s[i])) {
l = ranint(NCELLS);
setref(cells, l, q);
commentif(BLAH, "%i -> %i", i, l);
}
ap_state[i] = 0;
break;
}
}
checkfrom(cells);
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *z[10];
mycell **a = &z[0];
mycell **b = &z[1];
mycell **c = &z[2];
mycell **d = &z[3];
mycell **e = &z[4];
mycell **f = &z[5];
mycell **g = &z[6];
int i;
int j;
RC;
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*)&z[0], 10),
"create table root");
die(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
for (j=1; j<100; j++)
{
comment("%i of 100.", j);
UC;
*a = allocone(ap, 5, 1);
*b = *a;
*c = *a;
*d = *a;
*e = *a;
*f = *a;
*g = *a;
for (i=1; i<1000; i++)
{
UC;
*c = allocone(ap, 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;
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;
}
checkfrom(*a);
}
DC;
DMC;
checkfrom(*a);
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *b;
/* create an arena that can't grow beyond 1 Mb */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*1)),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(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,
(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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
comment("ready");
comment("reserved %ld, committed %ld",
mps_arena_reserved(arena), mps_arena_committed(arena));
b = allocdumb(ap, 1024ul*1024ul*40, mps_rank_exact());
comment("alloc 40 MB");
comment("reserved %ld, committed %ld",
mps_arena_reserved(arena), mps_arena_committed(arena));
b = allocdumb(ap, 1024ul*1024ul*40, mps_rank_exact());
comment("alloc 80 MB");
comment("reserved %ld, committed %ld",
mps_arena_reserved(arena), mps_arena_committed(arena));
mps_arena_collect(arena);
comment("collected");
comment("reserved %ld, committed %ld",
mps_arena_reserved(arena), mps_arena_committed(arena));
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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 pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mycell *cells;
int h,i,j,k,l;
mycell *pobj;
mycell *ambig[NAPS];
size_t size0, size1;
long mdiff = 0;
size_t bytes;
size_t alignment;
mps_addr_t q;
int nextid = 0x1000000;
/* turn on comments about copying and scanning */
formatcomments = VERBOSE;
fixcomments = VERBOSE;
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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
for (i = 0; i < NAPS; i++) {
die(mps_ap_create(&ap[i], pool, mps_rank_exact()), "create ap");
ap_state[i] = 0;
}
cells = allocone(ap[0], NCELLS);
/* ap_state can have the following values:
0 before reserve
1 after reverse
2 after init
3 after I=A
0 after commit
*/
for(h=0; h<ITERATIONS; h++) {
comment("%i of %i", h, ITERATIONS);
for(j=0; j<1000; j++) {
if (j == 500) {
size0 = mps_arena_committed(arena) - mps_arena_spare_committed(arena);
mps_arena_collect(arena);
size1 = mps_arena_committed(arena) - mps_arena_spare_committed(arena);
asserts(((long) size1)-((long) size0) < 1024*1024,
"Collection made arena bigger: %lu -> %lu",
(unsigned long) size0, (unsigned long) size1);
if (((long) size1)-((long) size0) > mdiff) {
mdiff = ((long) size1) - ((long) size0);
}
}
i = ranint(NAPS);
switch (ap_state[i]) {
case 0:
nrefs[i] = NUMREFS;
bytes = offsetof(struct data, ref)+nrefs[i]*sizeof(struct refitem);
alignment = MPS_PF_ALIGN;
bytes = (bytes+alignment-1)&~(alignment-1);
s[i] = bytes;
die(mps_reserve(&q, ap[i], s[i]), "reserve: ");
p[i] = q;
p[i]->data.tag = 0xD033E2A6;
p[i]->data.id = nextid;
ap_state[i] = 1;
commentif(VERBOSE, "%i: reserve %li at %p", i, nextid, q);
nextid +=1;
break;
case 1:
commentif(VERBOSE, "%i: init %li", i, p[i]->data.id);
p[i]->data.tag = MCdata;
p[i]->data.numrefs = nrefs[i];
p[i]->data.size = s[i];
ap_state[i] = 2;
for (k=0; k<nrefs[i]; k++) {
if PNULL {
p[i]->data.ref[k].addr = NULL;
p[i]->data.ref[k].id = 0;
} else {
l = ranint(NCELLS);
pobj = getref(cells, l);
p[i]->data.ref[k].addr = pobj;
p[i]->data.ref[k].id = (pobj==NULL ? 0 : pobj->data.id);
}
commentif(VERBOSE, " ref %i -> %li", k, p[i]->data.ref[k].id);
}
break;
case 2:
commentif(VERBOSE, "%i: begin commit %li", i, p[i]->data.id);
ambig[i] = p[i];
ap[i]->init = ap[i]->alloc;
ap_state[i] = 3;
break;
case 3:
commentif(VERBOSE, "%i: end commit %li", i, p[i]->data.id);
q=p[i];
if (ap[i]->limit != 0 || mps_ap_trip(ap[i], p[i], s[i])) {
l = ranint(NCELLS);
setref(cells, l, q);
commentif(VERBOSE, "%i -> %i", i, l);
}
ap_state[i] = 0;
ambig[i] = NULL;
break;
}
}
checkfrom(cells);
}
static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *a, *b;
int j;
/* create an arena that can't grow beyond 1 Mb */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*1)),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_thread(&root, 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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
comment("ready");
b = allocone(ap, 2, mps_rank_exact());
/* allocate lots of little objects */
for (;;) {
comment("reserved %ld, committed %ld",
mps_arena_reserved(arena), mps_arena_committed(arena));
if (mps_arena_committed(arena) > 1024ul*1024ul*10) {
break;
}
for (j=0; j<10000; j++) {
a = allocone(ap, 2, mps_rank_exact());
setref(a, 0, b);
b = a;
a = allocone(ap, 1, mps_rank_exact());
setref(b, 1, a);
}
mps_arena_collect(arena);
mps_arena_release(arena);
}
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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_pool_t poolmv, poolawl, poolamc;
mps_thr_t thread;
mps_root_t root0, root1, root2;
mps_addr_t p;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apawl, apamc;
mycell *a, *b;
int i,j;
RC;
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_table(&root0, arena, mps_rank_ambig(), 0,
(mps_addr_t*)&exfmt_root, 1),
"create exfmt root");
cdie(mps_root_create_table(&root2, arena, mps_rank_exact(), 0,
(mps_addr_t *)obj_table, MAXLDS),
"create table root");
cdie(mps_root_create_reg(&root1, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create register and stack root");
cdie(mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated),
"create awl pool");
cdie(mps_pool_create(&poolmv, arena, mps_class_mv(), 0x4000, 128, 0x4000),
"create mv pool");
cdie(mps_ap_create(&apawl, poolawl, mps_rank_exact()),
"create ap");
/* First we'll use only pool classes MV and AWL. So LDs shouldn't */
/* go stale at all. */
b = allocone(apawl, 5, mps_rank_exact());
for (i=0; i < MAXLDS; i++) {
comment("%d", i);
mps_alloc(&p, poolmv, sizeof(mps_ld_s));
a = allocone(apawl, 5, mps_rank_exact());
setref(a, 0, b);
b = a;
a = allocdumb(apawl, 256*1024, mps_rank_exact());
comment("alloc");
lds[i] = p;
mps_ld_reset(lds[i], arena);
comment("reset");
if (i>0) {
mps_ld_add(lds[i], arena, (mps_addr_t) b);
}
comment("add");
}
for (i=0; i < MAXLDS; i++) {
comment("%d", i);
asserts(mps_ld_isstale(lds[i], arena, p) == 0,
"%d stale but shouldn't be", i);
}
/* Then use AMC, so object do move and LDs go stale. */
die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
/* Allocate MAXLDS objects, and make each LD depend on the corresponding */
/* object. */
for (i=0; i < MAXLDS; i++) {
comment("%d", i);
obj_table[i] = allocone(apamc, ranint(100), mps_rank_exact());
mps_ld_add(lds[i], arena, (mps_addr_t) obj_table[i]);
}
for (i=0; i < 1000; i++) {
comment("%d of 1000", i);
checklds();
for (j=0; j < 8; j++) {
a = allocdumb(apamc, 32*1024, mps_rank_exact());
}
}
mps_ap_destroy(apawl);
mps_ap_destroy(apamc);
mps_pool_destroy(poolmv);
mps_pool_destroy(poolamc);
mps_pool_destroy(poolawl);
comment("Destroyed pools.");
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root0);
mps_root_destroy(root1);
mps_root_destroy(root2);
comment("Destroyed roots.");
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_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;
mps_thr_t thread;
mps_root_t root, root2, root3, root4, root5, root6, root7, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc;
typedef mycell * myroot;
myroot 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");
cdie(
mps_root_create_table(&root1, arena, mps_rank_exact(), 0, (mps_addr_t*)&a, 1),
"root");
cdie(
mps_root_create_table(&root2, arena, mps_rank_exact(), 0, (mps_addr_t*)&b, 1),
"root");
cdie(
mps_root_create_table(&root3, arena, mps_rank_exact(), 0, (mps_addr_t*)&c, 1),
"root");
cdie(
mps_root_create_table(&root4, arena, mps_rank_exact(), 0, (mps_addr_t*)&d, 1),
"root");
cdie(
mps_root_create_table(&root5, arena, mps_rank_exact(), 0, (mps_addr_t*)&e, 1),
"root");
cdie(
mps_root_create_table(&root6, arena, mps_rank_exact(), 0, (mps_addr_t*)&f, 1),
"root");
cdie(
mps_root_create_table(&root7, arena, mps_rank_exact(), 0, (mps_addr_t*)&g, 1),
"root");
cdie(
mps_root_create_table(&root, arena, mps_rank_exact(), 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_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
comment("parking...");
mps_arena_park(arena);
b = allocone(apamc, 1, 1);
for (j=1; j<10; j++) {
comment("%i of 10.", j);
a = allocone(apamc, 5, 1);
cutoff_id = getid(a);
b = a;
c = a;
d = a;
e = a;
f = a;
g = a;
for (i=1; i<1000; i++) {
c = allocone(apamc, 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(c, 0, b);
setref(c, 1, d);
setref(c, 2, e);
setref(c, 3, f);
setref(c, 4, g);
b = c;
}
for (i=1; i<1000; i++) {
c = allocone(apamc, 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(c, 0, b);
setref(c, 1, d);
setref(c, 2, e);
setref(c, 3, f);
setref(c, 4, g);
b = c;
}
a = c;
b = c;
d = c;
e = c;
f = c;
g = c;
exfmt_root = c;
mps_arena_collect(arena);
comment(" reserved: %lu", (unsigned long) mps_arena_reserved(arena));
comment("committed: %lu", (unsigned long) mps_arena_committed(arena));
comment("calling amc_apply:");
checkfrom(c);
appcount = 0;
apppadcount = 0;
junk_size = 0;
mps_amc_apply(poolamc, &test_apply, NULL, MAGICSIZE);
comment("finished amc_apply");
report("junksize", "%lu", (unsigned long) junk_size);
report("appcount", "%ld", appcount);
report("apppadcount", "%ld", apppadcount);
RC;
}
mps_arena_release(arena);
comment("released.");
mps_arena_park(arena);
mps_ap_destroy(apamc);
mps_pool_destroy(poolamc);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root);
mps_root_destroy(root1);
mps_root_destroy(root2);
mps_root_destroy(root3);
mps_root_destroy(root4);
mps_root_destroy(root5);
mps_root_destroy(root6);
mps_root_destroy(root7);
comment("Destroyed roots.");
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 poolMVFF, poolAMC;
mps_thr_t thread;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mps_res_t r;
mycell *a;
mps_addr_t p;
int i;
int s1, s2, s3;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
die(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
formatcomments = 0;
die(mmqa_pool_create_chain(&poolAMC, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, poolAMC, mps_rank_exact()),
"create ap");
comment("Sizes in megabytes:");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, EXTEND_BY);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, MEAN_SIZE);
cdie(mps_pool_create_k(&poolMVFF, arena, mps_class_mvff(), args),
"create MVFF pool");
} MPS_ARGS_END(args);
i = 0;
while ((r=mps_alloc(&p, poolMVFF, 1024*1024)) == 0) i++;
report("refuse1", "%s", err_text(r));
report("size1", "%i", i);
s1 = i;
mps_pool_destroy(poolMVFF);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, EXTEND_BY);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, MEAN_SIZE);
cdie(mps_pool_create_k(&poolMVFF, arena, mps_class_mvff(), args),
"create MVFF pool");
} MPS_ARGS_END(args);
i = 0;
while ((r=mps_alloc(&p, poolMVFF, 1024*1024)) == 0) i++;
report("refuse2", "%s", err_text(r));
report("size2", "%i", i);
s2 = i;
mps_pool_destroy(poolMVFF);
a = allocdumb(ap, 1024*1024*30); /* allocate 30 M object */
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, EXTEND_BY);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, MEAN_SIZE);
cdie(mps_pool_create_k(&poolMVFF, arena, mps_class_mvff(), args),
"create MVFF pool");
} MPS_ARGS_END(args);
i=0;
while ((r=mps_alloc(&p, poolMVFF, 1024*1024)) == 0) i++;
report("refuse3", "%s", err_text(r));
report("size3", "%i", i);
s3 = i;
report("diff12", "%i", s1-s2);
report("diff23", "%i", s2-s3);
for(i = 0; i < 10; i++) {
r = mps_alloc(&p, poolMVFF, 1024*1024);
report("refuse4", "%s", err_text(r));
}
mps_arena_park(arena);
mps_pool_destroy(poolMVFF);
mps_ap_destroy(ap);
mps_pool_destroy(poolAMC);
comment("Destroyed pool.");
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, poollo;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t apamc, aplo;
mycell *a[100];
int i;
int j;
int k,z;
alloccomments = 1;
formatcomments = 1;
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(amc)");
die(mps_pool_create(&poollo, arena, mps_class_lo(), format),
"create pool(lo)");
cdie(
mps_ap_create(&aplo, poollo, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
for(i=0; i<100; i++) {
a[i] = allocone(aplo, 6, 1);
}
for(i=0; i<10000; i++) {
j = ranint(100);
comment("New object %i", j);
a[j] = allocone(aplo, 5+ranint(50), 1);
k = ranint(50);
z = ranint(5);
comment("setting %i (%p) %i", k, a[k], z);
setref(a[k], z, a[j]);
(void)allocdumb(apamc, 0x400*64, 0);
}
mps_arena_park(arena);
mps_ap_destroy(aplo);
mps_ap_destroy(apamc);
comment("Destroyed aps.");
mps_pool_destroy(poolamc);
mps_pool_destroy(poollo);
comment("Destroyed pools.");
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)
{
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *a, *b;
mps_addr_t base, *addr;
mps_res_t res;
int j;
/* create an arena that can't grow beyond 30 M */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t) (1024*1024*30)),
"create arena");
die(mps_arena_commit_limit_set(arena, (size_t) (1024*1024*30)), "limit");
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");
base = &exfmt_root;
addr = base;
cdie(
mps_root_create_table(&root1,arena,mps_rank_ambig(),0,addr,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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
/* allocate 16 M of (live) stuff */
b = allocone(ap, 2, mps_rank_exact());
for (j=0; j<160; j++) {
a = allocone(ap, 2, mps_rank_exact());
setref(a, 0, b);
b = allocdumb(ap, 1024*100, mps_rank_exact());
setref(a, 1, b);
b = a;
}
comment("created 16M of live objects");
fillup();
comment("try to make collect by allocating another 1G...");
empty();
for (j=0; j<1000*1024; j++) {
res=allocrdumb(&a, ap, 1024, mps_rank_exact());
if (res == MPS_RES_OK) {
comment("%i ok", j);
} else {
break;
}
}
comment("collect world...");
for (j=0; j<10; j++) {
mps_arena_collect(arena);
}
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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, 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 pool;
mps_thr_t thread;
mps_root_t root, root1;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap;
mycell *a[3];
int i,j,k;
clock_t time0, time1;
formatcomments = 1;
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_table(&root, arena, mps_rank_ambig(), 0,
(mps_addr_t*)&a[0], 3),
"create table root");
cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0,
(mps_addr_t *)&exfmt_root, 1),
"exfmt 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(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
time0 = clock();
asserts(time0 != -1, "processor time not available");
for (k=0; k<100; k++) {
for (j=0; j<100; j++) {
a[0] = allocone(ap, 50, mps_rank_exact());
a[1] = a[0];
for (i=1; i<100; i++) {
a[2] = allocone(ap, 50, mps_rank_exact());
setref(a[1], 0, a[2]);
a[1] = a[2];
}
}
time1 = clock();
comment("%d: %i", k, (int) (100*(time1-time0)/CLOCKS_PER_SEC));
time0 = time1;
}
mps_ap_destroy(ap);
mps_pool_destroy(pool);
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)
{
int i;
mps_ap_t ap, sap;
mps_arena_t arena;
mps_fmt_t format;
mps_chain_t chain;
mps_pool_t pool, spool;
mps_thr_t thread;
mps_frame_t frame1;
mycell *p, *q;
size_t com, com1, com2;
formatcomments=1;
alloccomments=1;
fixcomments=1;
/* create an arena (no particular size limit) */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)ARENA_SIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
/* because we know objects in the stack pool don't move, */
/* we can do without roots. Hooray! */
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(&pool, arena, mps_class_amc(), format, chain),
"create pool(amc)");
cdie(mps_ap_create(&ap, pool, mps_rank_exact()), "create ap(amc)");
cdie(mps_pool_create(&spool, arena, mps_class_snc(), format),
"create SNC pool");
cdie(mps_ap_create(&sap, spool, mps_rank_exact()), "create ap");
/* push, alloc, check object is scanned */
com = arena_committed_and_used(arena);
report("com", "%ld", com);
cdie(mps_ap_frame_push(&frame1, sap), "push");
p = allocone(sap, 2, mps_rank_exact());
q = allocdumb(ap, BIGSIZE, mps_rank_exact());
setref(p, 0, q);
q = allocdumb(ap, SMALLSIZE, mps_rank_exact());
report("com", "%ld", arena_committed_and_used(arena));
comment("collect...");
mps_arena_collect(arena);
com1 = arena_committed_and_used(arena);
mps_arena_release(arena);
report("com", "%ld", com1);
report("inc1", "%d", (com1-com)/BIGSIZE);
/* pop, check object isn't scanned */
cdie(mps_ap_frame_pop(sap, frame1), "pop");
comment("collect...");
mps_arena_collect(arena);
com1 = arena_committed_and_used(arena);
mps_arena_release(arena);
report("com", "%ld", com1);
report("inc2", "%ld", (com1-com)/BIGSIZE);
/* check initial frame is scanned */
p = allocone(sap, 2, mps_rank_exact());
q = allocdumb(ap, BIGSIZE, mps_rank_exact());
setref(p, 1, q);
q = allocdumb(ap, SMALLSIZE, mps_rank_exact());
mps_arena_collect(arena);
com2 = arena_committed_and_used(arena);
mps_arena_release(arena);
report("inc3", "%ld", (com2-com1)/BIGSIZE);
/* even in ordinary collection */
for (i=0; i < 500; i++) {
q = allocdumb(ap, BIGSIZE, mps_rank_exact());
}
q = allocdumb(ap, SMALLSIZE, mps_rank_exact());
mps_arena_collect(arena);
com2 = arena_committed_and_used(arena);
mps_arena_release(arena);
report("inc4", "%ld", (com2-com1)/BIGSIZE);
mps_ap_destroy(ap);
mps_ap_destroy(sap);
mps_pool_destroy(pool);
mps_pool_destroy(spool);
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 poolamc1, poolamc2;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_chain_t chain;
mps_ap_t ap1, ap2;
mycell *a, *b;
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(&poolamc1, arena, mps_class_amc(), format, chain),
"create pool(1)");
die(mmqa_pool_create_chain(&poolamc2, arena, mps_class_amc(), format, chain),
"create pool(1)");
cdie(
mps_ap_create(&ap1, poolamc1, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&ap2, poolamc2, mps_rank_exact()),
"create ap");
for (j = 1; j < 100; j++) {
comment("%i of 100.", j);
for (i = 1; i < 10000; i++) {
UC;
a = allocone(ap1, 100, 1);
b = allocone(ap2, 100, 1);
setref(a, 0, b);
setref(b, 0, a);
UC;
}
DC;
DMC;
}
mps_arena_park(arena);
mps_ap_destroy(ap1);
mps_ap_destroy(ap2);
mps_pool_destroy(poolamc1);
mps_pool_destroy(poolamc2);
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)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_ap_t apA, apB;
mps_fmt_t format;
mps_chain_t chain;
mycell *ambigref;
size_t bytes;
size_t alignment;
mps_addr_t q;
int i;
formatcomments = 1;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE),
"create arena");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(mps_fmt_create_A(&format, arena, &fmtA), "create format");
cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain),
"create pool");
die(mps_ap_create(&apA, pool, mps_rank_exact()), "create apA");
die(mps_ap_create(&apB, pool, mps_rank_exact()), "create apB");
bytes = offsetof(struct data, ref) + sizeof(struct refitem);
alignment = MPS_PF_ALIGN;
bytes = (bytes+alignment-1)&~(alignment-1);
die(mps_reserve(&q, apB, bytes), "reserve: ");
comment("Reserve");
ambigref = q;
ambigref->data.tag = MCdata;
ambigref->data.id = MCerrorid;
ambigref->data.numrefs = 0;
ambigref->data.size = bytes;
comment("Midallocation");
for(i = 0; i < 40; i++) {
allocdumb(apA, 1024*256);
}
comment("Commit");
asserts(mps_commit(apB, q, bytes) == 0, "Commit succeeded!");
comment("Postallocation");
for(i = 0; i < 40; i++) {
allocdumb(apA, 1024*256);
}
comment("Finished");
mps_ap_destroy(apA);
mps_ap_destroy(apB);
mps_pool_destroy(pool);
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)
{
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)
{
mps_chain_t chain;
mycell *x;
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_table_masked(&root1, arena, mps_rank_exact(), 0,
(mps_addr_t*)&a[0], 4, 0x4),
"create a root table");
cdie(
mps_root_create_table(&root2, 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");
die(mmqa_pool_create_chain(&poollo, arena, mps_class_amcz(), format, chain),
"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;
alloccomments = 1;
die(allocrdumb(&a[0], aplo, 64, mps_rank_exact()), "alloc");
die(allocrdumb(&a[1], apamc, 64, mps_rank_exact()), "alloc");
die(allocrdumb(&a[3], apawl, 64, mps_rank_exact()), "alloc");
a[2] = (mycell *)((mps_word_t)a[3] | 4);
die(allocrdumb(&b[0], aplo, 64, mps_rank_exact()), "alloc");
die(allocrdumb(&b[1], apamc, 64, mps_rank_exact()), "alloc");
b[2] = NULL;
die(allocrdumb(&b[3], apawl, 64, mps_rank_exact()), "alloc");
rootcount = 0;
walkroots(NULL);
report("count1", "%ld", rootcount);
cdie(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, stackpointer, 0), "create stack root");
x = allocdumb(apamc, 64, mps_rank_exact());
(void)allocdumb(apamc, 64, mps_rank_exact());
(void)allocdumb(apamc, 64, mps_rank_exact());
rootcount = 0;
speccount = 0;
walkroots(x);
report("count2", "%ld", rootcount);
report("countspec", "%ld", speccount);
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_chain_destroy(chain);
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_root_destroy(root2);
mps_root_destroy(root1);
mps_root_destroy(root);
comment("Destroyed roots.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
