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 *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)
{
/* 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(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)
{
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 walkroots (mycell *a)
{
mps_arena_park(arena);
mps_arena_roots_walk(arena, root_step, (mps_addr_t) a, MAGICSIZE);
mps_arena_release(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(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 *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 *arg, size_t s)
{
mps_arena_t arena;
mps_fmt_t format;
mps_chain_t chain;
mps_root_t exactRoot, ambigRoot;
unsigned long objs; size_t i;
mps_word_t collections, rampSwitch;
mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp();
int ramping;
mps_ap_t busy_ap;
mps_addr_t busy_init;
arena = (mps_arena_t)arg;
(void)s; /* unused */
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mps_pool_create(&pool, arena, mps_class_amc(), format, chain),
"pool_create(amc)");
die(mps_ap_create(&ap, pool, MPS_RANK_EXACT), "BufferCreate");
die(mps_ap_create(&busy_ap, pool, MPS_RANK_EXACT), "BufferCreate 2");
for(i = 0; i < exactRootsCOUNT; ++i)
exactRoots[i] = objNULL;
for(i = 0; i < ambigRootsCOUNT; ++i)
ambigRoots[i] = rnd_addr();
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)");
/* create an ap, and leave it busy */
die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
collections = 0;
rampSwitch = rampSIZE;
die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
ramping = 1;
objs = 0;
while (collections < collectionsCOUNT) {
unsigned long c;
size_t r;
size_t hitRatio;
c = mps_collections(arena);
if (collections != c) {
collections = c;
printf("\nCollection %lu started, %lu objects.\n", c, objs);
/* test mps_arena_has_addr */
hitRatio = ((size_t)-1 / mps_arena_committed(arena));
/* That's roughly how often a random addr should hit the arena. */
for (i = 0; i < 4 * hitRatio ; i++) {
mps_addr_t p = rnd_addr();
if (mps_arena_has_addr(arena, p)) {
printf("%p is in the arena\n", p);
}
}
report(arena);
for (i = 0; i < exactRootsCOUNT; ++i)
cdie(exactRoots[i] == objNULL
|| (dylan_check(exactRoots[i])
&& mps_arena_has_addr(arena, exactRoots[i])),
"all roots check");
cdie(!mps_arena_has_addr(arena, NULL),
"NULL in arena");
if (collections == collectionsCOUNT / 2) {
unsigned long object_count = 0;
mps_arena_park(arena);
mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
mps_arena_release(arena);
printf("stepped on %lu objects.\n", object_count);
}
if (collections == rampSwitch) {
int begin_ramp = !ramping
|| /* Every other time, switch back immediately. */ (collections & 1);
rampSwitch += rampSIZE;
if (ramping) {
die(mps_ap_alloc_pattern_end(ap, ramp), "pattern end (ap)");
die(mps_ap_alloc_pattern_end(busy_ap, ramp), "pattern end (busy_ap)");
ramping = 0;
/* kill half of the roots */
for(i = 0; i < exactRootsCOUNT; i += 2) {
if (exactRoots[i] != objNULL) {
cdie(dylan_check(exactRoots[i]), "ramp kill check");
exactRoots[i] = objNULL;
}
}
}
if (begin_ramp) {
die(mps_ap_alloc_pattern_begin(ap, ramp),
"pattern rebegin (ap)");
die(mps_ap_alloc_pattern_begin(busy_ap, ramp),
"pattern rebegin (busy_ap)");
ramping = 1;
}
}
}
r = (size_t)rnd();
if (r & 1) {
i = (r >> 1) % exactRootsCOUNT;
if (exactRoots[i] != objNULL)
cdie(dylan_check(exactRoots[i]), "dying root check");
exactRoots[i] = make();
if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
exactRoots, exactRootsCOUNT);
} else {
static void test(mps_arena_t arena, mps_pool_class_t pool_class)
{
mps_chain_t chain;
mps_fmt_t format;
mps_pool_t pool;
mps_root_t exactRoot;
size_t i;
size_t totalSize, freeSize, allocSize, bufferSize;
unsigned long objs;
struct stepper_data sdStruct, *sd;
PoolClass class;
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
die(mps_pool_create_k(&pool, arena, pool_class, args), "pool_create");
} MPS_ARGS_END(args);
die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create");
for(i = 0; i < exactRootsCOUNT; ++i)
exactRoots[i] = objNULL;
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)");
objs = 0;
while(objs < objCOUNT) {
size_t r;
r = objs;
i = r % exactRootsCOUNT;
if(exactRoots[i] != objNULL) {
cdie(dylan_check(exactRoots[i]), "dying root check");
}
exactRoots[i] = make();
if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
exactRoots, exactRootsCOUNT);
++objs;
}
mps_arena_park(arena);
sd = &sdStruct;
sd->arena = arena;
sd->expect_pool = pool;
sd->expect_fmt = format;
sd->count = 0;
sd->objSize = 0;
sd->padSize = 0;
mps_arena_formatted_objects_walk(arena, stepper, sd, sizeof *sd);
Insist(sd->count == objs);
totalSize = mps_pool_total_size(pool);
freeSize = mps_pool_free_size(pool);
allocSize = totalSize - freeSize;
bufferSize = AddrOffset(ap->init, ap->limit);
class = ClassOfPoly(Pool, pool);
printf("%s: obj=%lu pad=%lu total=%lu free=%lu alloc=%lu buffer=%lu\n",
ClassName(class),
(unsigned long)sd->objSize,
(unsigned long)sd->padSize,
(unsigned long)totalSize,
(unsigned long)freeSize,
(unsigned long)allocSize,
(unsigned long)bufferSize);
Insist(sd->objSize + sd->padSize + bufferSize == allocSize);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
}
static void *test(mps_arena_t arena, mps_pool_class_t pool_class)
{
mps_chain_t chain;
mps_fmt_t format;
mps_pool_t pool;
mps_root_t exactRoot;
size_t i;
unsigned long objs;
struct stepper_data sdStruct, *sd;
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
die(mps_pool_create_k(&pool, arena, pool_class, args), "pool_create");
} MPS_ARGS_END(args);
die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create");
for(i = 0; i < exactRootsCOUNT; ++i)
exactRoots[i] = objNULL;
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)");
objs = 0;
while(objs < objCOUNT) {
size_t r;
r = objs;
i = r % exactRootsCOUNT;
if(exactRoots[i] != objNULL) {
cdie(dylan_check(exactRoots[i]), "dying root check");
}
exactRoots[i] = make();
if(exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
exactRoots, exactRootsCOUNT);
++objs;
}
sd = &sdStruct;
sd->arena = arena;
sd->expect_pool = pool;
sd->expect_fmt = format;
sd->count = 0;
mps_arena_formatted_objects_walk(arena, stepper, sd, sizeof *sd);
/* Note: stepper finds more than we expect, due to pad objects */
/* printf("stepper found %ld objs\n", sd->count); */
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
return NULL;
}
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(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
{
mps_fmt_t format;
mps_chain_t chain;
mps_root_t exactRoot, ambigRoot;
unsigned long objs; size_t i;
mps_word_t collections, rampSwitch;
mps_alloc_pattern_t ramp = mps_alloc_pattern_ramp();
int ramping;
mps_ap_t busy_ap;
mps_addr_t busy_init;
mps_pool_t pool;
int described = 0;
die(dylan_fmt(&format, arena), "fmt_create");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mps_pool_create(&pool, arena, pool_class, format, chain),
"pool_create(amc)");
die(mps_ap_create(&ap, pool, mps_rank_exact()), "BufferCreate");
die(mps_ap_create(&busy_ap, pool, mps_rank_exact()), "BufferCreate 2");
for(i = 0; i < exactRootsCOUNT; ++i)
exactRoots[i] = objNULL;
for(i = 0; i < ambigRootsCOUNT; ++i)
ambigRoots[i] = rnd_addr();
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)");
/* create an ap, and leave it busy */
die(mps_reserve(&busy_init, busy_ap, 64), "mps_reserve busy");
collections = 0;
rampSwitch = rampSIZE;
die(mps_ap_alloc_pattern_begin(ap, ramp), "pattern begin (ap)");
die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
ramping = 1;
objs = 0;
while (collections < collectionsCOUNT) {
mps_word_t c;
size_t r;
c = mps_collections(arena);
if (collections != c) {
if (!described) {
die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe");
described = TRUE;
}
collections = c;
report(arena);
printf("%lu objects (mps_collections says: %"PRIuLONGEST")\n", objs,
(ulongest_t)c);
/* test mps_arena_has_addr */
{
size_t hitRatio;
unsigned hitsWanted = 4; /* aim for 4 hits (on average) */
/* [Note: The for-loop condition used to be "i < 4 * hitRatio",
* with "4" an unexplained naked constant. I have now labelled
* it "hitsWanted", as I think that is the intent. RHSK]
*/
/* how many random addrs must we try, to hit the arena once? */
hitRatio = (0xfffffffful / mps_arena_committed(arena));
for (i = 0; i < hitsWanted * hitRatio ; i++) {
/* An exact root maybe in the arena, so add a random 32-bit
* offset to it. We may get no hits if it is objNULL.
*/
mps_addr_t p = (char *)exactRoots[rnd() % exactRootsCOUNT]
+ rnd()-0x80000000ul;
if (mps_arena_has_addr(arena, p)) {
printf("%p is in the arena\n", p);
}
}
}
for (i = 0; i < exactRootsCOUNT; ++i)
cdie(exactRoots[i] == objNULL
|| (dylan_check(exactRoots[i])
&& mps_arena_has_addr(arena, exactRoots[i])),
"all roots check");
cdie(!mps_arena_has_addr(arena, NULL),
"NULL in arena");
if (collections == collectionsCOUNT / 2) {
unsigned long object_count = 0;
mps_arena_park(arena);
mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
mps_arena_release(arena);
printf("stepped on %lu objects.\n", object_count);
}
if (collections == rampSwitch) {
int begin_ramp = !ramping
|| /* Every other time, switch back immediately. */ (collections & 1);
rampSwitch += rampSIZE;
if (ramping) {
die(mps_ap_alloc_pattern_end(ap, ramp), "pattern end (ap)");
die(mps_ap_alloc_pattern_end(busy_ap, ramp), "pattern end (busy_ap)");
ramping = 0;
/* kill half of the roots */
for(i = 0; i < exactRootsCOUNT; i += 2) {
if (exactRoots[i] != objNULL) {
cdie(dylan_check(exactRoots[i]), "ramp kill check");
exactRoots[i] = objNULL;
}
}
}
if (begin_ramp) {
die(mps_ap_alloc_pattern_begin(ap, ramp),
"pattern rebegin (ap)");
die(mps_ap_alloc_pattern_begin(busy_ap, ramp),
"pattern rebegin (busy_ap)");
ramping = 1;
}
}
}
r = (size_t)rnd();
if (r & 1) {
i = (r >> 1) % exactRootsCOUNT;
if (exactRoots[i] != objNULL)
cdie(dylan_check(exactRoots[i]), "dying root check");
exactRoots[i] = make(roots_count);
if (exactRoots[(exactRootsCOUNT-1) - i] != objNULL)
dylan_write(exactRoots[(exactRootsCOUNT-1) - i],
exactRoots, exactRootsCOUNT);
} else {
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.");
}
