X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=3f428141dff7f48641386855c0a25388c79b86d2;hb=a200038f469418fef77d863dc3d1cd0125ec1e82;hp=7f59f09155bd02e18c5dbe3ba6d5d7d468dbf53a;hpb=848dafe81b0b7e3564c09109a2f30b598235c555;p=ghc-hetmet.git diff --git a/rts/Schedule.c b/rts/Schedule.c index 7f59f09..3f42814 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -1912,7 +1912,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap) * ------------------------------------------------------------------------- */ #if defined(THREADED_RTS) -void +void OSThreadProcAttr workerStart(Task *task) { Capability *cap; @@ -2192,7 +2192,7 @@ static StgTSO * threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso) { bdescr *bd, *new_bd; - lnat new_tso_size_w, tso_size_w; + lnat free_w, tso_size_w; StgTSO *new_tso; tso_size_w = tso_sizeW(tso); @@ -2207,19 +2207,19 @@ threadStackUnderflow (Task *task STG_UNUSED, StgTSO *tso) // while we are moving the TSO: lockClosure((StgClosure *)tso); - new_tso_size_w = round_to_mblocks(tso_size_w/2); - - debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu", - (long)tso->id, tso_size_w, new_tso_size_w); + // this is the number of words we'll free + free_w = round_to_mblocks(tso_size_w/2); bd = Bdescr((StgPtr)tso); - new_bd = splitLargeBlock(bd, new_tso_size_w / BLOCK_SIZE_W); - new_bd->free = bd->free; + new_bd = splitLargeBlock(bd, free_w / BLOCK_SIZE_W); bd->free = bd->start + TSO_STRUCT_SIZEW; new_tso = (StgTSO *)new_bd->start; memcpy(new_tso,tso,TSO_STRUCT_SIZE); - new_tso->stack_size = new_tso_size_w - TSO_STRUCT_SIZEW; + new_tso->stack_size = new_bd->free - new_tso->stack; + + debugTrace(DEBUG_sched, "thread %ld: reducing TSO size from %lu words to %lu", + (long)tso->id, tso_size_w, tso_sizeW(new_tso)); tso->what_next = ThreadRelocated; tso->_link = new_tso; // no write barrier reqd: same generation