diff options
author | sewardj <unknown> | 2001-01-09 17:36:41 +0000 |
---|---|---|
committer | sewardj <unknown> | 2001-01-09 17:36:41 +0000 |
commit | 7fbfad3e61e92c6869f624414975b9d68675f27f (patch) | |
tree | ddb2552bf13e8f81c54a9acd5bdd936f847bc404 /ghc/rts/Interpreter.c | |
parent | 65494b207a56d8efdafcbe27b17f3141374fdb27 (diff) | |
download | haskell-7fbfad3e61e92c6869f624414975b9d68675f27f.tar.gz |
[project @ 2001-01-09 17:36:21 by sewardj]
Various bug fixes for the interpreter/byte-code-gen combination.
Diffstat (limited to 'ghc/rts/Interpreter.c')
-rw-r--r-- | ghc/rts/Interpreter.c | 32 |
1 files changed, 26 insertions, 6 deletions
diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index f993feeca3..daf5bb5dae 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-2000. * * $RCSfile: Interpreter.c,v $ - * $Revision: 1.8 $ - * $Date: 2001/01/05 15:24:28 $ + * $Revision: 1.9 $ + * $Date: 2001/01/09 17:36:21 $ * ---------------------------------------------------------------------------*/ #ifdef GHCI @@ -78,6 +78,12 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) fprintf(stderr,"Entering: "); printObj(obj); fprintf(stderr,"iSp = %p\tiSu = %p\n", iSp, iSu); fprintf(stderr, "\n" ); + + // checkSanity(1); + // iSp--; StackWord(0) = obj; + // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + // iSp++; + printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); fprintf(stderr, "\n\n"); ); @@ -93,6 +99,9 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) StgAP_UPD *ap = (StgAP_UPD*)obj; Words = ap->n_args; + /* WARNING: do a stack overflow check here ! + This code (copied from stg_AP_UPD_entry) is not correct without it. */ + iSp -= sizeofW(StgUpdateFrame); { @@ -104,7 +113,6 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) iSu = __frame; } - /* WARNING: do a stack overflow check here ! */ iSp -= Words; /* Reload the stack */ @@ -151,6 +159,8 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) } ); + // checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu); + switch (BCO_NEXT) { case bci_ARGCHECK: { @@ -321,6 +331,17 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) bciPtr = failto; goto nextInsn; } + case bci_TESTEQ_I: { + /* The top thing on the stack should be a tagged int. */ + int discr = BCO_NEXT; + int failto = BCO_NEXT; + I_ stackInt = (I_)StackWord(1); + ASSERT(1 == StackWord(0)); + fprintf(stderr, "TESTEQ_I: discr = %d, stack = %d\n",(I_)BCO_LIT(discr), stackInt); + if (stackInt != (I_)BCO_LIT(discr)) + bciPtr = failto; + goto nextInsn; + } /* Control-flow ish things */ case bci_ENTER: { @@ -331,14 +352,14 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) compiled code. */ int o_itoc_itbl = BCO_NEXT; int tag = StackWord(0); - StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag+1 +1); + StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag +1); ASSERT(tag <= 2); /* say ... */ if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1_info /* || ret_itbl == stg_ctoi_ret_F1_info || ret_itbl == stg_ctoi_ret_D1_info */) { /* Returning to interpreted code. Interpret the BCO immediately underneath the itbl. */ - StgBCO* ret_bco = (StgBCO*)StackWord(tag+1 +1+1); + StgBCO* ret_bco = (StgBCO*)StackWord(tag +1+1); iSp --; StackWord(0) = (W_)ret_bco; goto nextEnter; @@ -359,7 +380,6 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) /* As yet unimplemented */ case bci_TESTLT_I: - case bci_TESTEQ_I: case bci_TESTLT_F: case bci_TESTEQ_F: case bci_TESTLT_D: |