X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FHeapStackCheck.cmm;h=a1b6d65f34f6e611b67bb1cbd05dcba0683e041a;hb=de75026f5a48d3d052135a973ab4dff76c5b20f5;hp=75f14184a95a7faffcb412dd712b83bfd16be865;hpb=d31dfb32ea936c22628b508c28a36c12e631430a;p=ghc-hetmet.git diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index 75f1418..a1b6d65 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -12,13 +12,33 @@ #include "Cmm.h" +#ifdef __PIC__ +import pthread_mutex_unlock; +#endif +import EnterCriticalSection; +import LeaveCriticalSection; + /* Stack/Heap Check Failure * ------------------------ * * On discovering that a stack or heap check has failed, we do the following: * - * - If the context_switch flag is set, indicating that there are more - * threads waiting to run, we yield to the scheduler + * - If HpLim==0, indicating that we should context-switch, we yield + * to the scheduler (return ThreadYielding). + * + * Note that we must leave no slop in the heap (this is a requirement + * for LDV profiling, at least), so if we just had a heap-check + * failure, then we must retract Hp by HpAlloc. How do we know + * whether there was a heap-check failure? HpLim might be zero, and + * yet we got here as a result of a stack-check failure. Hence, we + * require that HpAlloc is only non-zero if there was a heap-check + * failure, otherwise it is zero, so we can always safely subtract + * HpAlloc from Hp. + * + * Hence, HpAlloc is zeroed in LOAD_THREAD_STATE(). + * + * - If the context_switch flag is set (the backup plan if setting HpLim + * to 0 didn't trigger a context switch), we yield to the scheduler * (return ThreadYielding). * * - If Hp > HpLim, we've had a heap check failure. This means we've @@ -55,12 +75,17 @@ DEBUG_ONLY(foreign "C" heapCheckFail()); \ if (Hp > HpLim) { \ Hp = Hp - HpAlloc/*in bytes*/; \ + if (HpLim == 0) { \ + R1 = ThreadYielding; \ + goto sched; \ + } \ if (HpAlloc <= BLOCK_SIZE \ && bdescr_link(CurrentNursery) != NULL) { \ + HpAlloc = 0; \ CLOSE_NURSERY(); \ CurrentNursery = bdescr_link(CurrentNursery); \ OPEN_NURSERY(); \ - if (CInt[context_switch] != 0 :: CInt) { \ + if (Capability_context_switch(MyCapability()) != 0 :: CInt) { \ R1 = ThreadYielding; \ goto sched; \ } else { \ @@ -108,7 +133,7 @@ There are canned sequences for 'n' pointer values in registers. -------------------------------------------------------------------------- */ -INFO_TABLE_RET( stg_enter, RET_SMALL, "ptr" W_ unused) +INFO_TABLE_RET( stg_enter, RET_SMALL, P_ unused) { R1 = Sp(1); Sp_adj(2); @@ -438,7 +463,7 @@ INFO_TABLE_RET( stg_gc_void, RET_SMALL) /*-- R1 is boxed/unpointed -------------------------------------------------- */ -INFO_TABLE_RET( stg_gc_unpt_r1, RET_SMALL, "ptr" W_ unused) +INFO_TABLE_RET( stg_gc_unpt_r1, RET_SMALL, P_ unused) { R1 = Sp(1); Sp_adj(2); @@ -525,7 +550,7 @@ stg_gc_l1 /*-- Unboxed tuple return, one pointer (unregisterised build only) ---------- */ -INFO_TABLE_RET( stg_ut_1_0_unreg, RET_SMALL, "ptr" W_ unused ) +INFO_TABLE_RET( stg_ut_1_0_unreg, RET_SMALL, P_ unused ) { Sp_adj(1); // one ptr is on the stack (Sp(0)) @@ -568,7 +593,7 @@ __stg_gc_fun W_ info; W_ type; - info = %GET_FUN_INFO(R1); + info = %GET_FUN_INFO(UNTAG(R1)); // cache the size type = TO_W_(StgFunInfoExtra_fun_type(info)); @@ -579,7 +604,7 @@ __stg_gc_fun #ifdef TABLES_NEXT_TO_CODE // bitmap field holds an offset size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) - + %GET_ENTRY(R1) /* ### */ ); + + %GET_ENTRY(UNTAG(R1)) /* ### */ ); #else size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) ); #endif @@ -629,12 +654,12 @@ INFO_TABLE_RET( stg_gc_fun, RET_FUN ) #ifdef NO_ARG_REGS // Minor optimisation: there are no argument registers to load up, // so we can just jump straight to the function's entry point. - jump %GET_ENTRY(R1); + jump %GET_ENTRY(UNTAG(R1)); #else W_ info; W_ type; - info = %GET_FUN_INFO(R1); + info = %GET_FUN_INFO(UNTAG(R1)); type = TO_W_(StgFunInfoExtra_fun_type(info)); if (type == ARG_GEN || type == ARG_GEN_BIG) { jump StgFunInfoExtra_slow_apply(info); @@ -810,7 +835,7 @@ stg_block_1 * * -------------------------------------------------------------------------- */ -INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, "ptr" W_ unused ) +INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, P_ unused ) { R1 = Sp(1); Sp_adj(2); @@ -821,7 +846,9 @@ INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, "ptr" W_ unused ) stg_block_takemvar_finally { #ifdef THREADED_RTS - unlockClosure(R3, stg_EMPTY_MVAR_info); + unlockClosure(R3, stg_MVAR_DIRTY_info); +#else + SET_INFO(R3, stg_MVAR_DIRTY_info); #endif jump StgReturn; } @@ -835,7 +862,7 @@ stg_block_takemvar BLOCK_BUT_FIRST(stg_block_takemvar_finally); } -INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, "ptr" W_ unused1, "ptr" W_ unused2 ) +INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, P_ unused1, P_ unused2 ) { R2 = Sp(2); R1 = Sp(1); @@ -847,7 +874,9 @@ INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, "ptr" W_ unused1, "ptr" W_ unused2 stg_block_putmvar_finally { #ifdef THREADED_RTS - unlockClosure(R3, stg_FULL_MVAR_info); + unlockClosure(R3, stg_MVAR_DIRTY_info); +#else + SET_INFO(R3, stg_MVAR_DIRTY_info); #endif jump StgReturn; } @@ -869,7 +898,7 @@ stg_block_blackhole_finally // The last thing we do is release sched_lock, which is // preventing other threads from accessing blackhole_queue and // picking up this thread before we are finished with it. - foreign "C" RELEASE_LOCK(sched_mutex "ptr"); + RELEASE_LOCK(sched_mutex "ptr"); #endif jump StgReturn; } @@ -882,7 +911,7 @@ stg_block_blackhole BLOCK_BUT_FIRST(stg_block_blackhole_finally); } -INFO_TABLE_RET( stg_block_throwto, RET_SMALL, "ptr" W_ unused, "ptr" W_ unused ) +INFO_TABLE_RET( stg_block_throwto, RET_SMALL, P_ unused, P_ unused ) { R2 = Sp(2); R1 = Sp(1); @@ -933,7 +962,7 @@ stg_block_async /* Used by threadDelay implementation; it would be desirable to get rid of * this free()'ing void return continuation. */ -INFO_TABLE_RET( stg_block_async_void, 0/*framesize*/, 0/*bitmap*/, RET_SMALL ) +INFO_TABLE_RET( stg_block_async_void, RET_SMALL ) { W_ ares;