X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FInterpreter.c;h=95ddc48c2e144367b4dcb6a6a9c2f1346b0ef287;hb=97906cfcc30dd591e840921d336fdabeb1b8a315;hp=7a382a4c68b40a74418e64a5eeeb76315b326920;hpb=4e8b2b5b1453967750e473ffaab1f76b7ea8864e;p=ghc-hetmet.git diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index 7a382a4..95ddc48 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,10 +5,16 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.24 $ - * $Date: 2001/05/27 06:08:24 $ + * $Revision: 1.34 $ + * $Date: 2002/02/15 22:15:08 $ * ---------------------------------------------------------------------------*/ +#if !defined(SMP) +#include "PosixSource.h" +#else +/* Hack and slash.. */ +#include "Stg.h" +#endif #include "Rts.h" #include "RtsAPI.h" #include "RtsUtils.h" @@ -54,13 +60,18 @@ #define BCO_LIT(n) (W_)literals[n] #define BCO_ITBL(n) itbls[n] -#define LOAD_STACK_POINTERS \ - iSp = cap->rCurrentTSO->sp; iSu = cap->rCurrentTSO->su; +#define LOAD_STACK_POINTERS \ + iSp = cap->r.rCurrentTSO->sp; \ + iSu = cap->r.rCurrentTSO->su; \ + /* We don't change this ... */ \ + iSpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS; + -#define SAVE_STACK_POINTERS \ - cap->rCurrentTSO->sp = iSp; cap->rCurrentTSO->su = iSu; +#define SAVE_STACK_POINTERS \ + cap->r.rCurrentTSO->sp = iSp; \ + cap->r.rCurrentTSO->su = iSu; -#define RETURN(retcode) \ +#define RETURN(retcode) \ SAVE_STACK_POINTERS; return retcode; @@ -169,9 +180,6 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) LOAD_STACK_POINTERS; - /* We don't change this ... */ - iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS; - /* Main object-entering loop. Object to be entered is on top of stack. */ nextEnter: @@ -193,10 +201,10 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) // checkSanity(1); // iSp--; StackWord(0) = obj; - // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + // checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); // iSp++; - printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); fprintf(stderr, "\n\n"); ); @@ -370,7 +378,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) /* Heap check */ if (doYouWantToGC()) { iSp--; StackWord(0) = (W_)bco; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(HeapOverflow); } @@ -378,7 +386,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (iSp - (INTERP_STACK_CHECK_THRESH+1) < iSpLim) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(StackOverflow); } @@ -386,7 +394,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (context_switch) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(ThreadYielding); } @@ -401,7 +409,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) IF_DEBUG(evaluator, //if (do_print_stack) { //fprintf(stderr, "\n-- BEGIN stack\n"); - //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + //printStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); //fprintf(stderr, "-- END stack\n\n"); //} do_print_stack = 1; @@ -413,7 +421,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i))); fprintf(stderr,"\n"); } - //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + //if (do_print_stack) checkStack(iSp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); ); # ifdef INTERP_STATS @@ -433,7 +441,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (iSp - stk_words_reqd < iSpLim) { iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterInterp; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(StackOverflow); } goto nextInsn; @@ -477,7 +485,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) fprintf(stderr,"\tBuilt "); printObj((StgClosure*)pap); ); - cap->rCurrentTSO->what_next = ThreadEnterGHC; + cap->r.rCurrentTSO->what_next = ThreadEnterGHC; RETURN(ThreadYielding); } case bci_PUSH_L: { @@ -747,7 +755,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl); if (magic_itbl != NULL) { StackWord(0) = (W_)magic_itbl; - cap->rCurrentTSO->what_next = ThreadRunGHC; + cap->r.rCurrentTSO->what_next = ThreadRunGHC; RETURN(ThreadYielding); } else { /* Special case -- returning a VoidRep to @@ -756,12 +764,28 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) tag and enter the itbl. */ ASSERT(StackWord(0) == (W_)NULL); iSp ++; - cap->rCurrentTSO->what_next = ThreadRunGHC; + cap->r.rCurrentTSO->what_next = ThreadRunGHC; RETURN(ThreadYielding); } } } - + case bci_SWIZZLE: { + int stkoff = BCO_NEXT; + signed short n = (signed short)(BCO_NEXT); + StackWord(stkoff) += (W_)n; + goto nextInsn; + } + case bci_CCALL: { + StgInt tok; + int o_itbl = BCO_NEXT; + void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl); + SAVE_STACK_POINTERS; + tok = suspendThread(&cap->r,rtsFalse); + marshall_fn ( (void*)(& StackWord(0) ) ); + cap = (Capability *)((void *)resumeThread(tok,rtsFalse) - sizeof(StgFunTable)); + LOAD_STACK_POINTERS; + goto nextInsn; + } case bci_JMP: { /* BCO_NEXT modifies bciPtr, so be conservative. */ int nextpc = BCO_NEXT; @@ -800,7 +824,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) printObj(obj); ); iSp--; StackWord(0) = (W_)obj; - cap->rCurrentTSO->what_next = ThreadEnterGHC; + cap->r.rCurrentTSO->what_next = ThreadEnterGHC; RETURN(ThreadYielding); } } /* switch on object kind */