static mps_res_t mv2_alloc(mps_addr_t *ref, mps_ap_t ap, size_t size) { mps_res_t res; size = ((size+7)/8)*8; do { MPS_RESERVE_BLOCK(res, *ref, ap, size); if (res != MPS_RES_OK) return res; } while (!mps_commit(ap, *ref, size)); return MPS_RES_OK; }
obj_t scheme_make_character(char c) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(character_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_character"); obj = addr; obj->character.type = TYPE_CHARACTER; obj->character.c = c; } while(!mps_commit(obj_ap, addr, size)); return obj; }
obj_t scheme_make_integer(long integer) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(integer_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_integer"); obj = addr; obj->integer.type = TYPE_INTEGER; obj->integer.integer = integer; } while(!mps_commit(obj_ap, addr, size)); return obj; }
obj_t scheme_make_special(char *string) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(special_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_special"); obj = addr; obj->special.type = TYPE_SPECIAL; obj->special.name = string; } while(!mps_commit(obj_ap, addr, size)); return obj; }
static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size, mps_align_t align) { mps_res_t res; size = alignUp(size, align); do { MPS_RESERVE_BLOCK(res, *p, ap, size); if(res != MPS_RES_OK) return res; } while(!mps_commit(ap, *p, size)); return MPS_RES_OK; }
static mps_addr_t make_with_permit(void) { size_t length = rnd() % 20, size = (length+2)*sizeof(mps_word_t); mps_addr_t p; mps_res_t res; do { MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, p, ap, size); if (res != MPS_RES_OK) die(res, "MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK"); res = dylan_init(p, size, exactRoots, exactRootsCOUNT); if (res != MPS_RES_OK) die(res, "dylan_init"); } while(!mps_commit(ap, p, size)); return p; }
obj_t scheme_make_symbol(size_t length, char string[]) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(offsetof(symbol_s, string) + length+1); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_symbol"); obj = addr; obj->symbol.type = TYPE_SYMBOL; obj->symbol.length = length; memcpy(obj->symbol.string, string, length+1); } while(!mps_commit(obj_ap, addr, size)); return obj; }
obj_t scheme_make_pair(obj_t car, obj_t cdr) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(pair_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_pair"); obj = addr; obj->pair.type = TYPE_PAIR; CAR(obj) = car; CDR(obj) = cdr; } while(!mps_commit(obj_ap, addr, size)); return obj; }
/* probably only ever cause a minor collection). */ static void churn(mps_ap_t ap) { int i; mps_addr_t p; mps_res_t e; for (i = 0; i < churnFACTOR; ++i) { do { MPS_RESERVE_BLOCK(e, p, ap, 4096); die(e, "MPS_RESERVE_BLOCK"); die(dylan_init(p, 4096, root, 1), "dylan_init"); } while (!mps_commit(ap, p, 4096)); } p = NULL; }
obj_t scheme_make_string(size_t length, char string[]) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(offsetof(string_s, string) + length+1); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_string"); obj = addr; obj->string.type = TYPE_STRING; obj->string.length = length; if (string) memcpy(obj->string.string, string, length+1); else memset(obj->string.string, 0, length+1); } while(!mps_commit(obj_ap, addr, size)); return obj; }
obj_t scheme_make_vector(size_t length, obj_t fill) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(offsetof(vector_s, vector) + length * sizeof(obj_t)); do { size_t i; mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_vector"); obj = addr; obj->vector.type = TYPE_VECTOR; obj->vector.length = length; for(i = 0; i < length; ++i) obj->vector.vector[i] = fill; } while(!mps_commit(obj_ap, addr, size)); return obj; }
static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size) { mps_addr_t addr; mps_res_t res; do { obj_t obj; res = mps_reserve(&addr, ap, size); if (res != MPS_RES_OK) return res; obj = addr; obj->size = size; obj->pad = 0; } while (!mps_commit(ap, addr, size)); *p = addr; return MPS_RES_OK; }
static mps_addr_t make(void) { size_t length = rnd() % 20, size = (length+2) * sizeof(mps_word_t); mps_addr_t p; mps_res_t res; do { MPS_RESERVE_BLOCK(res, p, ap, size); if (res) die(res, "MPS_RESERVE_BLOCK"); res = dylan_init(p, size, exactRoots, exactRootsCOUNT); if (res) die(res, "dylan_init"); } while(!mps_commit(ap, p, size)); totalSize += size; return p; }
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 mps_addr_t make(size_t rootsCount) { size_t length = rnd() % (scale * avLEN); size_t size = (length+2) * sizeof(mps_word_t); mps_addr_t p; mps_res_t res; do { MPS_RESERVE_BLOCK(res, p, ap, size); if (res) die(res, "MPS_RESERVE_BLOCK"); res = dylan_init(p, size, exactRoots, rootsCount); if (res) die(res, "dylan_init"); } while(!mps_commit(ap, p, size)); return p; }
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; mps_addr_t p; 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"); formatcomments = 0; 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"); do{ cdie( mps_reserve(&p, ap, (size_t) 64), "reserve"); } while (!mps_commit(ap, p, (size_t) HIGHBIT_SIZE+64)); }
obj_t scheme_make_table(size_t length, hash_t hashf, cmp_t cmpf) { obj_t obj; mps_addr_t addr; size_t l, size = ALIGN_OBJ(sizeof(table_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_table"); obj = addr; obj->table.type = TYPE_TABLE; obj->table.buckets = NULL; } while(!mps_commit(obj_ap, addr, size)); obj->table.hash = hashf; obj->table.cmp = cmpf; /* round up to next power of 2 */ for(l = 1; l < length; l *= 2); obj->table.buckets = scheme_make_buckets(l); mps_ld_reset(&obj->table.ld, scheme_arena); return obj; }
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; mps_addr_t p; 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"); formatcomments = 0; cdie( mps_pool_create(&pool, space, mps_class_amc(), format), "create pool"); cdie( mps_ap_create(&ap, pool, MPS_RANK_EXACT), "create ap"); do{ cdie( mps_reserve(&p, ap, (size_t) 64), "reserve"); } while (!mps_commit(NULL, p, (size_t) 64)); }
obj_t scheme_make_operator(char *name, entry_t entry, obj_t arguments, obj_t body, obj_t env, obj_t op_env) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(sizeof(operator_s)); do { mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_operator"); obj = addr; obj->operator.type = TYPE_OPERATOR; obj->operator.name = name; obj->operator.entry = entry; obj->operator.arguments = arguments; obj->operator.body = body; obj->operator.env = env; obj->operator.op_env = op_env; } while(!mps_commit(obj_ap, addr, size)); return obj; }
/* alloc_table -- create a table with n variable slots * * .assume.dylan-obj */ static mps_word_t *alloc_table(unsigned long n, mps_ap_t ap) { size_t objsize; void *p; mps_word_t *object; objsize = (4 + n) * sizeof(mps_word_t); objsize = (objsize + MPS_PF_ALIGN-1)/MPS_PF_ALIGN*MPS_PF_ALIGN; do { unsigned long i; die(mps_reserve(&p, ap, objsize), "Reserve Table\n"); object = p; object[0] = (mps_word_t)table_wrapper; object[1] = 0; object[2] = n << 2 | 1; for(i = 0; i < n; ++i) { object[3+i] = 0; } } while(!mps_commit(ap, p, objsize)); return object; }
obj_t scheme_make_buckets(size_t length) { obj_t obj; mps_addr_t addr; size_t size = ALIGN_OBJ(offsetof(buckets_s, bucket) + length * sizeof(obj->buckets.bucket[0])); do { size_t i; mps_res_t res = mps_reserve(&addr, obj_ap, size); if (res != MPS_RES_OK) error("out of memory in make_buckets"); obj = addr; obj->buckets.type = TYPE_BUCKETS; obj->buckets.length = length; obj->buckets.used = 0; obj->buckets.deleted = 0; for(i = 0; i < length; ++i) { obj->buckets.bucket[i].key = NULL; obj->buckets.bucket[i].value = NULL; } } while(!mps_commit(obj_ap, addr, size)); return obj; }
static mps_addr_t make(size_t roots_count) { size_t length = rnd() % (2*avLEN); size_t size = (length+2) * sizeof(mps_word_t); mps_addr_t p, userP; mps_res_t res; do { MPS_RESERVE_BLOCK(res, p, ap, size + headerSIZE); if (res) die(res, "MPS_RESERVE_BLOCK"); userP = (mps_addr_t)((char*)p + headerSIZE); res = dylan_init(userP, size, exactRoots, roots_count); if (res) die(res, "dylan_init"); ((int*)p)[0] = realHeader; ((int*)p)[1] = 0xED0ED; } while(!mps_commit(ap, p, size + headerSIZE)); return userP; }
mycell *allocone(mps_ap_t ap, int size) { mps_addr_t p; mycell *q; int i; size_t bytes; size_t alignment; bytes = offsetof(struct data, ref) + size*sizeof(struct refitem); alignment = MPS_PF_ALIGN; /* needed to make it as wide as size_t */ /* twiddle the value of size to make it aligned */ bytes = (bytes+alignment-1) & ~(alignment-1); do { die(mps_reserve(&p, ap, bytes), "Reserve: "); INCCOUNT(RESERVE_COUNT); q=p; q->data.tag = MCdata; q->data.id = nextid; q->data.copycount = 0; q->data.numrefs = size; q->data.checkedflag = 0; q->data.size = bytes; for(i=0; i<size; i+=1) { q->data.ref[i].addr = NULL; q->data.ref[i].id = 0; } } while (!mps_commit(ap, p, bytes)); INCCOUNT(ALLOC_COUNT); commentif(alloccomments, "allocated id %li at %p.", nextid, q); nextid += 1; return q; }
static void test(void) { mps_arena_t arena; mps_pool_t pool; mps_fmt_t format; mps_ap_t ap; mps_addr_t p; cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena"); cdie(mps_fmt_create_k(&format, arena, mps_args_none), "create format"); MPS_ARGS_BEGIN(args) { MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format); cdie(mps_pool_create_k(&pool, arena, mps_class_ams(), args), "create pool"); } MPS_ARGS_END(args); MPS_ARGS_BEGIN(args) { MPS_ARGS_ADD(args, MPS_KEY_RANK, mps_rank_weak()); cdie(mps_ap_create_k(&ap, pool, args), "create ap"); } MPS_ARGS_END(args); do { cdie(mps_reserve(&p, ap, 0x100), "Reserve: "); } while (!mps_commit(ap, p, 0x100)); comment("Committed."); mps_ap_destroy(ap); comment("Destroyed ap."); mps_pool_destroy(pool); comment("Destroyed pool."); mps_fmt_destroy(format); comment("Destroyed format."); mps_arena_destroy(arena); comment("Destroyed arena."); }
static mps_word_t *alloc_table(size_t n, mps_ap_t ap) { size_t objsize; void *p; mps_word_t *object; objsize = (3 + n) * sizeof(mps_word_t); objsize = size_tAlignUp(objsize, MPS_PF_ALIGN); do { size_t i; die(mps_reserve(&p, ap, objsize), "Reserve Table\n"); object = p; object[0] = (mps_word_t)table_wrapper; object[1] = 0; object[2] = n << 2 | 1; for(i = 0; i < n; ++i) { object[3+i] = 0; } } while(!mps_commit(ap, p, objsize)); return object; }
static mps_addr_t make(void) { size_t length = rnd() % (avLEN * 2); size_t size = (length+2) * sizeof(mps_word_t); mps_addr_t p; mps_res_t res; alloc_bytes += size; for(;;) { mps_bool_t commit_res; MPS_RESERVE_BLOCK(res, p, ap, size); if(res) die(res, "MPS_RESERVE_BLOCK"); res = dylan_init(p, size, exactRoots, exactRootsCOUNT); if(res) die(res, "dylan_init"); commit_res = mps_commit(ap, p, size); if(commit_res) break; } return p; }
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; mps_addr_t p; mps_addr_t q; 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"); do { cdie(mps_reserve(&p, ap, 0x100), "Reserve: "); q = (mps_addr_t) ((char *)p + 0x10); } while (!mps_commit(ap, q, 0x100)); comment("Committed."); 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 *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_arena_t arena; mps_pool_t pool; mps_thr_t thread; mps_root_t root; mps_ap_t apA, apB; mps_fmt_t format; mps_chain_t chain; mycell *ambigref; size_t bytes; size_t alignment; mps_addr_t q; int i; formatcomments = 1; cdie(mps_arena_create(&arena, mps_arena_class_vm(), mmqaArenaSIZE), "create arena"); cdie(mps_thread_reg(&thread, arena), "register thread"); cdie(mps_root_create_reg(&root, arena, mps_rank_ambig(), 0, thread, mps_stack_scan_ambig, stackpointer, 0), "create root"); cdie(mps_fmt_create_A(&format, arena, &fmtA), "create format"); cdie(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); cdie(mmqa_pool_create_chain(&pool, arena, mps_class_amc(), format, chain), "create pool"); die(mps_ap_create(&apA, pool, mps_rank_exact()), "create apA"); die(mps_ap_create(&apB, pool, mps_rank_exact()), "create apB"); bytes = offsetof(struct data, ref) + sizeof(struct refitem); alignment = MPS_PF_ALIGN; bytes = (bytes+alignment-1)&~(alignment-1); die(mps_reserve(&q, apB, bytes), "reserve: "); comment("Reserve"); ambigref = q; ambigref->data.tag = MCdata; ambigref->data.id = MCerrorid; ambigref->data.numrefs = 0; ambigref->data.size = bytes; comment("Midallocation"); for(i = 0; i < 40; i++) { allocdumb(apA, 1024*256); } comment("Commit"); asserts(mps_commit(apB, q, bytes) == 0, "Commit succeeded!"); comment("Postallocation"); for(i = 0; i < 40; i++) { allocdumb(apA, 1024*256); } comment("Finished"); mps_ap_destroy(apA); mps_ap_destroy(apB); mps_pool_destroy(pool); mps_chain_destroy(chain); mps_fmt_destroy(format); mps_root_destroy(root); mps_thread_dereg(thread); mps_arena_destroy(arena); comment("Destroyed arena."); }
static void *test(void *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; }