static void test(void *stack_pointer)
{
mps_arena_t arena;
mps_pool_t pool;
mps_addr_t block[ITERATIONS];
unsigned i;
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, CHUNKSIZE);
die(mps_arena_create_k(&arena, mps_arena_class_vm(), args), "arena_create");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_SPARE, 0);
die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args), "pool_create");
} MPS_ARGS_END(args);
check_chunks(arena, 1);
for (i = 0; i < ITERATIONS; ++i) {
die(mps_alloc(&block[i], pool, CHUNKSIZE), "mps_alloc");
check_chunks(arena, i + 2);
}
for (i = ITERATIONS; i > 0; --i) {
mps_free(pool, block[i - 1], CHUNKSIZE);
mps_arena_collect(arena); /* ensure ArenaCompact is called */
check_chunks(arena, i);
}
mps_pool_destroy(pool);
mps_arena_destroy(arena);
}
static void test(void *stack_pointer)
{
int j;
mps_ap_t ap;
mps_arena_t arena;
mps_fmt_t format;
mps_chain_t chain;
mps_pool_t pool;
mps_root_t root1;
mps_thr_t thread;
/* create an arena that can't grow beyond 30 MB */
cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)THIRTY_MEG),
"create arena");
cdie(mps_arena_commit_limit_set(arena, (size_t)THIRTY_MEG),
"commit limit set");
cdie(mps_thread_reg(&thread, arena), "register thread");
cdie(mps_root_create_table(&root1, arena, mps_rank_exact(), 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");
/* allocate a 16 MB live object */
allocdumb(ap, 16*MEG, mps_rank_exact());
comment("collect world...");
for (j=0; j<1000; 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(root1);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test_air(int interior, int stack)
{
size_t n_finalized = 0;
size_t i, j;
obj_t *s[OBJ_COUNT] = {0};
mps_root_t root = NULL;
if (!stack) {
mps_addr_t *p = (void *)s;
die(mps_root_create_table(&root, scheme_arena, mps_rank_ambig(), 0, p,
OBJ_COUNT), "mps_root_create_table");
}
mps_message_type_enable(scheme_arena, mps_message_type_finalization());
for (j = 0; j < OBJ_COUNT; ++j) {
obj_t n = scheme_make_integer(obj_ap, (long)j);
obj_t obj = scheme_make_vector(obj_ap, OBJ_LEN, n);
mps_addr_t ref = obj;
mps_finalize(scheme_arena, &ref);
s[j] = obj->vector.vector;
}
for (i = 1; i < OBJ_LEN; ++i) {
obj_t n = scheme_make_integer(obj_ap, (long)i);
mps_message_t msg;
for (j = 0; j + 1 < OBJ_COUNT; ++j) {
*++s[j] = n;
}
mps_arena_collect(scheme_arena);
mps_arena_release(scheme_arena);
if (mps_message_get(&msg, scheme_arena, mps_message_type_finalization())) {
mps_addr_t ref;
mps_message_finalization_ref(&ref, scheme_arena, msg);
++ n_finalized;
if (interior) {
obj_t o;
o = ref;
error("wrongly finalized vector %ld at %p",
o->vector.vector[0]->integer.integer, (void *)o);
}
}
}
if (!interior && n_finalized < OBJ_COUNT) {
error("only finalized %"PRIuLONGEST" out of %"PRIuLONGEST" vectors.",
(ulongest_t)n_finalized, (ulongest_t)OBJ_COUNT);
}
if (!stack) {
mps_root_destroy(root);
}
}
static void test(void)
{
mps_space_t space;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_fmt_t format;
mps_ap_t ap;
mycell *a, *b;
cdie(mps_space_create(&space), "create space");
cdie(mps_thread_reg(&thread, space), "register thread");
cdie(
mps_root_create_reg(&root, space, MPS_RANK_AMBIG, 0, thread,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(
mps_fmt_create_A(&format, space, &fmtA),
"create format");
cdie(
mps_pool_create(&pool, space, mps_class_amc(), format),
"create pool");
cdie(
mps_ap_create(&ap, pool, MPS_RANK_EXACT),
"create ap");
a = allocone(ap, 1024, 1);
z = a;
b = allocone(ap, 1024, 1);
setref(b, 0, a);
a = allocdumb(ap, 1024*64, 1);
a = allocdumb(ap, 1024*64, 1);
comment("Collecting...");
mps_arena_collect(space);
asserts(z != a, "Didn't move!");
comment("Writing bad pointer...");
b->data.ref[0].addr = z;
mps_arena_collect(space);
comment("Bad pointer not spotted in collection");
fail();
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_root_destroy(root);
comment("Destroyed root.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_space_destroy(space);
comment("Destroyed space.");
}
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 *stack_pointer)
{
long int i;
long int rsize = 0;
int inramp;
mycell *r = NULL, *s;
cdie(mps_arena_create(&arena, mps_arena_class_vm(),
(size_t) 1024*1024*ARENALIMIT),
"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_exact(), 0, &objtab[0], TABSIZE),
"create 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_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
inramp = 0;
for (i = 0; i < ITERATIONS; i++) {
if (i * 10 % ITERATIONS == 0) {
comment("%ld of %ld", i, ITERATIONS);
}
alloc_back();
if (inramp) {
s = allocone(apamc, 3, mps_rank_exact());
setref(r, 0, s);
setref(s, 1, r);
r = s;
s = allocdumb(apamc, RAMPSIZE, mps_rank_exact());
setref(r, 2, s);
rsize ++;
if (ranint(LEAVERAMP) == 0) {
r = allocone(apamc, 2, mps_rank_exact());
s = allocone(apamc, 2, mps_rank_exact());
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_end(apamc, mps_alloc_pattern_ramp());
#endif
#ifdef COLLECT_WORLD
mps_arena_collect(arena);
mps_arena_release(arena);
#endif
comment("ramp end, %ld objects", rsize);
inramp = 0;
}
} else {
if (ranint(ENTERRAMP) == 0) {
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_begin(apamc, mps_alloc_pattern_ramp());
#endif
comment("ramp begin");
r = allocone(apamc, 3, mps_rank_exact());
inramp = 1;
rsize = 0;
}
}
}
mps_arena_park(arena);
mps_ap_destroy(apamc);
comment("Destroyed ap.");
mps_pool_destroy(poolamc);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_chain_destroy(chain);
comment("Destroyed chain.");
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.");
}
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 *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) {
long int i;
long int rsize;
mps_message_t message;
int inramp;
mycell *r, *s;
cdie(mps_arena_create(&arena, mps_arena_class_vm(),
(size_t) 1024*1024*ARENALIMIT),
"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_exact(), 0, &objtab[0], TABSIZE),
"create 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_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
mps_message_type_enable(arena, mps_message_type_collection_stats());
inramp = 0;
for (i = 0; i < ITERATIONS; i++) {
if (i % 10000 == 0) {
comment("%ld of %ld", i, ITERATIONS);
}
alloc_back();
if (inramp) {
s = allocone(apamc, 3, mps_rank_exact());
setref(r, 0, s);
setref(s, 1, r);
r = s;
s = allocdumb(apamc, RAMPSIZE, mps_rank_exact());
setref(r, 2, s);
rsize ++;
if (ranint(LEAVERAMP) == 0) {
r = allocone(apamc, 2, mps_rank_exact());
s = allocone(apamc, 2, mps_rank_exact());
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_end(apamc, mps_alloc_pattern_ramp_collect_all());
#endif
#ifdef COLLECT_WORLD
mps_arena_collect(arena);
mps_arena_release(arena);
#endif
comment("ramp end, %ld objects", rsize);
inramp = 0;
}
} else {
if (ranint(ENTERRAMP) == 0) {
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_begin(apamc, mps_alloc_pattern_ramp_collect_all());
#endif
comment("ramp begin");
r = allocone(apamc, 3, mps_rank_exact());
inramp = 1;
rsize = 0;
}
}
if(mps_message_get(&message, arena, mps_message_type_collection_stats())) {
unsigned long live, condemned, notCondemned;
live = mps_message_collection_stats_live_size(arena, message);
condemned = mps_message_collection_stats_condemned_size(arena, message);
notCondemned =
mps_message_collection_stats_not_condemned_size(arena, message);
comment("Collection: live=%ld, condemned=%ld, not condemned = %ld",
live, condemned, notCondemned);
mps_message_discard(arena, message);
}
}
mps_ap_destroy(apamc);
comment("Destroyed ap.");
mps_pool_destroy(poolamc);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_chain_destroy(chain);
comment("Destroyed chain.");
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.");
}
static void test(void)
{
mps_arena_t arena;
mps_pool_t pool;
mps_thr_t thread;
mps_root_t root;
mps_chain_t chain;
mps_fmt_t format;
mps_ap_t ap;
mycell *a, *b;
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(
mps_pool_create(&pool, arena, mps_class_amc(), format, chain),
"create pool");
cdie(
mps_ap_create(&ap, pool, mps_rank_exact()),
"create ap");
a = allocone(ap, 1024, 1);
z = a;
b = allocone(ap, 1024, 1);
setref(b, 0, a);
a = allocdumb(ap, 1024*64, 1);
a = allocdumb(ap, 1024*64, 1);
comment("Collecting...");
mps_arena_collect(arena);
asserts(z != a, "Didn't move!");
comment("Writing bad pointer...");
b->data.ref[0].addr = z;
mps_arena_collect(arena);
comment("Bad pointer not spotted in collection");
fail();
mps_ap_destroy(ap);
comment("Destroyed ap.");
mps_pool_destroy(pool);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_chain_destroy(chain);
comment("Destroyed chain.");
mps_root_destroy(root);
comment("Destroyed root.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
static void test(void) {
mycell *p, *q;
int i;
mps_res_t res;
size_t lim7, avail7, commit7, lim8, avail8, commit8;
size_t lim9, avail9, commit9;
cdie(mps_arena_create(&arena, mps_arena_class_vm(), ARENA_SIZE),
"create space");
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 stack root");
cdie(
mps_fmt_create_A(&format, arena, &fmtA),
"create format");
cdie(
mps_pool_create(&poolamc, arena, mps_class_amc(), format),
"create pool");
cdie(
mps_ap_create(&apamc, poolamc, MPS_RANK_EXACT),
"create ap");
mps_arena_commit_limit_set(arena, mps_arena_committed(arena)+1024*1024);
mps_reservoir_limit_set(arena, 0);
report("lim7", "%d", lim7 = mps_reservoir_limit(arena));
report("avail7", "%d", avail7 = mps_reservoir_available(arena));
report("commit7", "%d", commit7 = mps_arena_committed(arena));
/* available should be zero, but should be able to allocate with
reservoir permit, until commit_limit is reached
*/
i = -1;
p = NULL;
res = MPS_RES_OK;
while (res == MPS_RES_OK) {
res = reservoir_allocrone(&q, apamc, 10, MPS_RANK_EXACT);
if (res == MPS_RES_OK) {
setref(q, 0, p);
p = q;
}
i++;
}
report("allocfail3", "%d", i);
report_res("failres3", res);
/* should be none left to make available */
mps_reservoir_limit_set(arena, 10ul*1024*1024);
report("lim8", "%d", lim8 = mps_reservoir_limit(arena));
report("avail8", "%d", avail8 = mps_reservoir_available(arena));
report("commit8", "%d", commit8 = mps_arena_committed(arena));
report("spill8", "%d", commit8-mps_arena_commit_limit(arena));
/* throw away objects and collect world */
p = NULL;
q = NULL;
mps_root_destroy(root);
mps_arena_collect(arena);
/* available should have gone up now */
report("lim9", "%d", lim9 = mps_reservoir_limit(arena));
report("avail9", "%d", avail9 = mps_reservoir_available(arena));
report("commit9", "%d", commit9 = mps_arena_committed(arena));
report("grow9", "%d", avail9-avail8);
report("spill9", "%d", commit9-mps_arena_commit_limit(arena));
/* destroy everything remaining
*/
mps_ap_destroy(apamc);
comment("Destroyed ap.");
mps_pool_destroy(poolamc);
comment("Destroyed pool.");
mps_fmt_destroy(format);
comment("Destroyed format.");
mps_thread_dereg(thread);
comment("Deregistered thread.");
mps_arena_destroy(arena);
comment("Destroyed space.");
}
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 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");
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<ITERATIONS; h++) {
comment("%i of %i", h, ITERATIONS);
for(j=0; j<1000; j++) {
if (j == 500) {
mps_arena_collect(arena);
}
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 *arg, size_t s)
{
mps_arena_t arena;
mps_fmt_t fmt;
mps_chain_t chain;
mps_pool_t amc;
mps_root_t mps_root[2];
mps_ap_t ap;
mps_res_t e;
int i;
mps_addr_t nullref = NULL;
void *p = NULL;
int N = rootCOUNT - 1;
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(2));
die(e, "MPS_RES_OK");
die(dylan_init(p, vectorSIZE(2), &nullref, 1), "dylan_init");
} while (!mps_commit(ap, p, vectorSIZE(2)));
/* set vector's slots */
((mps_word_t *)p)[vectorSLOT(0)] = dylan_int(i);
((mps_word_t *)p)[vectorSLOT(1)] = (mps_word_t)NULL;
die(mps_finalize(arena, &p), "finalize\n");
root[i] = p; state[i] = rootSTATE;
}
p = NULL;
mps_message_type_enable(arena, mps_message_type_finalization());
mps_arena_collect(arena);
report(arena, 0);
/* make 0 and N finalizable */
root[0] = NULL;
state[0] = finalizableSTATE;
root[N] = NULL;
state[N] = finalizableSTATE;
mps_arena_collect(arena);
report(arena, 2);
/* make 1 and N-1 refer to each other and finalizable */
((mps_word_t *)root[1])[vectorSLOT(1)] = (mps_word_t)root[N-1];
((mps_word_t *)root[N-1])[vectorSLOT(1)] = (mps_word_t)root[1];
root[1] = NULL;
state[1] = finalizableSTATE;
root[N-1] = NULL;
state[N-1] = finalizableSTATE;
mps_arena_collect(arena);
report(arena, 2);
mps_arena_collect(arena);
report(arena, 0);
/* @@@@ <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;
}
/* testscriptC -- actually runs a test script
*
*/
static void testscriptC(mps_arena_t arena, const char *script)
{
unsigned isLoNext = 1;
unsigned loNext = 0;
unsigned hiNext = myrootCOUNT - 1;
unsigned i;
const char *scriptAll = script;
char am[100]; /* Array of Messages (expected but not yet got) */
char *pmNext = am; /* Pointer to where Next Message will be stored */
while(*script != '\0') {
switch(*script) {
case '.': {
*pmNext = '\0';
printf(" Getting messages (expecting \"%s\")...\n", am);
report(arena, am, TRUE);
printf(" ...done.\n");
pmNext = am;
break;
}
case '!': {
/* Like '.', but not discarding got messages; see .discard */
*pmNext = '\0';
printf(" Getting messages (expecting \"%s\")...\n", am);
report(arena, am, FALSE); /* FALSE: see .discard */
printf(" ...done.\n");
printf(" NOTE: DELIBERATELY FAILING TO DISCARD MESSAGES, "
"TO SEE HOW MPS COPES.\n"); /* .discard */
pmNext = am;
break;
}
case 'C': {
printf(" Collect\n");
die(mps_arena_collect(arena), "mps_arena_collect");
break;
}
case 'F': {
/* (perhaps) make an object Finalizable
*
* .alternate: We alternately pick objects from the low and
* high ends of the myroot array. This is used to test for
* the defect described in job001658.
*/
Insist(loNext <= hiNext);
i = isLoNext ? loNext++ : hiNext--;
isLoNext = 1 - isLoNext;
printf(" Drop myroot ref to object %u -- "
"this might make it Finalizable\n", i);
/* drop myroot ref, to perhaps make i finalizable */
/* (but see .keep-alive) */
myroot[i] = NULL;
state[i] = finalizableSTATE;
break;
}
case 'b':
case 'e':
case 'f': {
/* expect that MPS has posted a particular message */
*pmNext++ = *script;
break;
}
default: {
printf("unknown script command %c (script %s).\n",
*script, scriptAll);
cdie(FALSE, "unknown script command");
return;
}
}
Insist(am <= pmNext && pmNext < am + NELEMS(am));
script++;
}
}
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 *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 *arg, size_t s)
{
mps_arena_t arena;
mps_fmt_t format;
mps_chain_t chain;
mps_root_t exactRoot, ambigRoot, singleRoot, fmtRoot;
unsigned long i;
/* Leave arena clamped until we have allocated this many objects.
is 0 when arena has not been clamped. */
unsigned long clamp_until = 0;
size_t j;
mps_word_t collections;
mps_pool_t mv;
mps_addr_t alloced_obj;
size_t asize = 32; /* size of alloced obj */
mps_addr_t obj;
mps_ld_s ld;
mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp();
size_t rampCount = 0;
mps_res_t res;
arena = (mps_arena_t)arg;
testlib_unused(s);
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mps_pool_create(&mv, arena, mps_class_mv(), 0x10000, 32, 0x10000),
"pool_create(mv)");
pool_create_v_test(arena, format, chain); /* creates amc pool */
ap_create_v_test(amcpool);
die(mps_ap_create(&ap, amcpool), "ap_create");
for(j = 0; j < exactRootsCOUNT; ++j) {
exactRoots[j] = objNULL;
}
for(j = 0; j < ambigRootsCOUNT; ++j) {
ambigRoots[j] = (mps_addr_t)rnd();
}
die(mps_root_create_table_masked(&exactRoot, arena,
MPS_RANK_EXACT, (mps_rm_t)0,
&exactRoots[0], exactRootsCOUNT,
(mps_word_t)1),
"root_create_table(exact)");
die(mps_root_create_table(&ambigRoot, arena,
MPS_RANK_AMBIG, (mps_rm_t)0,
&ambigRoots[0], ambigRootsCOUNT),
"root_create_table(ambig)");
obj = objNULL;
die(mps_root_create(&singleRoot, arena,
MPS_RANK_EXACT, (mps_rm_t)0,
&root_single, &obj, 0),
"root_create(single)");
/* test non-inlined reserve/commit */
obj = make_no_inline();
die(mps_alloc(&alloced_obj, mv, asize), "mps_alloc");
die(dylan_init(alloced_obj, asize, exactRoots, exactRootsCOUNT),
"dylan_init(alloced_obj)");
die(mps_root_create_fmt(&fmtRoot, arena,
MPS_RANK_EXACT, (mps_rm_t)0,
dylan_fmt_A()->scan,
alloced_obj,
(mps_addr_t)(((char*)alloced_obj)+asize)),
"root_create_fmt");
mps_ld_reset(&ld, arena);
mps_ld_add(&ld, arena, obj);
if (mps_ld_isstale(&ld, arena, obj)) {
mps_ld_reset(&ld, arena);
mps_ld_add(&ld, arena, obj);
}
collections = mps_collections(arena);
for(i = 0; i < OBJECTS; ++i) {
unsigned c;
size_t r;
c = mps_collections(arena);
if(collections != c) {
collections = c;
printf("\nCollection %u, %lu objects.\n", c, i);
for(r = 0; r < exactRootsCOUNT; ++r) {
cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]),
"all roots check");
}
if(collections == 1) {
mps_arena_clamp(arena);
clamp_until = i + 10000;
}
if(collections % 6 == 0) {
mps_arena_expose(arena);
mps_arena_release(arena);
}
if(collections % 6 == 3) {
mps_arena_unsafe_expose_remember_protection(arena);
mps_arena_unsafe_restore_protection(arena);
mps_arena_release(arena);
}
if(collections % 6 == 4) {
mps_arena_unsafe_expose_remember_protection(arena);
mps_arena_release(arena);
}
if(collections % 3 == 2) {
mps_arena_park(arena);
mps_arena_release(arena);
}
}
if(clamp_until && i >= clamp_until) {
mps_arena_release(arena);
clamp_until = 0;
}
if (rnd() % patternFREQ == 0) {
switch(rnd() % 4) {
case 0: case 1:
die(mps_ap_alloc_pattern_begin(ap, ramp), "alloc_pattern_begin");
++rampCount;
break;
case 2:
res = mps_ap_alloc_pattern_end(ap, ramp);
cdie(rampCount > 0 ? res == MPS_RES_OK : res == MPS_RES_FAIL,
"alloc_pattern_end");
if (rampCount > 0) {
--rampCount;
}
break;
case 3:
die(mps_ap_alloc_pattern_reset(ap), "alloc_pattern_reset");
rampCount = 0;
break;
}
}
if (rnd() & 1) {
exactRoots[rnd() % exactRootsCOUNT] = make();
} else {
ambigRoots[rnd() % ambigRootsCOUNT] = make();
}
r = rnd() % exactRootsCOUNT;
if (exactRoots[r] != objNULL) {
cdie(dylan_check(exactRoots[r]), "random root check");
}
}
arena_commit_test(arena);
reservoir_test(arena);
alignmentTest(arena);
die(mps_arena_collect(arena), "collect");
mps_free(mv, alloced_obj, 32);
alloc_v_test(mv);
mps_pool_destroy(mv);
mps_ap_destroy(ap);
mps_root_destroy(fmtRoot);
mps_root_destroy(singleRoot);
mps_root_destroy(exactRoot);
mps_root_destroy(ambigRoot);
mps_pool_destroy(amcpool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
return NULL;
}
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.");
}
static void test(mps_arena_t arena,
mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap,
mps_ap_t bogusap)
{
mps_word_t *weaktable;
mps_word_t *exacttable;
mps_word_t *preserve[TABLE_SLOTS]; /* preserves objects in the weak */
/* table by referring to them */
size_t i, j;
void *p;
exacttable = alloc_table(TABLE_SLOTS, exactap);
weaktable = alloc_table(TABLE_SLOTS, weakap);
table_link(exacttable, weaktable);
/* Leave bogusap between reserve and commit for the duration */
die(mps_reserve(&p, bogusap, 64), "Reserve bogus");
for(i = 0; i < TABLE_SLOTS; ++i) {
mps_word_t *string;
/* Ensure that the first and last entries in the table are
* preserved, so that we don't get false positives due to the
* local variables 'weak_table' and 'string' keeping these entries
* alive (see job003436).
*/
if (rnd() % 2 == 0 || i == 0 || i + 1 == TABLE_SLOTS) {
string = alloc_string("iamalive", leafap);
preserve[i] = string;
} else {
string = alloc_string("iamdead", leafap);
preserve[i] = 0;
}
set_table_slot(weaktable, i, string);
string = alloc_string("iamexact", leafap);
set_table_slot(exacttable, i, string);
}
for(j = 0; j < ITERATIONS; ++j) {
for(i = 0; i < TABLE_SLOTS; ++i) {
(void)alloc_string("spong", leafap);
}
}
die(mps_arena_collect(arena), "mps_arena_collect");
mps_arena_release(arena);
for(i = 0; i < TABLE_SLOTS; ++i) {
if (preserve[i] == 0) {
if (table_slot(weaktable, i)) {
error("Strongly unreachable weak table entry found, "
"slot %"PRIuLONGEST".\n", (ulongest_t)i);
} else {
if (table_slot(exacttable, i) != 0) {
error("Weak table entry deleted, but corresponding "
"exact table entry not deleted, slot %"PRIuLONGEST".\n",
(ulongest_t)i);
}
}
}
}
(void)mps_commit(bogusap, p, 64);
}
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_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)
{
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) {
long int i;
long int rsize;
int inramp;
mycell *r1, *r2, *s1, *s2;
cdie(mps_arena_create(&arena1, mps_arena_class_vm(),
(size_t) 1024*1024*ARENALIMIT), "create arena");
cdie(mps_arena_create(&arena2, mps_arena_class_vm(),
(size_t) 1024*1024*ARENALIMIT), "create arena");
cdie(mps_thread_reg(&thread1, arena1), "register thread");
cdie(mps_thread_reg(&thread2, arena2), "register thread");
cdie(
mps_root_create_reg(&root1, arena1, mps_rank_ambig(), 0, thread1,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(
mps_root_create_reg(&root2, arena2, mps_rank_ambig(), 0, thread2,
mps_stack_scan_ambig, stackpointer, 0),
"create root");
cdie(
mps_root_create_table(&root1a, arena1, mps_rank_exact(), 0, &objtab1[0], TABSIZE),
"create root table");
cdie(
mps_root_create_table(&root2a, arena2, mps_rank_exact(), 0, &objtab2[0], TABSIZE),
"create root table");
cdie(
mps_fmt_create_A(&format1, arena1, &fmtA),
"create format");
cdie(
mps_fmt_create_A(&format2, arena2, &fmtA),
"create format");
cdie(
mps_pool_create(&poolamc1, arena1, mps_class_amc(), format1),
"create pool");
cdie(
mps_pool_create(&poolamc2, arena2, mps_class_amc(), format2),
"create pool");
cdie(
mps_ap_create(&apamc1, poolamc1, mps_rank_exact()),
"create ap");
cdie(
mps_ap_create(&apamc2, poolamc2, mps_rank_exact()),
"create ap");
inramp = 0;
for (i = 0; i < ITERATIONS; i++) {
if (i % 10000 == 0) {
comment("%ld of %ld", i, ITERATIONS);
}
alloc_back();
if (inramp) {
s1 = allocone(apamc1, 3, mps_rank_exact());
s2 = allocone(apamc2, 3, mps_rank_exact());
setref(r1, 0, s1);
setref(r2, 0, s2);
setref(s1, 1, r1);
setref(s2, 1, r2);
r1 = s1;
r2 = s2;
s1 = allocdumb(apamc1, RAMPSIZE, mps_rank_exact());
s2 = allocdumb(apamc2, RAMPSIZE, mps_rank_exact());
setref(r1, 2, s1);
setref(r2, 2, s2);
rsize ++;
if (ranint(LEAVERAMP) == 0) {
r1 = allocone(apamc1, 2, mps_rank_exact());
r2 = allocone(apamc2, 2, mps_rank_exact());
s1 = allocone(apamc1, 2, mps_rank_exact());
s2 = allocone(apamc2, 2, mps_rank_exact());
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_end(apamc1, mps_alloc_pattern_ramp());
mps_ap_alloc_pattern_end(apamc2, mps_alloc_pattern_ramp());
#endif
#ifdef COLLECT_WORLD
mps_arena_collect(arena1);
mps_arena_collect(arena2);
mps_arena_release(arena1);
mps_arena_release(arena2);
#endif
comment("ramp end, %ld objects", rsize);
inramp = 0;
}
} else {
if (ranint(ENTERRAMP) == 0) {
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_begin(apamc1, mps_alloc_pattern_ramp());
mps_ap_alloc_pattern_begin(apamc2, mps_alloc_pattern_ramp());
#endif
comment("ramp begin");
r1 = allocone(apamc1, 3, mps_rank_exact());
r2 = allocone(apamc2, 3, mps_rank_exact());
inramp = 1;
rsize = 0;
}
}
}
mps_ap_destroy(apamc1);
mps_ap_destroy(apamc2);
comment("Destroyed ap.");
mps_pool_destroy(poolamc1);
mps_pool_destroy(poolamc2);
comment("Destroyed pool.");
mps_fmt_destroy(format1);
mps_fmt_destroy(format2);
comment("Destroyed format.");
mps_root_destroy(root1);
mps_root_destroy(root1a);
mps_root_destroy(root2);
mps_root_destroy(root2a);
comment("Destroyed roots.");
mps_thread_dereg(thread1);
mps_thread_dereg(thread2);
comment("Deregistered thread.");
mps_arena_destroy(arena1);
mps_arena_destroy(arena2);
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)
{
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;
long int i;
long int rsize = 0;
int inramp;
mycell *r, *s;
cdie(mps_arena_create(&arena, mps_arena_class_vm(),
(size_t) 1024*1024*ARENALIMIT),
"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_exact(), 0, &objtab[0], TABSIZE),
"create 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)");
cdie(
mps_ap_create(&apamc, poolamc, mps_rank_exact()),
"create ap");
inramp = 0;
r = NULL; /* r is always initialized, because inramp=0 at the start, but */
/* the compiler doesn't know this. */
for (i = 0; i < ITERATIONS; i++) {
if (i % 10000 == 0) {
comment("%ld of %ld", i, ITERATIONS);
}
alloc_back();
if (inramp) {
s = allocone(apamc, 3, mps_rank_exact());
setref(r, 0, s);
setref(s, 1, r);
r = s;
s = allocdumb(apamc, RAMPSIZE, mps_rank_exact());
setref(r, 2, s);
rsize ++;
if (ranint(LEAVERAMP) == 0) {
r = allocone(apamc, 2, mps_rank_exact());
s = allocone(apamc, 2, mps_rank_exact());
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_end(apamc, mps_alloc_pattern_ramp());
#endif
#ifdef COLLECT_WORLD
mps_arena_collect(arena);
mps_arena_release(arena);
#endif
comment("ramp end, %ld objects", rsize);
inramp = 0;
}
} else {
if (ranint(ENTERRAMP) == 0) {
#ifdef RAMP_INTERFACE
mps_ap_alloc_pattern_begin(apamc, mps_alloc_pattern_ramp());
#endif
comment("ramp begin");
r = allocone(apamc, 3, mps_rank_exact());
inramp = 1;
rsize = 0;
}
}
}
mps_arena_park(arena);
mps_ap_destroy(apamc);
mps_pool_destroy(poolamc);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_root_destroy(root1);
mps_root_destroy(root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
comment("Destroyed arena.");
}
