static void test(void *stack_pointer) { mps_pool_t poolamc, poolawl, poollo; mps_thr_t thread; mps_root_t root0, root1; mps_fmt_t format; mps_chain_t chain; mps_ap_t apamc, apawl, aplo; mycell *a, *b, *c, *d, *z; long int i,j; cdie(mps_arena_create(&arena, mps_arena_class_vm(), (size_t)1024*1024*30), "create arena"); cdie(mps_thread_reg(&thread, arena), "register thread"); cdie(mps_root_create_thread(&root0, arena, thread, stack_pointer), "thread root"); cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0, (mps_addr_t*)&exfmt_root, 1), "create table root"); cdie(mps_fmt_create_A(&format, arena, &fmtA), "create format"); cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); die(mmqa_pool_create_chain(&poolamc, arena, mps_class_amc(), format, chain), "create pool(amc)"); cdie(mps_pool_create(&poolawl, arena, mps_class_awl(), format, getassociated), "create pool(awl)"); cdie(mmqa_pool_create_chain(&poollo, arena, mps_class_amcz(), format, chain), "create pool(amcz)"); cdie(mps_ap_create(&apawl, poolawl, mps_rank_weak()), "create ap(awl)"); cdie(mps_ap_create(&apamc, poolamc, mps_rank_exact()), "create ap(amc)"); cdie(mps_ap_create(&aplo, poollo, mps_rank_exact()), "create ap(amcz)"); mps_message_type_enable(arena, mps_message_type_finalization()); /* register loads of objects for finalization (1000*4) */ a = allocone(apamc, 2, 1); b = a; for (j=0; j<1000; j++) { a = allocone(apamc, 2, mps_rank_exact()); c = allocone(apawl, 2, mps_rank_weak()); d = allocone(aplo, 2, mps_rank_exact()); /* rank irrelevant here! */ mps_finalize(arena, (mps_addr_t*)&a); mps_finalize(arena, (mps_addr_t*)&c); mps_finalize(arena, (mps_addr_t*)&d); mps_finalize(arena, (mps_addr_t*)&d); final_count += 4; } /* throw them all away and collect everything */ comment("b = %p", b); /* suppress compiler warning about unused b */ a = NULL; b = NULL; c = NULL; d = NULL; mps_root_destroy(root0); mps_root_destroy(root1); comment("Destroyed roots."); mps_arena_collect(arena); i = 0; while (final_count != 0 && i < 10) { finalpoll(&z, FINAL_DISCARD); if (mps_message_poll(arena) == 0) { i++; a = allocdumb(apawl, 1024, mps_rank_weak()); a = allocdumb(apamc, 1024, mps_rank_exact()); a = allocdumb(aplo, 1024, mps_rank_exact()); mps_arena_collect(arena); comment(" %i", final_count); } } /* how many are left? (Ideally, this would be 0 but there's no guarantee.) */ report("count", "%i", final_count); report("iter", "%i", i); /* now to test leaving messages open for a long time! */ mps_arena_park(arena); mps_ap_destroy(apawl); mps_ap_destroy(apamc); mps_ap_destroy(aplo); comment("Destroyed aps."); mps_pool_destroy(poolamc); mps_pool_destroy(poolawl); mps_pool_destroy(poollo); comment("Destroyed pools."); mps_chain_destroy(chain); mps_fmt_destroy(format); mps_thread_dereg(thread); mps_arena_destroy(arena); comment("Destroyed arena."); }
static void test(void) { mps_pool_t poolamc, poolawl, poolamcz; mps_thr_t thread; mps_root_t root0, root1; mps_fmt_t format; mps_chain_t chain; mps_ap_t apamc, apawl, apamcz; mycell *a, *b, *c, *d, *z; long int j; cdie(mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none), "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"); cdie(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(&poolamcz, 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(&apamcz, poolamcz, 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(apamcz, 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; setref(a, 0, b); setref(a, 1, c); setref(c, 1, d); b = a; } /* throw them all away and collect everything */ a = NULL; b = NULL; c = NULL; d = NULL; mps_arena_collect(arena); while (mps_message_poll(arena)) { finalpoll(&z, FINAL_DISCARD); } /* How many are left? (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<1000; j++) { comment("%d of 1000", j+1); a = allocone(apamc, 10000, mps_rank_exact()); mps_finalize(arena, (mps_addr_t*)&a); final_count +=1; comment("finalize"); finalpoll(&z, FINAL_QUEUE); } comment("reregister"); for (j=0; j<500; j++) { comment("%d of 500", j+1); qpoll(&z, FINAL_REREGISTER); } b = a; z = a; for (j=0; j<1000; j++) { comment("%d of 1000", j+1); finalpoll(&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<1000; j++) { a = allocone(apamc, 2, mps_rank_exact()); qpoll(&z, FINAL_DISCARD); finalpoll(&z, FINAL_DISCARD); setref(a, 0, b); b = a; } /* Force old objects to be killed */ while (qmt() == 0) { qpoll(&z, FINAL_DISCARD); } mps_root_destroy(root0); mps_root_destroy(root1); comment("Destroyed roots."); mps_arena_collect(arena); comment("Collected arena."); while (mps_message_poll(arena)) { finalpoll(&z, FINAL_DISCARD); } report("count2", "%d", final_count); mps_arena_park(arena); mps_ap_destroy(apawl); mps_ap_destroy(apamc); mps_ap_destroy(apamcz); comment("Destroyed aps."); mps_pool_destroy(poolamc); mps_pool_destroy(poolawl); mps_pool_destroy(poolamcz); comment("Destroyed pools."); mps_chain_destroy(chain); mps_fmt_destroy(format); mps_thread_dereg(thread); mps_arena_destroy(arena); comment("Destroyed arena."); }