X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FHeapStackCheck.cmm;h=10baca23c6789552545ab54fed485ff1c4e2579c;hb=536942c5b15e2cd06bb274022c670b9ecbbef465;hp=11af7c70731585d6b26b2c13378ab804bb02fbb4;hpb=0981e24e9980b8b26e6f20fc56bebc1c7416cc4f;p=ghc-hetmet.git diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm index 11af7c7..10baca2 100644 --- a/rts/HeapStackCheck.cmm +++ b/rts/HeapStackCheck.cmm @@ -13,18 +13,21 @@ #include "Cmm.h" #ifdef __PIC__ -import EnterCriticalSection -import LeaveCriticalSection 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). + * + * - 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 @@ -60,13 +63,17 @@ import pthread_mutex_unlock; #define GC_GENERIC \ DEBUG_ONLY(foreign "C" heapCheckFail()); \ if (Hp > HpLim) { \ + if (HpLim == 0) { \ + R1 = ThreadYielding; \ + goto sched; \ + } \ Hp = Hp - HpAlloc/*in bytes*/; \ if (HpAlloc <= BLOCK_SIZE \ && bdescr_link(CurrentNursery) != NULL) { \ 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 { \ @@ -114,7 +121,7 @@ import pthread_mutex_unlock; 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); @@ -444,7 +451,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); @@ -531,7 +538,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)) @@ -816,7 +823,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); @@ -827,7 +834,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; } @@ -841,7 +850,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); @@ -853,7 +862,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; } @@ -888,7 +899,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);