summaryrefslogtreecommitdiff
path: root/ghc/rts/Interpreter.c
diff options
context:
space:
mode:
authorsewardj <unknown>2001-01-09 17:36:41 +0000
committersewardj <unknown>2001-01-09 17:36:41 +0000
commit7fbfad3e61e92c6869f624414975b9d68675f27f (patch)
treeddb2552bf13e8f81c54a9acd5bdd936f847bc404 /ghc/rts/Interpreter.c
parent65494b207a56d8efdafcbe27b17f3141374fdb27 (diff)
downloadhaskell-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.c32
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: