diff --git a/mps/code/apss.c b/mps/code/apss.c index 1fe460df9ba..5192baada42 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; kspareRing && 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/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/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.h b/mps/code/mpm.h index b8cb8c250ee..af2cde97ff1 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -521,6 +521,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) diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h index d212e0e3307..a798cc71fc4 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/mpsicv.c b/mps/code/mpsicv.c index 29a81b174c8..44036efead9 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/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/shield.c b/mps/code/shield.c index 8b73f8f488c..0dfc1945db6 100644 --- a/mps/code/shield.c +++ b/mps/code/shield.c @@ -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; } } @@ -266,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; diff --git a/mps/code/th.h b/mps/code/th.h index 8c7da150fd0..8f7996cc0b5 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 8c5af222898..f1fb21006d8 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 d32a7dd6601..c1a31c6e902 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); } @@ -231,20 +248,16 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) self = pthread_self(); if(pthread_equal(self, thread->id)) { /* scan this thread's stack */ + AVER(thread->alive); res = StackScan(ss, stackBot); if(res != ResOK) return res; - } else { + } else if (thread->alive) { MutatorFaultContext mfc; Addr *stackBase, *stackLimit, 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 */ @@ -280,6 +293,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 33424b6cf54..20e694ddc82 100644 --- a/mps/code/thw3i3.c +++ b/mps/code/thw3i3.c @@ -74,7 +74,13 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) id = GetCurrentThreadId(); - if(id != thread->id) { /* .thread.id */ + if (id == thread->id) { /* .thread.id */ + /* scan this thread's stack */ + AVER(thread->alive); + res = StackScan(ss, stackBot); + if(res != ResOK) + return res; + } else if (thread->alive) { CONTEXT context; BOOL success; Addr *stackBase, *stackLimit, stackPtr; @@ -116,11 +122,6 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) (Addr *)((char *)&context + sizeof(CONTEXT))); if(res != ResOK) return res; - - } else { /* scan this thread's stack */ - res = StackScan(ss, stackBot); - if(res != ResOK) - return res; } return ResOK; diff --git a/mps/code/thw3i6.c b/mps/code/thw3i6.c index 9b0eae55db6..a13a031ec22 100644 --- a/mps/code/thw3i6.c +++ b/mps/code/thw3i6.c @@ -74,7 +74,13 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) id = GetCurrentThreadId(); - if(id != thread->id) { /* .thread.id */ + if (id == thread->id) { /* .thread.id */ + /* scan this thread's stack */ + AVER(thread->alive); + res = StackScan(ss, stackBot); + if(res != ResOK) + return res; + } else if (thread->alive) { CONTEXT context; BOOL success; Addr *stackBase, *stackLimit, stackPtr; @@ -116,11 +122,6 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) (Addr *)((char *)&context + sizeof(CONTEXT))); if(res != ResOK) return res; - - } else { /* scan this thread's stack */ - res = StackScan(ss, stackBot); - if(res != ResOK) - return res; } return ResOK; diff --git a/mps/code/thxc.c b/mps/code/thxc.c index 6aeffef6568..6ecc1ea726e 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) @@ -199,17 +220,18 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) AVER(MACH_PORT_VALID(self)); if (thread->port == self) { /* scan this thread's stack */ + AVER(thread->alive); res = StackScan(ss, stackBot); if(res != ResOK) return res; - } else { + } else if (thread->alive) { MutatorFaultContextStruct mfcStruct; THREAD_STATE_S threadState; Addr *stackBase, *stackLimit, stackPtr; 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. */ @@ -257,6 +279,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/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 993c1aad9f9..830b5b9da33 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 a2825ad6e78..fb43e62e344 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 ad285d7adc6..a7e028fae2a 100644 --- a/mps/manual/source/release.rst +++ b/mps/manual/source/release.rst @@ -70,6 +70,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 1120b868897..7ae2900fed4 100644 --- a/mps/manual/source/topic/error.rst +++ b/mps/manual/source/topic/error.rst @@ -300,6 +300,13 @@ this documentation. 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`` 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/thread.rst b/mps/manual/source/topic/thread.rst index a470dedf420..9417c473b04 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 @@ -142,6 +143,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 d19cce41070..c6893a54c30 100644 --- a/mps/test/testsets/passing +++ b/mps/test/testsets/passing @@ -168,5 +168,6 @@ function/224.c % 225 -- no such test function/226.c function/227.c +function/228.c function/229.c function/231.c