diff --git a/mps/code/apss.c b/mps/code/apss.c index 48a21e1d3fd..4f77e8bbc85 100644 --- a/mps/code/apss.c +++ b/mps/code/apss.c @@ -87,6 +87,14 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options, check_allocated_size(pool, ap, allocated); } + /* Check introspection functions */ + for (i = 0; i < NELEMS(ps); ++i) { + mps_pool_t addr_pool = NULL; + Insist(mps_arena_has_addr(arena, ps[i])); + Insist(mps_addr_pool(&addr_pool, arena, ps[i])); + Insist(addr_pool == pool); + } + mps_pool_check_fenceposts(pool); for (k=0; khasFreeLand); + /* We're about to free the memory occupied by the free land, which + contains a CBS. We want to make sure that LandFinish doesn't try + to check the CBS, so nuke it here. TODO: LandReset? */ + arena->freeLandStruct.splayTreeStruct.root = TreeEMPTY; + /* The CBS block pool can't free its own memory via ArenaFree because * that would use the free land. */ MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor, @@ -998,7 +1003,7 @@ static Res arenaAllocFromLand(Tract *tractReturn, ZoneSet zones, Bool high, { Arena arena; RangeStruct range, oldRange; - Chunk chunk; + Chunk chunk = NULL; /* suppress uninit warning */ Bool found, b; Index baseIndex; Count pages; @@ -1450,10 +1455,10 @@ static void ArenaTrivCompact(Arena arena, Trace trace) Bool ArenaHasAddr(Arena arena, Addr addr) { - Seg seg; + Tract tract; AVERT(Arena, arena); - return SegOfAddr(&seg, arena, addr); + return TractOfAddr(&tract, arena, addr); } diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c index ba34a7c70ef..f5666a1e7e6 100644 --- a/mps/code/arenavm.c +++ b/mps/code/arenavm.c @@ -992,7 +992,7 @@ static Size arenaUnmapSpare(Arena arena, Size size, Chunk filter) while (RingNext(node) != &vmArena->spareRing && purged < size) { Ring next = RingNext(node); Page page = PageOfSpareRing(next); - Chunk chunk; + Chunk chunk = NULL; /* suppress uninit warning */ Bool b; /* Use the fact that the page table resides in the chunk to find the chunk that owns the page. */ diff --git a/mps/code/djbench.c b/mps/code/djbench.c index 33cf1d4bdb9..fbc6dcabc1c 100644 --- a/mps/code/djbench.c +++ b/mps/code/djbench.c @@ -13,10 +13,15 @@ #include "mps.c" -#include "getopt.h" #include "testlib.h" #include "testthr.h" +#ifdef MPS_OS_W3 +#include "getopt.h" +#else +#include +#endif + #include /* fprintf, stderr */ #include /* alloca, exit, EXIT_SUCCESS, EXIT_FAILURE */ #include /* CLOCKS_PER_SEC, clock */ diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c index 9f22226dc17..2be7f083735 100644 --- a/mps/code/finalcv.c +++ b/mps/code/finalcv.c @@ -24,6 +24,9 @@ #include "mps.h" #include "mpsavm.h" #include "mpscamc.h" +#include "mpscams.h" +#include "mpscawl.h" +#include "mpsclo.h" #include "mpslib.h" #include "mpstd.h" #include "testlib.h" @@ -37,6 +40,7 @@ #define finalizationRATE 6 #define gcINTERVAL ((size_t)150 * 1024) #define collectionCOUNT 3 +#define messageCOUNT 3 /* 3 words: wrapper | vector-len | first-slot */ #define vectorSIZE (3*sizeof(mps_word_t)) @@ -95,35 +99,37 @@ enum { }; -static void *test(void *arg, size_t s) +static void test(mps_arena_t arena, mps_pool_class_t pool_class) { - unsigned i; /* index */ + size_t i; /* index */ mps_ap_t ap; mps_fmt_t fmt; mps_chain_t chain; - mps_pool_t amc; + mps_pool_t pool; 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; + size_t messages = 0; + void *p; - arena = (mps_arena_t)arg; - (void)s; + printf("---- finalcv: pool class %s ----\n", pool_class->name); 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"); + MPS_ARGS_BEGIN(args) { + MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain); + MPS_ARGS_ADD(args, MPS_KEY_FORMAT, fmt); + die(mps_pool_create_k(&pool, arena, pool_class, args), "pool_create\n"); + } MPS_ARGS_END(args); 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"); + die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create\n"); /* Make registered-for-finalization objects. */ /* */ @@ -142,12 +148,10 @@ static void *test(void *arg, size_t s) } p = NULL; - die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe"); - mps_message_type_enable(arena, mps_message_type_finalization()); /* */ - while (mps_collections(arena) < collectionCOUNT) { + while (messages < messageCOUNT && mps_collections(arena) < collectionCOUNT) { /* Perhaps cause (minor) collection */ churn(ap); @@ -197,36 +201,34 @@ static void *test(void *arg, size_t s) if (rnd() % 2 == 0) root[objind] = objaddr; mps_message_discard(arena, message); + ++ messages; } } - /* @@@@ missing */ - - mps_arena_park(arena); mps_ap_destroy(ap); mps_root_destroy(mps_root[1]); mps_root_destroy(mps_root[0]); - mps_pool_destroy(amc); + mps_pool_destroy(pool); mps_chain_destroy(chain); mps_fmt_destroy(fmt); - - return NULL; } int main(int argc, char *argv[]) { mps_arena_t arena; - mps_thr_t thread; - void *r; testlib_init(argc, argv); die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), "arena_create\n"); - die(mps_thread_reg(&thread, arena), "thread_reg\n"); - mps_tramp(&r, test, arena, 0); - mps_thread_dereg(thread); + + test(arena, mps_class_amc()); + test(arena, mps_class_amcz()); + test(arena, mps_class_awl()); + test(arena, mps_class_ams()); + test(arena, mps_class_lo()); + mps_arena_destroy(arena); printf("%s: Conclusion: Failed to find any defects.\n", argv[0]); diff --git a/mps/code/gcbench.c b/mps/code/gcbench.c index a65a06108e7..2a61a8662c5 100644 --- a/mps/code/gcbench.c +++ b/mps/code/gcbench.c @@ -7,13 +7,18 @@ */ #include "mps.c" -#include "getopt.h" #include "testlib.h" #include "testthr.h" #include "fmtdy.h" #include "fmtdytst.h" #include "mpm.h" +#ifdef MPS_OS_W3 +#include "getopt.h" +#else +#include +#endif + #include /* fprintf, printf, putchars, sscanf, stderr, stdout */ #include /* alloca, exit, EXIT_FAILURE, EXIT_SUCCESS, strtoul */ #include /* clock, CLOCKS_PER_SEC */ diff --git a/mps/code/global.c b/mps/code/global.c index 05a941b1c4f..65948706928 100644 --- a/mps/code/global.c +++ b/mps/code/global.c @@ -153,6 +153,7 @@ Bool GlobalsCheck(Globals arenaGlobals) } CHECKD_NOSIG(Ring, &arena->threadRing); + CHECKD_NOSIG(Ring, &arena->deadRing); CHECKL(BoolCheck(arena->insideShield)); CHECKL(arena->shCacheLimit <= ShieldCacheSIZE); @@ -277,6 +278,7 @@ Res GlobalsInit(Globals arenaGlobals) arenaGlobals->rememberedSummaryIndex = 0; RingInit(&arena->threadRing); + RingInit(&arena->deadRing); arena->threadSerial = (Serial)0; RingInit(&arena->formatRing); arena->formatSerial = (Serial)0; @@ -405,6 +407,7 @@ void GlobalsFinish(Globals arenaGlobals) RingFinish(&arena->chainRing); RingFinish(&arena->messageRing); RingFinish(&arena->threadRing); + RingFinish(&arena->deadRing); for(rank = RankMIN; rank < RankLIMIT; ++rank) RingFinish(&arena->greyRing[rank]); RingFinish(&arenaGlobals->rootRing); @@ -495,6 +498,7 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals) AVER(RingIsSingle(&arena->chainRing)); AVER(RingIsSingle(&arena->messageRing)); AVER(RingIsSingle(&arena->threadRing)); + AVER(RingIsSingle(&arena->deadRing)); AVER(RingIsSingle(&arenaGlobals->rootRing)); for(rank = RankMIN; rank < RankLIMIT; ++rank) AVER(RingIsSingle(&arena->greyRing[rank])); @@ -858,17 +862,19 @@ Bool ArenaStep(Globals globals, double interval, double multiplier) Res ArenaFinalize(Arena arena, Ref obj) { Res res; + Pool refpool; AVERT(Arena, arena); - AVER(ArenaHasAddr(arena, (Addr)obj)); + AVER(PoolOfAddr(&refpool, arena, (Addr)obj)); + AVER(PoolHasAttr(refpool, AttrGC)); if (!arena->isFinalPool) { - Pool pool; + Pool finalpool; - res = PoolCreate(&pool, arena, PoolClassMRG(), argsNone); + res = PoolCreate(&finalpool, arena, PoolClassMRG(), argsNone); if (res != ResOK) return res; - arena->finalPool = pool; + arena->finalPool = finalpool; arena->isFinalPool = TRUE; } diff --git a/mps/code/mpm.c b/mps/code/mpm.c index d3c32a66daf..aba1ac2f5cb 100644 --- a/mps/code/mpm.c +++ b/mps/code/mpm.c @@ -1,7 +1,7 @@ /* mpm.c: GENERAL MPM SUPPORT * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * * .purpose: Miscellaneous support for the implementation of the MPM * and pool classes. @@ -137,6 +137,16 @@ Bool AlignCheck(Align align) } +/* AccessSetCheck -- check that an access set is valid */ + +Bool AccessSetCheck(AccessSet mode) +{ + CHECKL(mode < ((ULongest)1 << AccessLIMIT)); + UNUSED(mode); /* see .check.unused */ + return TRUE; +} + + #endif /* defined(AVER_AND_CHECK) */ @@ -638,7 +648,7 @@ Bool StringEqual(const char *s1, const char *s2) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpm.h b/mps/code/mpm.h index a2ceae76bef..6b3ebc5e88f 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -1,7 +1,7 @@ /* mpm.h: MEMORY POOL MANAGER DEFINITIONS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .trans.bufferinit: The Buffer data structure has an Init field and @@ -46,6 +46,7 @@ extern Bool FunCheck(Fun f); extern Bool ShiftCheck(Shift shift); extern Bool AttrCheck(Attr attr); extern Bool RootVarCheck(RootVar rootVar); +extern Bool AccessSetCheck(AccessSet mode); /* Address/Size Interface -- see */ @@ -519,6 +520,7 @@ extern Ring GlobalsRememberedSummaryRing(Globals); #define GlobalsArena(glob) PARENT(ArenaStruct, globals, glob) #define ArenaThreadRing(arena) (&(arena)->threadRing) +#define ArenaDeadRing(arena) (&(arena)->deadRing) #define ArenaEpoch(arena) ((arena)->epoch) /* .epoch.ts */ #define ArenaTrace(arena, ti) (&(arena)->trace[ti]) #define ArenaZoneShift(arena) ((arena)->zoneShift) @@ -1055,7 +1057,7 @@ extern LandClass LandClassGet(void); /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h index c5bf54bdc2b..d893c25afc4 100644 --- a/mps/code/mpmst.h +++ b/mps/code/mpmst.h @@ -755,6 +755,7 @@ typedef struct mps_arena_s { /* thread fields () */ RingStruct threadRing; /* ring of attached threads */ + RingStruct deadRing; /* ring of dead threads */ Serial threadSerial; /* serial of next thread */ /* shield fields () */ diff --git a/mps/code/mps.xcodeproj/project.pbxproj b/mps/code/mps.xcodeproj/project.pbxproj index 3278a570222..5e8c90c57fa 100644 --- a/mps/code/mps.xcodeproj/project.pbxproj +++ b/mps/code/mps.xcodeproj/project.pbxproj @@ -288,7 +288,6 @@ 3124CAFB156BE82000753214 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; 3124CAFC156BE82900753214 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; 3150AE53156ABA2500A6E22A /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; - 318DA8D21892B13B0089718C /* getoptl.c in Sources */ = {isa = PBXBuildFile; fileRef = 318DA8D11892B13B0089718C /* getoptl.c */; }; 318DA8D31892B27E0089718C /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; 31A47BA4156C1E130039B1C2 /* mps.c in Sources */ = {isa = PBXBuildFile; fileRef = 31A47BA3156C1E130039B1C2 /* mps.c */; }; 31D60007156D3C6200337B26 /* segsmss.c in Sources */ = {isa = PBXBuildFile; fileRef = 31D60006156D3C5F00337B26 /* segsmss.c */; }; @@ -330,7 +329,6 @@ 31FCAE161769244F008C034C /* mps.c in Sources */ = {isa = PBXBuildFile; fileRef = 31A47BA3156C1E130039B1C2 /* mps.c */; }; 31FCAE19176924D4008C034C /* scheme.c in Sources */ = {isa = PBXBuildFile; fileRef = 31FCAE18176924D4008C034C /* scheme.c */; }; 6313D46918A400B200EB03EF /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; - 6313D46A18A400B200EB03EF /* getoptl.c in Sources */ = {isa = PBXBuildFile; fileRef = 318DA8D11892B13B0089718C /* getoptl.c */; }; 6313D47318A4028E00EB03EF /* djbench.c in Sources */ = {isa = PBXBuildFile; fileRef = 318DA8CE1892B1210089718C /* djbench.c */; }; 6313D47418A4029200EB03EF /* gcbench.c in Sources */ = {isa = PBXBuildFile; fileRef = 6313D46618A3FDC900EB03EF /* gcbench.c */; }; 6313D47518A40C6300EB03EF /* fmtdytst.c in Sources */ = {isa = PBXBuildFile; fileRef = 3124CAC7156BE48D00753214 /* fmtdytst.c */; }; @@ -1656,8 +1654,6 @@ 317B3C2A1731830100F9A469 /* arg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = arg.c; sourceTree = ""; }; 318DA8CD1892B0F30089718C /* djbench */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = djbench; sourceTree = BUILT_PRODUCTS_DIR; }; 318DA8CE1892B1210089718C /* djbench.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = djbench.c; sourceTree = ""; }; - 318DA8D01892B13B0089718C /* getopt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = getopt.h; sourceTree = ""; }; - 318DA8D11892B13B0089718C /* getoptl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = getoptl.c; sourceTree = ""; }; 31A47BA3156C1E130039B1C2 /* mps.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = mps.c; sourceTree = ""; }; 31A47BA5156C1E5E0039B1C2 /* ssixi3.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = ssixi3.c; sourceTree = ""; }; 31C83ADD1786281C0031A0DB /* protxc.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = protxc.h; sourceTree = ""; }; @@ -2297,8 +2293,6 @@ 318DA8C21892B0B20089718C /* Benchmarks */ = { isa = PBXGroup; children = ( - 318DA8D01892B13B0089718C /* getopt.h */, - 318DA8D11892B13B0089718C /* getoptl.c */, 318DA8CE1892B1210089718C /* djbench.c */, 6313D46618A3FDC900EB03EF /* gcbench.c */, ); @@ -3968,7 +3962,6 @@ files = ( 318DA8D31892B27E0089718C /* testlib.c in Sources */, 6313D47318A4028E00EB03EF /* djbench.c in Sources */, - 318DA8D21892B13B0089718C /* getoptl.c in Sources */, 22561A9A18F426BB00372C66 /* testthrix.c in Sources */, ); runOnlyForDeploymentPostprocessing = 0; @@ -4077,7 +4070,6 @@ 6313D47418A4029200EB03EF /* gcbench.c in Sources */, 6313D47518A40C6300EB03EF /* fmtdytst.c in Sources */, 6313D47618A40C7B00EB03EF /* fmtdy.c in Sources */, - 6313D46A18A400B200EB03EF /* getoptl.c in Sources */, 22561A9B18F426F300372C66 /* testthrix.c in Sources */, ); runOnlyForDeploymentPostprocessing = 0; diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c index 87d1e02419e..aa563683f4f 100644 --- a/mps/code/mpsicv.c +++ b/mps/code/mpsicv.c @@ -233,6 +233,7 @@ static void ap_create_v_test(mps_pool_t pool, ...) /* addr_pool_test * * intended to test: + * mps_arena_has_addr * mps_addr_pool * mps_addr_fmt */ @@ -270,6 +271,7 @@ static void addr_pool_test(mps_arena_t arena, addr = obj1; pool = poolDistinguished; fmt = fmtDistinguished; + cdie(mps_arena_has_addr(arena, addr), "mps_arena_has_addr 0a"); b = mps_addr_pool(&pool, arena, addr); /* printf("b %d; pool %p; sig %lx\n", b, (void *)pool, b ? ((mps_word_t*)pool)[0] : (mps_word_t)0); */ @@ -283,6 +285,7 @@ static void addr_pool_test(mps_arena_t arena, addr = obj2; pool = poolDistinguished; fmt = fmtDistinguished; + cdie(mps_arena_has_addr(arena, addr), "mps_arena_has_addr 0b"); b = mps_addr_pool(&pool, arena, addr); /* printf("b %d; pool %p; sig %lx\n", b, (void *)pool, b ? ((mps_word_t*)pool)[0] : (mps_word_t)0); */ @@ -296,6 +299,7 @@ static void addr_pool_test(mps_arena_t arena, addr = &pool; /* point at stack, not in any chunk */ pool = poolDistinguished; fmt = fmtDistinguished; + cdie(mps_arena_has_addr(arena, addr) == FALSE, "mps_arena_has_addr 5"); b = mps_addr_pool(&pool, arena, addr); cdie(b == FALSE && pool == poolDistinguished, "mps_addr_pool 5"); b = mps_addr_fmt(&fmt, arena, addr); diff --git a/mps/code/pool.c b/mps/code/pool.c index 945a846edcb..f939bca84e9 100644 --- a/mps/code/pool.c +++ b/mps/code/pool.c @@ -1,7 +1,7 @@ /* pool.c: POOL IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2001 Global Graphics Software. * * DESIGN @@ -328,7 +328,7 @@ Res PoolAccess(Pool pool, Seg seg, Addr addr, AVERT(Seg, seg); AVER(SegBase(seg) <= addr); AVER(addr < SegLimit(seg)); - /* Can't check mode as there is no check method */ + AVERT(AccessSet, mode); /* Can't check MutatorFaultContext as there is no check method */ return (*pool->class->access)(pool, seg, addr, mode, context); @@ -694,7 +694,7 @@ Bool PoolHasRange(Pool pool, Addr base, Addr limit) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolabs.c b/mps/code/poolabs.c index 712f24152e5..30f5d0f999e 100644 --- a/mps/code/poolabs.c +++ b/mps/code/poolabs.c @@ -1,7 +1,7 @@ /* poolabs.c: ABSTRACT POOL CLASSES * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * PURPOSE @@ -334,7 +334,7 @@ Res PoolNoAccess(Pool pool, Seg seg, Addr addr, AVERT(Seg, seg); AVER(SegBase(seg) <= addr); AVER(addr < SegLimit(seg)); - /* can't check AccessSet as there is no Check method */ + AVERT(AccessSet, mode); /* can't check context as there is no Check method */ UNUSED(mode); UNUSED(context); @@ -360,7 +360,7 @@ Res PoolSegAccess(Pool pool, Seg seg, Addr addr, AVER(SegBase(seg) <= addr); AVER(addr < SegLimit(seg)); AVER(SegPool(seg) == pool); - /* can't check AccessSet as there is no Check method */ + AVERT(AccessSet, mode); /* can't check context as there is no Check method */ UNUSED(addr); @@ -396,7 +396,7 @@ Res PoolSingleAccess(Pool pool, Seg seg, Addr addr, AVER(SegBase(seg) <= addr); AVER(addr < SegLimit(seg)); AVER(SegPool(seg) == pool); - /* can't check AccessSet as there is no Check method */ + AVERT(AccessSet, mode); /* can't check context as there is no Check method */ arena = PoolArena(pool); @@ -691,7 +691,7 @@ Size PoolNoSize(Pool pool) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c index 01ca12ea46f..5bb0e6b9025 100644 --- a/mps/code/poolawl.c +++ b/mps/code/poolawl.c @@ -1,7 +1,7 @@ /* poolawl.c: AUTOMATIC WEAK LINKED POOL CLASS * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * * * DESIGN @@ -1206,6 +1206,7 @@ static Res AWLAccess(Pool pool, Seg seg, Addr addr, AVER(SegBase(seg) <= addr); AVER(addr < SegLimit(seg)); AVER(SegPool(seg) == pool); + AVERT(AccessSet, mode); /* Attempt scanning a single reference if permitted */ if(AWLCanTrySingleAccess(PoolArena(pool), awl, seg, addr)) { @@ -1375,7 +1376,7 @@ static Bool AWLCheck(AWL awl) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c index f329b87f110..2cb5e7a2f21 100644 --- a/mps/code/poolmrg.c +++ b/mps/code/poolmrg.c @@ -745,7 +745,12 @@ Res MRGRegister(Pool pool, Ref ref) } -/* MRGDeregister -- deregister (once) an object for finalization */ +/* MRGDeregister -- deregister (once) an object for finalization + * + * TODO: Definalization loops over all finalizable objects in the heap, + * and so using it could accidentally be disastrous for performance. + * See job003953 and back out changelist 187123 if this is fixed. + */ Res MRGDeregister(Pool pool, Ref obj) { diff --git a/mps/code/protan.c b/mps/code/protan.c index 1959e42395b..0e4771f18da 100644 --- a/mps/code/protan.c +++ b/mps/code/protan.c @@ -1,7 +1,7 @@ /* protan.c: ANSI MEMORY PROTECTION * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * * * DESIGN @@ -36,8 +36,7 @@ Size ProtGranularity(void) void ProtSet(Addr base, Addr limit, AccessSet pm) { AVER(base < limit); - /* .improve.protset.check: There is nor AccessSetCheck, so we */ - /* don't check it. */ + AVERT(AccessSet, pm); UNUSED(pm); NOOP; } @@ -74,7 +73,7 @@ void ProtSync(Arena arena) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/protix.c b/mps/code/protix.c index ea674ae53d5..a243b009491 100644 --- a/mps/code/protix.c +++ b/mps/code/protix.c @@ -1,7 +1,7 @@ /* protix.c: PROTECTION FOR UNIX * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * * Somewhat generic across different Unix systems. Shared between * OS X, FreeBSD, and Linux. @@ -66,6 +66,7 @@ void ProtSet(Addr base, Addr limit, AccessSet mode) AVER(base < limit); AVER(base != 0); AVER(AddrOffset(base, limit) <= INT_MAX); /* should be redundant */ + AVERT(AccessSet, mode); /* Convert between MPS AccessSet and UNIX PROT thingies. In this function, AccessREAD means protect against read accesses @@ -122,7 +123,7 @@ Size ProtGranularity(void) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/protw3.c b/mps/code/protw3.c index 30c3edc0975..a8dddd74fe2 100644 --- a/mps/code/protw3.c +++ b/mps/code/protw3.c @@ -1,7 +1,7 @@ /* protw3.c: PROTECTION FOR WIN32 * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. */ #include "mpm.h" @@ -26,6 +26,7 @@ void ProtSet(Addr base, Addr limit, AccessSet mode) AVER(base < limit); AVER(base != 0); + AVERT(AccessSet, mode); newProtect = PAGE_EXECUTE_READWRITE; if((mode & AccessWRITE) != 0) @@ -140,7 +141,7 @@ void ProtSync(Arena arena) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/root.c b/mps/code/root.c index 6439f3c15ab..407b84dc246 100644 --- a/mps/code/root.c +++ b/mps/code/root.c @@ -154,7 +154,7 @@ Bool RootCheck(Root root) CHECKL(root->protBase != (Addr)0); CHECKL(root->protLimit != (Addr)0); CHECKL(root->protBase < root->protLimit); - /* there is no AccessSetCheck */ + CHECKL(AccessSetCheck(root->pm)); } else { CHECKL(root->protBase == (Addr)0); CHECKL(root->protLimit == (Addr)0); @@ -606,7 +606,7 @@ Bool RootOfAddr(Root *rootReturn, Arena arena, Addr addr) void RootAccess(Root root, AccessSet mode) { AVERT(Root, root); - /* Can't AVERT mode. */ + AVERT(AccessSet, mode); AVER((root->pm & mode) != AccessSetEMPTY); AVER(mode == AccessWRITE); /* only write protection supported */ diff --git a/mps/code/shield.c b/mps/code/shield.c index 55625664ca7..0dfc1945db6 100644 --- a/mps/code/shield.c +++ b/mps/code/shield.c @@ -1,7 +1,7 @@ /* shield.c: SHIELD IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license. * * See: idea.shield, design.mps.shield. * @@ -83,7 +83,7 @@ void (ShieldSuspend)(Arena arena) AVER(arena->insideShield); if (!arena->suspended) { - ThreadRingSuspend(ArenaThreadRing(arena)); + ThreadRingSuspend(ArenaThreadRing(arena), ArenaDeadRing(arena)); arena->suspended = TRUE; } } @@ -105,6 +105,7 @@ static void protLower(Arena arena, Seg seg, AccessSet mode) AVERT_CRITICAL(Arena, arena); UNUSED(arena); AVERT_CRITICAL(Seg, seg); + AVERT_CRITICAL(AccessSet, mode); if (SegPM(seg) & mode) { SegSetPM(seg, SegPM(seg) & ~mode); @@ -191,6 +192,7 @@ void (ShieldRaise) (Arena arena, Seg seg, AccessSet mode) /* can't check seg. Nor can we check arena as that checks the */ /* segs in the cache. */ + AVERT(AccessSet, mode); AVER((SegSM(seg) & mode) == AccessSetEMPTY); SegSetSM(seg, SegSM(seg) | mode); /* inv.prot.shield preserved */ @@ -204,6 +206,7 @@ void (ShieldRaise) (Arena arena, Seg seg, AccessSet mode) void (ShieldLower)(Arena arena, Seg seg, AccessSet mode) { /* Don't check seg or arena, see .seg.broken */ + AVERT(AccessSet, mode); AVER((SegSM(seg) & mode) == mode); /* synced(seg) is not changed by the following * preserving inv.unsynced.suspended @@ -263,7 +266,7 @@ void (ShieldLeave)(Arena arena) /* Ensuring the mutator is running at this point * guarantees inv.outside.running */ if (arena->suspended) { - ThreadRingResume(ArenaThreadRing(arena)); + ThreadRingResume(ArenaThreadRing(arena), ArenaDeadRing(arena)); arena->suspended = FALSE; } arena->insideShield = FALSE; @@ -336,7 +339,7 @@ void (ShieldCover)(Arena arena, Seg seg) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2015 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/th.h b/mps/code/th.h index ea56be2dd42..ed35733002c 100644 --- a/mps/code/th.h +++ b/mps/code/th.h @@ -47,13 +47,14 @@ extern void ThreadDeregister(Thread thread, Arena arena); /* ThreadRingSuspend/Resume * - * These functions suspend/resume the threads on the ring. - * If the current thread is among them, it is not suspended, - * nor is any attempt to resume it made. + * These functions suspend/resume the threads on the ring. If the + * current thread is among them, it is not suspended, nor is any + * attempt to resume it made. Threads that can't be suspended/resumed + * because they are dead are moved to deadRing. */ -extern void ThreadRingSuspend(Ring threadRing); -extern void ThreadRingResume(Ring threadRing); +extern void ThreadRingSuspend(Ring threadRing, Ring deadRing); +extern void ThreadRingResume(Ring threadRing, Ring deadRing); /* ThreadRingThread diff --git a/mps/code/than.c b/mps/code/than.c index f9b0e51e148..fb3219c270d 100644 --- a/mps/code/than.c +++ b/mps/code/than.c @@ -86,14 +86,16 @@ void ThreadDeregister(Thread thread, Arena arena) } -void ThreadRingSuspend(Ring threadRing) +void ThreadRingSuspend(Ring threadRing, Ring deadRing) { AVERT(Ring, threadRing); + AVERT(Ring, deadRing); } -void ThreadRingResume(Ring threadRing) +void ThreadRingResume(Ring threadRing, Ring deadRing) { AVERT(Ring, threadRing); + AVERT(Ring, deadRing); } Thread ThreadRingThread(Ring threadRing) diff --git a/mps/code/thix.c b/mps/code/thix.c index 6da41e572d6..c8f3d6ca52a 100644 --- a/mps/code/thix.c +++ b/mps/code/thix.c @@ -12,10 +12,10 @@ * * ASSUMPTIONS * - * .error.resume: PThreadextResume is assumed to succeed unless the thread - * has been destroyed. - * .error.suspend: PThreadextSuspend is assumed to succeed unless the thread - * has been destroyed. In this case, the suspend context is set to NULL; + * .error.resume: PThreadextResume is assumed to succeed unless the + * thread has been terminated. + * .error.suspend: PThreadextSuspend is assumed to succeed unless the + * thread has been terminated. * * .stack.full-descend: assumes full descending stack. * i.e. stack pointer points to the last allocated location; @@ -48,9 +48,10 @@ typedef struct mps_thr_s { /* PThreads thread structure */ Serial serial; /* from arena->threadSerial */ Arena arena; /* owning arena */ RingStruct arenaRing; /* threads attached to arena */ + Bool alive; /* thread believed to be alive? */ PThreadextStruct thrextStruct; /* PThreads extension */ pthread_t id; /* Pthread object of thread */ - MutatorFaultContext mfc; /* Context if thread is suspended */ + MutatorFaultContext mfc; /* Context if suspended, NULL if not */ } ThreadStruct; @@ -62,6 +63,7 @@ Bool ThreadCheck(Thread thread) CHECKU(Arena, thread->arena); CHECKL(thread->serial < thread->arena->threadSerial); CHECKD_NOSIG(Ring, &thread->arenaRing); + CHECKL(BoolCheck(thread->alive)); CHECKD(PThreadext, &thread->thrextStruct); return TRUE; } @@ -98,6 +100,7 @@ Res ThreadRegister(Thread *threadReturn, Arena arena) thread->serial = arena->threadSerial; ++arena->threadSerial; thread->arena = arena; + thread->alive = TRUE; thread->mfc = NULL; PThreadextInit(&thread->thrextStruct, thread->id); @@ -130,69 +133,83 @@ void ThreadDeregister(Thread thread, Arena arena) } -/* mapThreadRing -- map over threads on ring calling a function on each one - * except the current thread +/* mapThreadRing -- map over threads on ring calling a function on + * each one except the current thread. + * + * Threads that are found to be dead (that is, if func returns FALSE) + * are moved to deadRing, in order to implement + * design.thread-manager.sol.thread.term.attempt. */ -static void mapThreadRing(Ring threadRing, void (*func)(Thread)) +static void mapThreadRing(Ring threadRing, Ring deadRing, Bool (*func)(Thread)) { Ring node, next; pthread_t self; AVERT(Ring, threadRing); + AVERT(Ring, deadRing); + AVER(FUNCHECK(func)); self = pthread_self(); RING_FOR(node, threadRing, next) { Thread thread = RING_ELT(Thread, arenaRing, node); AVERT(Thread, thread); - if(! pthread_equal(self, thread->id)) /* .thread.id */ - (*func)(thread); + AVER(thread->alive); + if (!pthread_equal(self, thread->id) /* .thread.id */ + && !(*func)(thread)) + { + thread->alive = FALSE; + RingRemove(&thread->arenaRing); + RingAppend(deadRing, &thread->arenaRing); + } } } -/* ThreadRingSuspend -- suspend all threads on a ring, expect the current one */ +/* ThreadRingSuspend -- suspend all threads on a ring, except the + * current one. + */ - -static void threadSuspend(Thread thread) +static Bool threadSuspend(Thread thread) { - /* .error.suspend */ - /* In the error case (PThreadextSuspend returning ResFAIL), we */ - /* assume the thread has been destroyed. */ - /* In which case we simply continue. */ + /* .error.suspend: if PThreadextSuspend fails, we assume the thread + * has been terminated. */ Res res; + AVER(thread->mfc == NULL); res = PThreadextSuspend(&thread->thrextStruct, &thread->mfc); - if(res != ResOK) - thread->mfc = NULL; + AVER(res == ResOK); + AVER(thread->mfc != NULL); + /* design.thread-manager.sol.thread.term.attempt */ + return res == ResOK; } -void ThreadRingSuspend(Ring threadRing) +void ThreadRingSuspend(Ring threadRing, Ring deadRing) { - mapThreadRing(threadRing, threadSuspend); + mapThreadRing(threadRing, deadRing, threadSuspend); } /* ThreadRingResume -- resume all threads on a ring (expect the current one) */ -static void threadResume(Thread thread) +static Bool threadResume(Thread thread) { - /* .error.resume */ - /* If the previous suspend failed (thread->mfc == NULL), */ - /* or in the error case (PThreadextResume returning ResFAIL), */ - /* assume the thread has been destroyed. */ - /* In which case we simply continue. */ - if(thread->mfc != NULL) { - (void)PThreadextResume(&thread->thrextStruct); - thread->mfc = NULL; - } + Res res; + /* .error.resume: If PThreadextResume fails, we assume the thread + * has been terminated. */ + AVER(thread->mfc != NULL); + res = PThreadextResume(&thread->thrextStruct); + AVER(res == ResOK); + thread->mfc = NULL; + /* design.thread-manager.sol.thread.term.attempt */ + return res == ResOK; } -void ThreadRingResume(Ring threadRing) +void ThreadRingResume(Ring threadRing, Ring deadRing) { - mapThreadRing(threadRing, threadResume); + mapThreadRing(threadRing, deadRing, threadResume); } @@ -232,21 +249,17 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot, self = pthread_self(); if(pthread_equal(self, thread->id)) { /* scan this thread's stack */ + AVER(thread->alive); res = StackScan(ss, stackBot, mask, pattern); if(res != ResOK) return res; - } else { + } else if (thread->alive) { MutatorFaultContext mfc; Word *stackBase, *stackLimit; Addr stackPtr; mfc = thread->mfc; - if(mfc == NULL) { - /* .error.suspend */ - /* We assume that the thread must have been destroyed. */ - /* We ignore the situation by returning immediately. */ - return ResOK; - } + AVER(mfc != NULL); stackPtr = MutatorFaultContextSP(mfc); /* .stack.align */ @@ -282,6 +295,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + " alive $S\n", WriteFYesNo(thread->alive), " id $U\n", (WriteFU)thread->id, "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, NULL); diff --git a/mps/code/thw3.c b/mps/code/thw3.c index eda4c139b19..b8b8b106680 100644 --- a/mps/code/thw3.c +++ b/mps/code/thw3.c @@ -109,6 +109,7 @@ Res ThreadRegister(Thread *threadReturn, Arena arena) thread->serial = arena->threadSerial; ++arena->threadSerial; thread->arena = arena; + thread->alive = TRUE; AVERT(Thread, thread); @@ -138,60 +139,66 @@ void ThreadDeregister(Thread thread, Arena arena) } -/* Map over threads on ring calling f on each one except the - * current thread. +/* mapThreadRing -- map over threads on ring calling a function on + * each one except the current thread. + * + * Threads that are found to be dead (that is, if func returns FALSE) + * are moved to deadRing. */ -static void mapThreadRing(Ring ring, void (*f)(Thread thread)) + +static void mapThreadRing(Ring threadRing, Ring deadRing, Bool (*func)(Thread)) { - Ring node; + Ring node, next; DWORD id; + AVERT(Ring, threadRing); + AVERT(Ring, deadRing); + AVER(FUNCHECK(func)); + id = GetCurrentThreadId(); - node = RingNext(ring); - while(node != ring) { - Ring next = RingNext(node); - Thread thread; - - thread = RING_ELT(Thread, arenaRing, node); + RING_FOR(node, threadRing, next) { + Thread thread = RING_ELT(Thread, arenaRing, node); AVERT(Thread, thread); - if(id != thread->id) /* .thread.id */ - (*f)(thread); - - node = next; + AVER(thread->alive); + if (id != thread->id /* .thread.id */ + && !(*func)(thread)) + { + thread->alive = FALSE; + RingRemove(&thread->arenaRing); + RingAppend(deadRing, &thread->arenaRing); + } } } -static void suspend(Thread thread) +static Bool suspendThread(Thread thread) { /* .thread.handle.susp-res */ /* .error.suspend */ - /* In the error case (SuspendThread returning 0xFFFFFFFF), we */ - /* assume the thread has been destroyed (as part of process shutdown). */ - /* In which case we simply continue. */ + /* In the error case (SuspendThread returning -1), we */ + /* assume the thread has been terminated. */ /* [GetLastError appears to return 5 when SuspendThread is called */ - /* on a destroyed thread, but I'm not sufficiently confident of this */ + /* on a terminated thread, but I'm not sufficiently confident of this */ /* to check -- drj 1998-04-09] */ - (void)SuspendThread(thread->handle); + return SuspendThread(thread->handle) != (DWORD)-1; } -void ThreadRingSuspend(Ring ring) +void ThreadRingSuspend(Ring threadRing, Ring deadRing) { - mapThreadRing(ring, suspend); + mapThreadRing(threadRing, deadRing, suspendThread); } -static void resume(Thread thread) +static Bool resumeThread(Thread thread) { /* .thread.handle.susp-res */ /* .error.resume */ - /* In the error case (ResumeThread returning 0xFFFFFFFF), we */ - /* assume the thread has been destroyed (as part of process shutdown). */ - /* In which case we simply continue. */ - (void)ResumeThread(thread->handle); + /* In the error case (ResumeThread returning -1), we */ + /* assume the thread has been terminated. */ + return ResumeThread(thread->handle) != (DWORD)-1; } -void ThreadRingResume(Ring ring) +void ThreadRingResume(Ring threadRing, Ring deadRing) { - mapThreadRing(ring, resume); + mapThreadRing(threadRing, deadRing, resumeThread); } @@ -220,6 +227,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + " alive $S\n", WriteFYesNo(thread->alive), " handle $W\n", (WriteFW)thread->handle, " id $U\n", (WriteFU)thread->id, "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, diff --git a/mps/code/thw3.h b/mps/code/thw3.h index 7e3cd68e2f1..b19bfccadba 100644 --- a/mps/code/thw3.h +++ b/mps/code/thw3.h @@ -26,6 +26,7 @@ typedef struct mps_thr_s { /* Win32 thread structure */ Serial serial; /* from arena->threadSerial */ Arena arena; /* owning arena */ RingStruct arenaRing; /* threads attached to arena */ + Bool alive; /* thread believed to be alive? */ HANDLE handle; /* Handle of thread, see * */ DWORD id; /* Thread id of thread */ diff --git a/mps/code/thw3i3.c b/mps/code/thw3i3.c index 030319c3350..997ff2986f2 100644 --- a/mps/code/thw3i3.c +++ b/mps/code/thw3i3.c @@ -75,7 +75,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot, id = GetCurrentThreadId(); - if(id != thread->id) { /* .thread.id */ + if (id != thread->id) { /* .thread.id */ CONTEXT context; BOOL success; Word *stackBase, *stackLimit; diff --git a/mps/code/thw3i6.c b/mps/code/thw3i6.c index 77a7aefe425..cc11805eb41 100644 --- a/mps/code/thw3i6.c +++ b/mps/code/thw3i6.c @@ -75,7 +75,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot, id = GetCurrentThreadId(); - if(id != thread->id) { /* .thread.id */ + if (id != thread->id) { /* .thread.id */ CONTEXT context; BOOL success; Word *stackBase, *stackLimit; diff --git a/mps/code/thxc.c b/mps/code/thxc.c index 8beaea1930e..05d49e0f913 100644 --- a/mps/code/thxc.c +++ b/mps/code/thxc.c @@ -36,6 +36,7 @@ typedef struct mps_thr_s { /* OS X / Mach thread structure */ Serial serial; /* from arena->threadSerial */ Arena arena; /* owning arena */ RingStruct arenaRing; /* attaches to arena */ + Bool alive; /* thread believed to be alive? */ thread_port_t port; /* thread kernel port */ } ThreadStruct; @@ -46,6 +47,7 @@ Bool ThreadCheck(Thread thread) CHECKU(Arena, thread->arena); CHECKL(thread->serial < thread->arena->threadSerial); CHECKD_NOSIG(Ring, &thread->arenaRing); + CHECKL(BoolCheck(thread->alive)); CHECKL(MACH_PORT_VALID(thread->port)); return TRUE; } @@ -78,6 +80,7 @@ Res ThreadRegister(Thread *threadReturn, Arena arena) thread->serial = arena->threadSerial; ++arena->threadSerial; + thread->alive = TRUE; thread->port = mach_thread_self(); thread->sig = ThreadSig; AVERT(Thread, thread); @@ -108,62 +111,80 @@ void ThreadDeregister(Thread thread, Arena arena) } -/* mapThreadRing -- map over threads on ring calling a function on each one - * except the current thread +/* mapThreadRing -- map over threads on ring calling a function on + * each one except the current thread. + * + * Threads that are found to be dead (that is, if func returns FALSE) + * are marked as dead and moved to deadRing, in order to implement + * design.thread-manager.sol.thread.term.attempt. */ -static void mapThreadRing(Ring threadRing, void (*func)(Thread)) +static void mapThreadRing(Ring threadRing, Ring deadRing, Bool (*func)(Thread)) { Ring node, next; mach_port_t self; AVERT(Ring, threadRing); + AVERT(Ring, deadRing); + AVER(FUNCHECK(func)); self = mach_thread_self(); AVER(MACH_PORT_VALID(self)); RING_FOR(node, threadRing, next) { Thread thread = RING_ELT(Thread, arenaRing, node); AVERT(Thread, thread); - if(thread->port != self) - (*func)(thread); + AVER(thread->alive); + if (thread->port != self + && !(*func)(thread)) + { + thread->alive = FALSE; + RingRemove(&thread->arenaRing); + RingAppend(deadRing, &thread->arenaRing); + } } } -static void threadSuspend(Thread thread) +static Bool threadSuspend(Thread thread) { kern_return_t kern_return; kern_return = thread_suspend(thread->port); /* No rendezvous is necessary: thread_suspend "prevents the thread * from executing any more user-level instructions" */ AVER(kern_return == KERN_SUCCESS); + /* Experimentally, values other then KERN_SUCCESS indicate the thread has + terminated . */ + /* design.thread-manager.sol.thread.term.attempt */ + return kern_return == KERN_SUCCESS; } -static void threadResume(Thread thread) +static Bool threadResume(Thread thread) { kern_return_t kern_return; kern_return = thread_resume(thread->port); /* Mach has no equivalent of EAGAIN. */ AVER(kern_return == KERN_SUCCESS); + /* Experimentally, values other then KERN_SUCCESS indicate the thread has + terminated . */ + /* design.thread-manager.sol.thread.term.attempt */ + return kern_return == KERN_SUCCESS; } /* ThreadRingSuspend -- suspend all threads on a ring, except the * current one. */ -void ThreadRingSuspend(Ring threadRing) +void ThreadRingSuspend(Ring threadRing, Ring deadRing) { - AVERT(Ring, threadRing); - mapThreadRing(threadRing, threadSuspend); + mapThreadRing(threadRing, deadRing, threadSuspend); } /* ThreadRingResume -- resume all threads on a ring, except the * current one. */ -void ThreadRingResume(Ring threadRing) +void ThreadRingResume(Ring threadRing, Ring deadRing) { - AVERT(Ring, threadRing); - mapThreadRing(threadRing, threadResume); + mapThreadRing(threadRing, deadRing, threadResume); } Thread ThreadRingThread(Ring threadRing) @@ -200,10 +221,11 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot, AVER(MACH_PORT_VALID(self)); if (thread->port == self) { /* scan this thread's stack */ + AVER(thread->alive); res = StackScan(ss, stackBot, mask, pattern); if(res != ResOK) return res; - } else { + } else if (thread->alive) { MutatorFaultContextStruct mfcStruct; THREAD_STATE_S threadState; Word *stackBase, *stackLimit; @@ -211,7 +233,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot, mach_msg_type_number_t count; kern_return_t kern_return; - /* Note: We could get the thread state and check the suspend cound in + /* Note: We could get the thread state and check the suspend count in order to assert that the thread is suspended, but it's probably unnecessary and is a lot of work to check a static condition. */ @@ -259,6 +281,7 @@ Res ThreadDescribe(Thread thread, mps_lib_FILE *stream, Count depth) "Thread $P ($U) {\n", (WriteFP)thread, (WriteFU)thread->serial, " arena $P ($U)\n", (WriteFP)thread->arena, (WriteFU)thread->arena->serial, + " alive $S\n", WriteFYesNo(thread->alive), " port $U\n", (WriteFU)thread->port, "} Thread $P ($U)\n", (WriteFP)thread, (WriteFU)thread->serial, NULL); diff --git a/mps/code/trace.c b/mps/code/trace.c index 6f44f724846..8dcc6a2643b 100644 --- a/mps/code/trace.c +++ b/mps/code/trace.c @@ -1,7 +1,7 @@ /* trace.c: GENERIC TRACER IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. + * Copyright (c) 2001-2015 Ravenbrook Limited. * See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * @@ -1188,6 +1188,7 @@ void TraceSegAccess(Arena arena, Seg seg, AccessSet mode) AVERT(Arena, arena); AVERT(Seg, seg); + AVERT(AccessSet, mode); /* If it's a read access, then the segment must be grey for a trace */ /* which is flipped. */ @@ -1939,7 +1940,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited + * Copyright (C) 2001-2015 Ravenbrook Limited * . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. diff --git a/mps/design/guide.hex.trans.txt b/mps/design/guide.hex.trans.txt index 95c533f6bc8..8120f6e53e5 100644 --- a/mps/design/guide.hex.trans.txt +++ b/mps/design/guide.hex.trans.txt @@ -22,10 +22,11 @@ hexadecimal digits. _`.readership`: This document is intended for anyone devising arbitrary constants which may appear in hex-dumps. -_`.sources`: This transliteration was supplied by RHSK in -`mail.richardk.1997-04-07.13-44`_. - -.. _mail.richardk.1997-04-07.13-44: https://info.ravenbrook.com/project/mps/mail/1997/04/07/13-44/0.txt +_`.sources`: This transliteration was supplied by Richard Kistruck +[RHSK-1997-04-07]_ based on magic number encodings for object signatures +used by Richard Brooksby [RB-1996-02-12]_, the existence of which was +inspired by the structure marking used in the Multics operating system +[THVV-1995]_. Transliteration @@ -78,8 +79,8 @@ _`.trans.t`: T is an exception to `.numbers`_, but is such a common letter that it deserves it. -4. Notes --------- +Notes +----- _`.change`: This transliteration differs from the old transliteration used for signatures (see design.mps.sig_), as follows: J:6->1; @@ -106,6 +107,33 @@ selected (by capitalisation), e.g.:: #define SpaceSig ((Sig)0x5195BACE) /* SIGnature SPACE */ +References +---------- + +.. [RB-1996-02-12] + "Signature magic numbers" (e-mail message); + `Richard Brooksby`_; + Harlequin; + 1996-12-02 12:05:30Z. + +.. _`Richard Brooksby`: mailto:rb@ravenbrook.com + +.. [RHSK-1997-04-07] + "Alpha-to-Hex v1.0 beta"; + Richard Kistruck; + Ravenbrook; + 1997-04-07 14:42:02+0100; + . + +.. [THVV-1995] + "Structure Marking"; + Tom Van Vleck; + multicians.org_; + . + +.. _multicians.org: http://www.multicians.org/ + + Document History ---------------- 2013-05-10 RB_ Converted to reStructuredText and imported to MPS design. diff --git a/mps/design/poolmrg.txt b/mps/design/poolmrg.txt index 6cf69daef16..148e016fae7 100644 --- a/mps/design/poolmrg.txt +++ b/mps/design/poolmrg.txt @@ -630,10 +630,6 @@ All objects from the MRG pool will then be freed (thus dropping all references to the AMC objects). This will test `.promise.faithful`_ and `.promise.live`_. -_`.test.promise.ut.not`: The following part of the test has not -implemented. This is because the messaging system has not yet been -implemented. - _`.test.promise.ut.alloc`: A number of objects will be allocated in the AMC pool. diff --git a/mps/design/thread-manager.txt b/mps/design/thread-manager.txt index efe6bcee9e9..48cbb912533 100644 --- a/mps/design/thread-manager.txt +++ b/mps/design/thread-manager.txt @@ -54,6 +54,15 @@ which might provoke a collection. See request.dylan.160252_.) .. _request.dylan.160252: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/160252/ +_`.req.thread.die`: It would be nice if the MPS coped with threads +that die while registered. (This makes it easier for a client program +to interface with foreign code that terminates threads without the +client program being given an opportunity to deregister them. See +request.dylan.160022_ and request.mps.160093_.) + +.. _request.dylan.160022: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/160022 +.. _request.mps.160093: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/mps/160093/ + Design ------ @@ -70,6 +79,22 @@ thread that might refer to, read from, or write to memory in automatically managed pool classes is registered with the MPS. This is documented in the manual under ``mps_thread_reg()``. +_`.sol.thread.term`: The thread manager cannot reliably detect that a +thread has terminated. The reason is that threading systems do not +guarantee behaviour in this case. For example, POSIX_ says, "A +conforming implementation is free to reuse a thread ID after its +lifetime has ended. If an application attempts to use a thread ID +whose lifetime has ended, the behavior is undefined." For this reason, +the documentation for ``mps_thread_dereg()`` specifies that it is an +error if a thread dies while registered. + +.. _POSIX: http://pubs.opengroup.org/onlinepubs/9699919799/functions/V2_chap02.html#tag_15_09_02 + +_`.sol.thread.term.attempt`: Nonetheless, the thread manager makes a +"best effort" to continue running after detecting a terminated thread, +by moving the thread to a ring of dead threads, and avoiding scanning +it. This might allow a malfunctioning client program to limp along. + Interface --------- @@ -112,14 +137,16 @@ Otherwise, return a result code indicating the cause of the error. _`.if.deregister`: Remove ``thread`` from the list of threads managed by the arena and free it. -``void ThreadRingSuspend(Ring threadRing)`` +``void ThreadRingSuspend(Ring threadRing, Ring deadRing)`` _`.if.ring.suspend`: Suspend all the threads on ``threadRing``, except -for the current thread. +for the current thread. If any threads are discovered to have +terminated, move them to ``deadRing``. -``void ThreadRingResume(Ring threadRing)`` +``void ThreadRingResume(Ring threadRing, Ring deadRing)`` -_`.if.ring.resume`: Resume all the threads on ``threadRing``. +_`.if.ring.resume`: Resume all the threads on ``threadRing``. If any +threads are discovered to have terminated, move them to ``deadRing``. ``Thread ThreadRingThread(Ring threadRing)`` diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c index 8f1b83a26a7..d2275da895f 100644 --- a/mps/example/scheme/scheme-advanced.c +++ b/mps/example/scheme/scheme-advanced.c @@ -424,7 +424,7 @@ static void error(const char *format, ...) * that type. * * These functions illustrate the two-phase MPS Allocation Point - * Protocol with `reserve` and `commmit`. This protocol allows very fast + * Protocol with `reserve` and `commit`. This protocol allows very fast * in-line allocation without locking, but there is a very tiny chance that * the object must be re-initialized. In nearly all cases, however, it's * just a pointer bump. See topic/allocation. @@ -991,22 +991,12 @@ static char *symbol_name(obj_t symbol) } -/* port_close -- close and definalize a port %%MPS - * - * Ports objects are registered for finalization when they are created - * (see make_port). When closed, we definalize them. This is purely an - * optimization: it would be harmless to finalize them because setting - * 'stream' to NULL prevents the stream from being closed multiple - * times. See topic/finalization. - */ static void port_close(obj_t port) { assert(TYPE(port) == TYPE_PORT); if(port->port.stream != NULL) { - mps_addr_t port_ref = port; fclose(port->port.stream); port->port.stream = NULL; - mps_definalize(arena, &port_ref); } } diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c index dacdfd93ab5..ea5583c5f19 100644 --- a/mps/example/scheme/scheme.c +++ b/mps/example/scheme/scheme.c @@ -416,7 +416,7 @@ static void error(const char *format, ...) * that type. * * These functions illustrate the two-phase MPS Allocation Point - * Protocol with `reserve` and `commmit`. This protocol allows very fast + * Protocol with `reserve` and `commit`. This protocol allows very fast * in-line allocation without locking, but there is a very tiny chance that * the object must be re-initialized. In nearly all cases, however, it's * just a pointer bump. See topic/allocation. @@ -1017,22 +1017,12 @@ static void table_delete(obj_t tbl, obj_t key) } -/* port_close -- close and definalize a port %%MPS - * - * Ports objects are registered for finalization when they are created - * (see make_port). When closed, we definalize them. This is purely an - * optimization: it would be harmless to finalize them because setting - * 'stream' to NULL prevents the stream from being closed multiple - * times. See topic/finalization. - */ static void port_close(obj_t port) { assert(TYPE(port) == TYPE_PORT); if(port->port.stream != NULL) { - mps_addr_t port_ref = port; fclose(port->port.stream); port->port.stream = NULL; - mps_definalize(arena, &port_ref); } } diff --git a/mps/manual/source/guide/advanced.rst b/mps/manual/source/guide/advanced.rst index e4a076336a0..b56edf14fa4 100644 --- a/mps/manual/source/guide/advanced.rst +++ b/mps/manual/source/guide/advanced.rst @@ -28,14 +28,6 @@ call ``close-input-file``, then the underlying file handle should still be closed when the port object :term:`dies `. This procedure is known as :term:`finalization`. -.. note:: - - It's generally a bad idea to depend on finalization to release your - resources (see the :ref:`topic-finalization-cautions` section in - :ref:`topic-finalization`). Treat it as a last resort when more - reliable mechanisms for releasing resources (like Scheme's - ``with-open-input-file``) aren't available. - Any block in an :term:`automatically managed ` :term:`pool` can be registered for finalization by calling :c:func:`mps_finalize`. In the toy Scheme interpreter, this can be done @@ -138,26 +130,37 @@ Here's an example session showing finalization taking place: not_condemned 0 clock: 3807 -The toy Scheme interpreter :dfn:`definalizes` ports by calling -:c:func:`mps_definalize` when they are closed. This is purely an -optimization: setting ``stream`` to ``NULL`` ensures that the file -handle wouldn't be closed more than once, even if the port object were -later finalized. +It's wise not to depend on finalization as the only method for +releasing resources (see the :ref:`topic-finalization-cautions` +section in :ref:`topic-finalization`), because the garbage collector +does not promise to collect particular objects at particular times, +and in any case it does so only when it can prove that the object is +:term:`dead`. So it is best to provide a reliable mechanism for +releasing the resource (here, the Scheme function +``close-input-port``), and use finalization as a backup strategy. + +But this raises the possibility that a port will be closed twice: once +via ``close-input-port`` and a second time via finalization. So it's +necessary to make ports robust against be closed multiple times. The +toy Scheme interpreter does so by setting ``stream`` to ``NULL``: this +ensures that the file handle won't be closed more than once. .. code-block:: c - :emphasize-lines: 8 + :emphasize-lines: 6 static void port_close(obj_t port) { assert(TYPE(port) == TYPE_PORT); if(port->port.stream != NULL) { - mps_addr_t port_ref = port; fclose(port->port.stream); port->port.stream = NULL; - mps_definalize(arena, &port_ref); } } +Note that because finalization messages are processed synchronously +via the message queue (and the Scheme interpreter is single-threaded) +there is no need for a lock here. + It's still possible that the toy Scheme interpreter might run out of open file handles despite having some or all of its port objects being finalizable. That's because the arena's message queue is only polled diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst index 2dfdab79555..0b8233f5cba 100644 --- a/mps/manual/source/release.rst +++ b/mps/manual/source/release.rst @@ -73,6 +73,18 @@ Other changes .. _job003899: https://www.ravenbrook.com/project/mps/issue/job003899/ +#. Unfinalizable objects can no longer be registered for finalization. + Previously the objects would be registered but never finalized. See + job003865_. + + .. _job003865: https://www.ravenbrook.com/project/mps/issue/job003865/ + +#. :c:func:`mps_arena_has_addr` now returns the correct result for + objects allocated from the :ref:`pool-mfs`, :ref:`pool-mv`, and + :ref:`pool-mvff` pools. See job003866_. + + .. _job003866: https://www.ravenbrook.com/project/mps/issue/job003866/ + .. _release-notes-1.114: diff --git a/mps/manual/source/topic/error.rst b/mps/manual/source/topic/error.rst index e13e79a9735..7ae2900fed4 100644 --- a/mps/manual/source/topic/error.rst +++ b/mps/manual/source/topic/error.rst @@ -265,6 +265,48 @@ this documentation. :c:type:`mps_fmt_t` for this argument. +``global.c: RingIsSingle(&arena->chainRing)`` + + The client program called :c:func:`mps_arena_destroy` without + destroying all the :term:`generation chains` belonging to the + arena. It is necessary to call :c:func:`mps_chain_destroy` first. + + +``global.c: RingIsSingle(&arena->formatRing)`` + + The client program called :c:func:`mps_arena_destroy` without + destroying all the :term:`object formats` belonging to the arena. + It is necessary to call :c:func:`mps_fmt_destroy` first. + + +``global.c: RingIsSingle(&arena->rootRing)`` + + The client program called :c:func:`mps_arena_destroy` without + destroying all the :term:`roots` belonging to the arena. + It is necessary to call :c:func:`mps_root_destroy` first. + + +``global.c: RingIsSingle(&arena->threadRing)`` + + The client program called :c:func:`mps_arena_destroy` without + deregistering all the :term:`threads` belonging to the arena. + It is necessary to call :c:func:`mps_thread_dereg` first. + + +``global.c: RingLength(&arenaGlobals->poolRing) == 5`` + + The client program called :c:func:`mps_arena_destroy` without + destroying all the :term:`pools` belonging to the arena. + It is necessary to call :c:func:`mps_pool_destroy` first. + + +``global.c: PoolHasAttr(pool, AttrGC)`` + + The client program called :c:func:`mps_finalize` on a reference + that does not belong to an :term:`automatically managed ` :term:`pool`. + + ``lockix.c: res == 0`` ``lockw3.c: lock->claims == 0`` @@ -299,13 +341,19 @@ this documentation. condition? -``ring.c: ring->next == ring`` +``poolsnc.c: foundSeg`` - The client program destroyed an MPS data structure without having - destroyed all the data structures that it owns first. For example, - it destroyed an arena without first destroying all pools in that - arena, or it destroyed a pool without first destroying all - allocation points created on that pool. + The client program passed an incorrect ``frame`` argument to + :c:func:`mps_ap_frame_pop`. This argument must be the result from + a previous call to :c:func:`mps_ap_frame_push` on the same + allocation point. + + +``seg.c: gcseg->buffer == NULL`` + + The client program destroyed pool without first destroying all the + allocation points created on that pool. The allocation points must + be destroyed first. ``trace.c: ss->rank < RankEXACT`` diff --git a/mps/manual/source/topic/finalization.rst b/mps/manual/source/topic/finalization.rst index 5b65d9945dd..7edadb9e3cc 100644 --- a/mps/manual/source/topic/finalization.rst +++ b/mps/manual/source/topic/finalization.rst @@ -221,10 +221,8 @@ Finalization interface :term:`result code` if not. This function registers the block pointed to by ``*ref_p`` for - finalization. This block must have been allocated from a - :term:`pool` in ``arena``. Violations of this constraint may not - be checked by the MPS, and may be unsafe, causing the MPS to crash - in undefined ways. + finalization. This block must have been allocated from an + automatically managed :term:`pool` in ``arena``. .. note:: @@ -252,6 +250,13 @@ Finalization interface avoid placing the restriction on the :term:`client program` that the C call stack be a :term:`root`. + .. warning:: + + Definalization is not yet efficient: the current + implementation just loops over all finalized objects. If you + need efficient definalization, please :ref:`contact us + `. + .. index:: pair: finalization; message diff --git a/mps/manual/source/topic/scanning.rst b/mps/manual/source/topic/scanning.rst index c9f71e3b503..6b4c4a1d396 100644 --- a/mps/manual/source/topic/scanning.rst +++ b/mps/manual/source/topic/scanning.rst @@ -361,9 +361,9 @@ Scanning interface .. c:function:: MPS_FIX_CALL(ss, call) - Call a function from within a :term:`scan method`, between - :c:func:`MPS_SCAN_BEGIN` and :c:func:`MPS_SCAN_END`, passing - the :term:`scan state` correctly. + Call a function to do some scanning, from within a :term:`scan + method`, between :c:func:`MPS_SCAN_BEGIN` and + :c:func:`MPS_SCAN_END`, passing the :term:`scan state` correctly. ``ss`` is the scan state that was passed to the scan method. @@ -377,6 +377,9 @@ Scanning interface must wrap the call with :c:func:`MPS_FIX_CALL` to ensure that the scan state is passed correctly. + The function being called must use :c:func:`MPS_SCAN_BEGIN` and + :c:func:`MPS_SCAN_END` appropriately. + In example below, the scan method ``obj_scan`` fixes the object's ``left`` and ``right`` references, but delegates the scanning of references inside the object's ``data`` member to the function @@ -406,9 +409,11 @@ Scanning interface .. warning:: - Use of :c:func:`MPS_FIX_CALL` is best avoided, as it forces - values out of registers. The gains in simplicity of the code - need to be measured against the loss in performance. + Use of :c:func:`MPS_FIX_CALL` is best avoided, as it may + force values out of registers (depending on compiler + optimisations such as inlining). The gains in simplicity of + the code ought to be measured against the loss in + performance. .. index:: diff --git a/mps/manual/source/topic/thread.rst b/mps/manual/source/topic/thread.rst index 86a54d36ebe..54a929b6f65 100644 --- a/mps/manual/source/topic/thread.rst +++ b/mps/manual/source/topic/thread.rst @@ -100,6 +100,7 @@ Signal and exception handling issues for co-operating: if you are in this situation, please :ref:`contact us `. + .. index:: single: thread; interface @@ -143,6 +144,9 @@ Thread interface It is recommended that all threads be registered with all arenas. + It is an error if a thread terminates while it is registered. The + client program must call :c:func:`mps_thread_dereg` first. + .. c:function:: void mps_thread_dereg(mps_thr_t thr) diff --git a/mps/procedure/release-build.rst b/mps/procedure/release-build.rst index c35f3a25610..cf07cee0620 100644 --- a/mps/procedure/release-build.rst +++ b/mps/procedure/release-build.rst @@ -33,7 +33,7 @@ All relative paths are relative to .. _version-create: version-create -#. Make sure that you have rights to push to the ``mps-temporary`` +#. Make sure that you have rights to push to the ``mps`` repository on GitHub. If not, follow the `Becoming a Ravenbrook team member procedure `_ first. @@ -218,10 +218,10 @@ On a Unix (including OS X) machine: Memory Pool System Kit release $RELEASE. See . END - git push --tags git@github.com:Ravenbrook/mps-temporary.git + git push --tags git@github.com:Ravenbrook/mps.git #. Go to the `list of releases on Github - `__ and + `__ and select "Draft a new release". Select the tag you just pushed, and set the title and description to match the other releases. @@ -259,6 +259,7 @@ B. Document History 2012‑09‑24 RB_ Make sure ZIP files contain files with Windows line endings. Use a fresh Perforce client to avoid any possibility of a clash with working files. Different archive name for custom variants. 2013-03-20 GDR_ Ensure that manual HTML is up to date before making a release. 2014-01-13 GDR_ Make procedure less error-prone by giving exact sequence of commands (where possible) based on experience of release 1.112.0. +2016-01-28 RB_ Git repository renamed from mps-temporary to mps. ========== ===== ========================================================== .. _RB: mailto:rb@ravenbrook.com diff --git a/mps/procedure/version-create.rst b/mps/procedure/version-create.rst index d52c208ce7d..3f743639fdf 100644 --- a/mps/procedure/version-create.rst +++ b/mps/procedure/version-create.rst @@ -154,7 +154,7 @@ the parent branch. A typical invocation looks like this:: PUSHES=$(p4 have //info.ravenbrook.com/infosys/robots/git-fusion/etc/pushes | cut -d' ' -f3) p4 edit $PUSHES - printf "mps-version-$VERSION\tgit@github.com:Ravenbrook/mps-temporary.git\tversion/$VERSION" >> $PUSHES + printf "mps-version-$VERSION\tgit@github.com:Ravenbrook/mps.git\tversion/$VERSION" >> $PUSHES p4 submit -d "Arranging for MPS version $VERSION to be pushed to GitHub by Git Fusion" $PUSHES @@ -178,6 +178,7 @@ B. Document History 2014-01-13 GDR_ Make procedure less error-prone by giving exact sequence of commands (where possible) based on experience of version 1.112. 2014-01-14 GDR_ Step for adding to Git Fusion. 2014-03-19 GDR_ Describe automated procedure. +2016-01-28 RB_ Git repository renamed from mps-temporary to mps. ========== ===== ======================================================== .. _GDR: mailto:gdr@ravenbrook.com diff --git a/mps/test/function/228.c b/mps/test/function/228.c new file mode 100644 index 00000000000..baa69a7cd7e --- /dev/null +++ b/mps/test/function/228.c @@ -0,0 +1,41 @@ +/* +TEST_HEADER + id = $Id$ + summary = can't register unfinalizable objects for finalization + language = c + link = testlib.o +OUTPUT_SPEC + assert = true + assertfile P= global.c + assertcond = PoolHasAttr(refpool, AttrGC) +END_HEADER +*/ + +#include "testlib.h" +#include "mpscmvff.h" +#include "mpsavm.h" + +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); +} + + +int main(void) +{ + easy_tramp(test); + pass(); + return 0; +} diff --git a/mps/test/testsets/passing b/mps/test/testsets/passing index fde2ca5de8d..88d5e6dfa51 100644 --- a/mps/test/testsets/passing +++ b/mps/test/testsets/passing @@ -168,4 +168,5 @@ function/224.c % 225 -- no such test function/226.c function/227.c -function/229.c \ No newline at end of file +function/228.c +function/229.c