X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FInterpreter.c;h=d047876d21d2c12fc198686fe384a688b183ce4c;hb=b2b2744e0a095b9a86952adabfe0a7410dcf5489;hp=ab59533666eab0a381fa0be6dc5503c7efed1e83;hpb=e0fcf61dca4dfac99cb5417e1bc4cbee18822cf2;p=ghc-hetmet.git diff --git a/rts/Interpreter.c b/rts/Interpreter.c index ab59533..d047876 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -7,21 +7,20 @@ #include "PosixSource.h" #include "Rts.h" #include "RtsAPI.h" +#include "rts/Bytecodes.h" + +// internal headers +#include "sm/Storage.h" #include "RtsUtils.h" -#include "Closures.h" -#include "TSO.h" #include "Schedule.h" -#include "RtsFlags.h" -#include "LdvProfile.h" #include "Updates.h" #include "Sanity.h" -#include "Liveness.h" #include "Prelude.h" - -#include "Bytecodes.h" +#include "Stable.h" #include "Printer.h" #include "Disassembler.h" #include "Interpreter.h" +#include "ThreadPaused.h" #include /* for memcpy */ #ifdef HAVE_ERRNO_H @@ -63,6 +62,7 @@ SpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS; #define SAVE_STACK_POINTERS \ + ASSERT(Sp > SpLim); \ cap->r.rCurrentTSO->sp = Sp #define RETURN_TO_SCHEDULER(todo,retcode) \ @@ -195,6 +195,9 @@ interpretBCO (Capability* cap) LOAD_STACK_POINTERS; + cap->r.rHpLim = (P_)1; // HpLim is the context-switch flag; when it + // goes to zero we must return to the scheduler. + // ------------------------------------------------------------------------ // Case 1: // @@ -549,6 +552,16 @@ do_apply: goto defer_apply_to_sched; } + // Stack check: we're about to unpack the PAP onto the + // stack. The (+1) is for the (arity < n) case, where we + // also need space for an extra info pointer. + if (Sp - (pap->n_args + 1) < SpLim) { + Sp -= 2; + Sp[1] = (W_)tagged_obj; + Sp[0] = (W_)&stg_enter_info; + RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow); + } + Sp++; arity = pap->arity; ASSERT(arity > 0); @@ -749,19 +762,22 @@ run_BCO_fun: run_BCO: INTERP_TICK(it_BCO_entries); { - register int bciPtr = 1; /* instruction pointer */ + register int bciPtr = 0; /* instruction pointer */ register StgWord16 bci; register StgBCO* bco = (StgBCO*)obj; register StgWord16* instrs = (StgWord16*)(bco->instrs->payload); register StgWord* literals = (StgWord*)(&bco->literals->payload[0]); register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]); + int bcoSize; + bcoSize = BCO_NEXT_WORD; + IF_DEBUG(interpreter,debugBelch("bcoSize = %d\n", bcoSize)); #ifdef INTERP_STATS it_lastopc = 0; /* no opcode */ #endif nextInsn: - ASSERT(bciPtr <= instrs[0]); + ASSERT(bciPtr < bcoSize); IF_DEBUG(interpreter, //if (do_print_stack) { //debugBelch("\n-- BEGIN stack\n"); @@ -1172,7 +1188,7 @@ run_BCO: case bci_TESTLT_P: { unsigned int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgClosure* con = (StgClosure*)Sp[0]; if (GET_TAG(con) >= discr) { bciPtr = failto; @@ -1182,7 +1198,7 @@ run_BCO: case bci_TESTEQ_P: { unsigned int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgClosure* con = (StgClosure*)Sp[0]; if (GET_TAG(con) != discr) { bciPtr = failto; @@ -1193,7 +1209,7 @@ run_BCO: case bci_TESTLT_I: { // There should be an Int at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; I_ stackInt = (I_)Sp[1]; if (stackInt >= (I_)BCO_LIT(discr)) bciPtr = failto; @@ -1203,7 +1219,7 @@ run_BCO: case bci_TESTEQ_I: { // There should be an Int at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; I_ stackInt = (I_)Sp[1]; if (stackInt != (I_)BCO_LIT(discr)) { bciPtr = failto; @@ -1214,7 +1230,7 @@ run_BCO: case bci_TESTLT_D: { // There should be a Double at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; stackDbl = PK_DBL( & Sp[1] ); discrDbl = PK_DBL( & BCO_LIT(discr) ); @@ -1227,7 +1243,7 @@ run_BCO: case bci_TESTEQ_D: { // There should be a Double at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; stackDbl = PK_DBL( & Sp[1] ); discrDbl = PK_DBL( & BCO_LIT(discr) ); @@ -1240,7 +1256,7 @@ run_BCO: case bci_TESTLT_F: { // There should be a Float at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; stackFlt = PK_FLT( & Sp[1] ); discrFlt = PK_FLT( & BCO_LIT(discr) ); @@ -1253,7 +1269,7 @@ run_BCO: case bci_TESTEQ_F: { // There should be a Float at Sp[1], and an info table at Sp[0]. int discr = BCO_NEXT; - int failto = BCO_NEXT; + int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; stackFlt = PK_FLT( & Sp[1] ); discrFlt = PK_FLT( & BCO_LIT(discr) ); @@ -1270,7 +1286,7 @@ run_BCO: // context switching: sometimes the scheduler can invoke // the interpreter with context_switch == 1, particularly // if the -C0 flag has been given on the cmd line. - if (context_switch) { + if (cap->r.rHpLim == NULL) { Sp--; Sp[0] = (W_)&stg_enter_info; RETURN_TO_SCHEDULER(ThreadInterpret, ThreadYielding); } @@ -1411,7 +1427,7 @@ run_BCO: ffi_call(cif, fn, ret, argptrs); // And restart the thread again, popping the RET_DYN frame. - cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - sizeof(StgFunTable))); + cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - STG_FIELD_OFFSET(Capability,r))); LOAD_STACK_POINTERS; // Re-load the pointer to the BCO from the RET_DYN frame, @@ -1437,7 +1453,7 @@ run_BCO: case bci_JMP: { /* BCO_NEXT modifies bciPtr, so be conservative. */ - int nextpc = BCO_NEXT; + int nextpc = BCO_GET_LARGE_ARG; bciPtr = nextpc; goto nextInsn; }