X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FInterpreter.c;h=86c152fdb98c01774d2c7c4830ab8d036cd1ee97;hb=2a59f826d3c2c5f02254f64c09f77f784a24a90f;hp=2fd1580afbc6435bc5feb96e4f692e6c22fec94e;hpb=2843826aa4f1ea974bd7e87428974539b85a36f0;p=ghc-hetmet.git diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index 2fd1580..86c152f 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,12 +5,16 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.14 $ - * $Date: 2001/02/05 17:27:48 $ + * $Revision: 1.33 $ + * $Date: 2002/01/24 02:15:19 $ * ---------------------------------------------------------------------------*/ -#ifdef GHCI - +#if !defined(SMP) +#include "PosixSource.h" +#else +/* Hack and slash.. */ +#include "Stg.h" +#endif #include "Rts.h" #include "RtsAPI.h" #include "RtsUtils.h" @@ -56,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 RETURN(retcode) \ +#define SAVE_STACK_POINTERS \ + cap->r.rCurrentTSO->sp = iSp; \ + cap->r.rCurrentTSO->su = iSu; + +#define RETURN(retcode) \ SAVE_STACK_POINTERS; return retcode; @@ -95,8 +104,8 @@ int it_slides; int it_insns; int it_BCO_entries; -int it_ofreq[26]; -int it_oofreq[26][26]; +int it_ofreq[27]; +int it_oofreq[27][27]; int it_lastopc; void interp_startup ( void ) @@ -107,9 +116,9 @@ void interp_startup ( void ) for (i = 0; i < N_CLOSURE_TYPES; i++) it_unknown_entries[i] = 0; it_slides = it_insns = it_BCO_entries = 0; - for (i = 0; i < 26; i++) it_ofreq[i] = 0; - for (i = 0; i < 26; i++) - for (j = 0; j < 26; j++) + for (i = 0; i < 27; i++) it_ofreq[i] = 0; + for (i = 0; i < 27; i++) + for (j = 0; j < 27; j++) it_oofreq[i][j] = 0; it_lastopc = 0; } @@ -117,7 +126,7 @@ void interp_startup ( void ) void interp_shutdown ( void ) { int i, j, k, o_max, i_max, j_max; - fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ???)\n", + fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n", it_retto_BCO + it_retto_UPDATE + it_retto_other, it_retto_BCO, it_retto_UPDATE, it_retto_other ); fprintf(stderr, "%d total entries, %d unknown entries \n", @@ -131,14 +140,14 @@ void interp_shutdown ( void ) } fprintf(stderr, "%d insns, %d slides, %d BCO_entries\n", it_insns, it_slides, it_BCO_entries); - for (i = 0; i < 26; i++) + for (i = 0; i < 27; i++) fprintf(stderr, "opcode %2d got %d\n", i, it_ofreq[i] ); for (k = 1; k < 20; k++) { o_max = 0; i_max = j_max = 0; - for (i = 0; i < 26; i++) { - for (j = 0; j < 26; j++) { + for (i = 0; i < 27; i++) { + for (j = 0; j < 27; j++) { if (it_oofreq[i][j] > o_max) { o_max = it_oofreq[i][j]; i_max = i; j_max = j; @@ -171,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: @@ -195,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"); ); @@ -322,7 +328,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) case SEQ_FRAME: /* Too complicated ... adopt the Usual Solution. */ - fprintf(stderr, "!!! SEQ frame in PAP update\n"); + /* fprintf(stderr, "!!! SEQ frame in PAP update\n"); */ goto defer_to_sched; case CATCH_FRAME: @@ -369,12 +375,30 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) register StgInfoTable** itbls = (StgInfoTable**) (&bco->itbls->payload[0]); + /* Heap check */ if (doYouWantToGC()) { iSp--; StackWord(0) = (W_)bco; - cap->rCurrentTSO->what_next = ThreadEnterGHC; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; RETURN(HeapOverflow); } + /* "Standard" stack check */ + if (iSp - (INTERP_STACK_CHECK_THRESH+1) < iSpLim) { + iSp--; + StackWord(0) = (W_)obj; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; + RETURN(StackOverflow); + } + + /* Context-switch check */ + if (context_switch) { + iSp--; + StackWord(0) = (W_)obj; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; + RETURN(ThreadYielding); + } + + # ifdef INTERP_STATS it_lastopc = 0; /* no opcode */ # endif @@ -385,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; @@ -397,12 +421,12 @@ 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 it_insns++; - ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 26 ); + ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 27 ); it_ofreq[ (int)instrs[bciPtr] ] ++; it_oofreq[ it_lastopc ][ (int)instrs[bciPtr] ] ++; it_lastopc = (int)instrs[bciPtr]; @@ -410,6 +434,18 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) switch (BCO_NEXT) { + case bci_STKCHECK: { + /* An explicit stack check; we hope these will be + rare. */ + int stk_words_reqd = BCO_NEXT + 1; + if (iSp - stk_words_reqd < iSpLim) { + iSp--; + StackWord(0) = (W_)obj; + cap->r.rCurrentTSO->what_next = ThreadEnterInterp; + RETURN(StackOverflow); + } + goto nextInsn; + } case bci_ARGCHECK: { int i; StgPAP* pap; @@ -449,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: { @@ -534,7 +570,7 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) ap = (StgAP_UPD*)allocate_UPD(request); StackWord(-1) = (W_)ap; ap->n_args = n_payload; - SET_HDR(ap, &stg_AP_UPD_info, ??) + SET_HDR(ap, &stg_AP_UPD_info, CCS_SYSTEM/*ToDo*/) iSp --; goto nextInsn; } @@ -663,6 +699,30 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) bciPtr = failto; goto nextInsn; } + case bci_TESTLT_F: { + /* The top thing on the stack should be a tagged float. */ + int discr = BCO_NEXT; + int failto = BCO_NEXT; + StgFloat stackFlt, discrFlt; + ASSERT(sizeofW(StgFloat) == StackWord(0)); + stackFlt = PK_FLT( & StackWord(1) ); + discrFlt = PK_FLT( & BCO_LIT(discr) ); + if (stackFlt >= discrFlt) + bciPtr = failto; + goto nextInsn; + } + case bci_TESTEQ_F: { + /* The top thing on the stack should be a tagged float. */ + int discr = BCO_NEXT; + int failto = BCO_NEXT; + StgFloat stackFlt, discrFlt; + ASSERT(sizeofW(StgFloat) == StackWord(0)); + stackFlt = PK_FLT( & StackWord(1) ); + discrFlt = PK_FLT( & BCO_LIT(discr) ); + if (stackFlt != discrFlt) + bciPtr = failto; + goto nextInsn; + } /* Control-flow ish things */ case bci_ENTER: { @@ -678,7 +738,8 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1p_info || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1n_info || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_F1_info - || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_D1_info) { + || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_D1_info + || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_V_info) { /* Returning to interpreted code. Interpret the BCO immediately underneath the itbl. */ StgBCO* ret_bco = (StgBCO*)StackWord(tag +1+1); @@ -692,19 +753,48 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) the TOS value into R1/F1/D1 and do a standard compiled-code return. */ StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl); - StackWord(0) = (W_)magic_itbl; - cap->rCurrentTSO->what_next = ThreadRunGHC; - RETURN(ThreadYielding); + if (magic_itbl != NULL) { + StackWord(0) = (W_)magic_itbl; + cap->r.rCurrentTSO->what_next = ThreadRunGHC; + RETURN(ThreadYielding); + } else { + /* Special case -- returning a VoidRep to + compiled code. T.O.S is the VoidRep tag, + and underneath is the return itbl. Zap the + tag and enter the itbl. */ + ASSERT(StackWord(0) == (W_)NULL); + iSp ++; + 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); + marshall_fn ( (void*)(& StackWord(0) ) ); + cap = (Capability *)((void *)resumeThread(tok) - sizeof(StgFunTable)); + LOAD_STACK_POINTERS; + goto nextInsn; + } + case bci_JMP: { + /* BCO_NEXT modifies bciPtr, so be conservative. */ + int nextpc = BCO_NEXT; + bciPtr = nextpc; + goto nextInsn; + } case bci_CASEFAIL: barf("interpretBCO: hit a CASEFAIL"); - /* As yet unimplemented */ - case bci_TESTLT_F: - case bci_TESTEQ_F: - /* Errors */ default: barf("interpretBCO: unknown or unimplemented opcode"); @@ -734,12 +824,10 @@ 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 */ barf("fallen off end of object-type switch in interpretBCO()"); } - -#endif /* GHCI */