X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FInterpreter.c;h=9a38a7ed189e0bb4579d9fbdd8479119b6539995;hb=41bfdf710742595e6043d9b851e8dab30ffe6d2f;hp=5197510766395613e0dcb6b43656c3938b448097;hpb=5270423a6afe69f1dc57e5e5a474812182718d40;p=ghc-hetmet.git diff --git a/rts/Interpreter.c b/rts/Interpreter.c index 5197510..9a38a7e 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -11,16 +11,17 @@ // internal headers #include "sm/Storage.h" +#include "sm/Sanity.h" #include "RtsUtils.h" #include "Schedule.h" #include "Updates.h" -#include "Sanity.h" #include "Prelude.h" #include "Stable.h" #include "Printer.h" #include "Disassembler.h" #include "Interpreter.h" #include "ThreadPaused.h" +#include "Threads.h" #include /* for memcpy */ #ifdef HAVE_ERRNO_H @@ -269,14 +270,13 @@ eval_obj: debugBelch("\n\n"); ); - IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size)); +// IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size)); + IF_DEBUG(sanity,checkStackFrame(Sp)); switch ( get_itbl(obj)->type ) { case IND: - case IND_OLDGEN: case IND_PERM: - case IND_OLDGEN_PERM: case IND_STATIC: { tagged_obj = ((StgInd*)obj)->indirectee; @@ -442,7 +442,8 @@ do_return: // to a PAP by the GC, violating the invariant that PAPs // always contain a tagged pointer to the function. INTERP_TICK(it_retto_UPDATE); - UPD_IND(((StgUpdateFrame *)Sp)->updatee, tagged_obj); + updateThunk(cap, cap->r.rCurrentTSO, + ((StgUpdateFrame *)Sp)->updatee, tagged_obj); Sp += sizeofW(StgUpdateFrame); goto do_return; @@ -883,21 +884,15 @@ run_BCO: // in a reasonable state for the GC and so that // execution of this BCO can continue when we resume ioAction = (StgClosure *) deRefStablePtr (rts_breakpoint_io_action); - Sp -= 9; - Sp[8] = (W_)obj; - Sp[7] = (W_)&stg_apply_interp_info; - Sp[6] = (W_)&stg_noforceIO_info; // see [unreg] below + Sp -= 8; + Sp[7] = (W_)obj; + Sp[6] = (W_)&stg_apply_interp_info; Sp[5] = (W_)new_aps; // the AP_STACK Sp[4] = (W_)BCO_PTR(arg3_freeVars); // the info about local vars of the breakpoint Sp[3] = (W_)False_closure; // True <=> a breakpoint Sp[2] = (W_)&stg_ap_pppv_info; Sp[1] = (W_)ioAction; // apply the IO action to its two arguments above Sp[0] = (W_)&stg_enter_info; // get ready to run the IO action - // Note [unreg]: in unregisterised mode, the return - // convention for IO is different. The - // stg_noForceIO_info stack frame is necessary to - // account for this difference. - // set the flag in the TSO to say that we are now // stopping at a breakpoint so that when we resume // we don't stop on the same breakpoint that we