static void process_mess(mps_message_t message, int faction, mps_addr_t *ref) { mps_addr_t ffref; switch (faction) { case FINAL_DISCARD: mps_message_discard(arena, message); break; case FINAL_REREGISTER: mps_message_finalization_ref(&ffref, arena, message); mps_finalize(arena, &ffref); final_count +=1; mps_message_discard(arena, message); break; case FINAL_STORE: mps_message_finalization_ref(ref, arena, message); mps_message_discard(arena, message); break; case FINAL_QUEUE: nq(message); break; default: asserts(0, "Unknown finalization action."); } }
static void register_numbered_tree(mps_word_t tree, mps_arena_t arena) { /* don't finalize ints */ if ((tree & 1) == 0) { mps_finalize(arena, (mps_addr_t *)&tree); register_numbered_tree(DYLAN_VECTOR_SLOT(tree, 0), arena); register_numbered_tree(DYLAN_VECTOR_SLOT(tree, 1), arena); } }
static void register_indirect_tree(mps_word_t tree, mps_arena_t arena) { /* don't finalize ints */ if ((tree & 1) == 0) { mps_addr_t indirect = (void *)DYLAN_VECTOR_SLOT(tree,2); die(mps_finalize(arena, &indirect), "mps_finalize"); register_indirect_tree(DYLAN_VECTOR_SLOT(tree, 0), arena); register_indirect_tree(DYLAN_VECTOR_SLOT(tree, 1), arena); } }
static void test(void) { mps_arena_t arena; mps_pool_t pool; mps_addr_t p; die(mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none), "arena_create"); die(mps_pool_create_k(&pool, arena, mps_class_mvff(), mps_args_none), "pool_create"); die(mps_alloc(&p, pool, 4096), "alloc"); die(mps_finalize(arena, &p), "finalize"); mps_pool_destroy(pool); mps_arena_destroy(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); } }
obj_t scheme_make_port(obj_t name, FILE *stream) { mps_addr_t port_ref; obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(port_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_port"); obj = addr; obj->port.type = TYPE_PORT; obj->port.name = name; obj->port.stream = stream; } while(!mps_commit(obj_ap, addr, size)); port_ref = obj; mps_finalize(scheme_arena, &port_ref); return obj; }
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 *arg, size_t s) { unsigned i; /* index */ mps_ap_t ap; mps_fmt_t fmt; mps_chain_t chain; mps_pool_t amc; mps_res_t e; mps_root_t mps_root[2]; mps_addr_t nullref = NULL; int state[rootCOUNT]; mps_arena_t arena; void *p = NULL; mps_message_t message; 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); die(e, "MPS_RES_OK"); die(dylan_init(p, vectorSIZE, &nullref, 1), "dylan_init"); } while (!mps_commit(ap, p, vectorSIZE)); /* store index in vector's slot */ ((mps_word_t *)p)[vectorSLOT] = dylan_int(i); die(mps_finalize(arena, &p), "finalize\n"); root[i] = p; state[i] = rootSTATE; } p = NULL; mps_message_type_enable(arena, mps_message_type_finalization()); /* <design/poolmrg/#test.promise.ut.churn> */ while (mps_collections(arena) < collectionCOUNT) { /* Perhaps cause (minor) collection */ churn(ap); /* Maybe make some objects ready-to-finalize */ /* <design/poolmrg/#test.promise.ut.drop> */ for (i = 0; i < rootCOUNT; ++i) { if (root[i] != NULL && state[i] == rootSTATE) { if (rnd() % finalizationRATE == 0) { /* for this object, either... */ if (rnd() % 2 == 0) { /* ...definalize it, or */ die(mps_definalize(arena, &root[i]), "definalize\n"); state[i] = deadSTATE; } else { /* ...expect it to be finalized soon */ state[i] = finalizableSTATE; } /* Drop the root reference to it; this makes it */ /* non-E-reachable: so either dead, or ready-to-finalize. */ root[i] = NULL; } } } /* Test any finalized objects, and perhaps resurrect some */ while (mps_message_poll(arena)) { mps_word_t *obj; mps_word_t objind; mps_addr_t objaddr; /* <design/poolmrg/#test.promise.ut.message> */ cdie(mps_message_get(&message, arena, mps_message_type_finalization()), "get"); cdie(0 == mps_message_clock(arena, message), "message clock should be 0 (unset) for finalization messages"); mps_message_finalization_ref(&objaddr, arena, message); obj = objaddr; objind = dylan_int_int(obj[vectorSLOT]); printf("Finalizing: object %lu at %p\n", objind, objaddr); /* <design/poolmrg/#test.promise.ut.final.check> */ cdie(root[objind] == NULL, "finalized live"); cdie(state[objind] == finalizableSTATE, "finalized dead"); state[objind] = finalizedSTATE; /* sometimes resurrect */ if (rnd() % 2 == 0) root[objind] = objaddr; mps_message_discard(arena, message); } } /* @@@@ <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; }
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 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"); cdie(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"); cdie(mps_root_create_table(&root1, arena, mps_rank_ambig(), 0, (mps_addr_t *)&exfmt_root, 1), "create table root"); die(mps_fmt_create_A(&format, arena, &fmtA), "create format"); cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); die(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain), "create pool"); 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"); for (j=0; j<1000; j++) { res=allocrdumb(&a, ap, 1024*1024, mps_rank_exact()); } fillup(); comment("finalizing..."); addr = a; for (j=0; j<100; j++) { comment(err_text(mps_finalize(arena, &addr))); } comment("try to make collectm by allocating another 1G..."); empty(); for (j=0; j<1024; j++) { res=allocrdumb(&a, ap, 1024 * 1024, mps_rank_exact()); if (res == MPS_RES_OK) { comment("%i ok", j); } else { break; } } comment("collect world..."); for (j=0; j<100; 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 *testscriptB(void *arg, size_t s) { trampDataStruct trampData; mps_arena_t arena; mps_thr_t thr; const char *script; mps_fmt_t fmt; mps_chain_t chain; mps_pool_t amc; mps_root_t root_table; mps_ap_t ap; mps_root_t root_stackreg; size_t i; int N = myrootCOUNT - 1; void *stack_starts_here; /* stack scanning starts here */ Insist(s == sizeof(trampDataStruct)); trampData = *(trampDataStruct*)arg; arena = trampData.arena; thr = trampData.thr; script = trampData.script; die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create"); die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); die(mps_pool_create(&amc, arena, mps_class_amc(), fmt, chain), "pool_create amc"); for(i = 0; i < myrootCOUNT; ++i) { myroot[i] = NULL; } die(mps_root_create_table(&root_table, arena, mps_rank_exact(), (mps_rm_t)0, myroot, (size_t)myrootCOUNT), "root_create"); die(mps_ap_create(&ap, amc, mps_rank_exact()), "ap_create"); /* root_stackreg: stack & registers are ambiguous roots = mutator's workspace */ die(mps_root_create_reg(&root_stackreg, arena, mps_rank_ambig(), (mps_rm_t)0, thr, mps_stack_scan_ambig, &stack_starts_here, 0), "root_stackreg"); /* Make myrootCOUNT registered-for-finalization objects. */ /* Each is a dylan vector with 2 slots, inited to: (index, NULL) */ for(i = 0; i < myrootCOUNT; ++i) { mps_word_t v; mps_addr_t v_ref; die(make_dylan_vector(&v, ap, 2), "make_dylan_vector"); DYLAN_VECTOR_SLOT(v, 0) = DYLAN_INT(i); DYLAN_VECTOR_SLOT(v, 1) = (mps_word_t)NULL; v_ref = (mps_addr_t)v; die(mps_finalize(arena, &v_ref), "finalize"); myroot[i] = (void*)v; state[i] = rootSTATE; } /* .keep-alive: Create some additional inter-object references. * * 1 and N-1 don't die until myroot refs to both have been nulled. * * 2 and 3 don't die until myroot refs to both have been nulled. * * We do this to check that reachability via non-root refs prevents * finalization. */ /* Leave 0 and N containing NULL refs */ /* Make 1 and N-1 refer to each other */ DYLAN_VECTOR_SLOT(myroot[1] , 1) = (mps_word_t)myroot[N-1]; DYLAN_VECTOR_SLOT(myroot[N-1], 1) = (mps_word_t)myroot[1]; /* Make 2 and 3 refer to each other */ DYLAN_VECTOR_SLOT(myroot[2], 1) = (mps_word_t)myroot[3]; DYLAN_VECTOR_SLOT(myroot[3], 1) = (mps_word_t)myroot[2]; /* Stop stack scanning, otherwise stack or register dross from */ /* these setup functions can cause unwanted object retention, */ /* which would mean we don't get the finalization messages we */ /* expect. */ mps_root_destroy(root_stackreg); mps_message_type_enable(arena, mps_message_type_gc_start()); mps_message_type_enable(arena, mps_message_type_gc()); mps_message_type_enable(arena, mps_message_type_finalization()); testscriptC(arena, script); mps_ap_destroy(ap); mps_root_destroy(root_table); 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 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; }
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."); }