From 7215e7347b9e46ef5991bc07140dfd58b0a70cad Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 5 Jan 2001 15:24:28 +0000 Subject: [PATCH] [project @ 2001-01-05 15:24:28 by sewardj] Various bug fixes. --- ghc/rts/Disassembler.c | 6 +++-- ghc/rts/Interpreter.c | 68 +++++++++++++++++++++++++----------------------- ghc/rts/Printer.c | 21 ++++++++------- 3 files changed, 52 insertions(+), 43 deletions(-) diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 29d40d6..65809d3 100644 --- a/ghc/rts/Disassembler.c +++ b/ghc/rts/Disassembler.c @@ -5,8 +5,8 @@ * Copyright (c) 1994-1998. * * $RCSfile: Disassembler.c,v $ - * $Revision: 1.17 $ - * $Date: 2001/01/03 16:44:30 $ + * $Revision: 1.18 $ + * $Date: 2001/01/05 15:24:28 $ * ---------------------------------------------------------------------------*/ #ifdef GHCI @@ -64,6 +64,7 @@ int disInstr ( StgBCO *bco, int pc ) case bci_PUSH_AS: fprintf(stderr, "PUSH_AS " ); printPtr( ptrs[instrs[pc]] ); fprintf(stderr, " 0x%x", literals[instrs[pc+1]] ); + fprintf(stderr, "\n"); pc += 2; break; case bci_PUSH_UBX: fprintf(stderr, "PUSH_UBX "); @@ -94,6 +95,7 @@ int disInstr ( StgBCO *bco, int pc ) case bci_PACK: fprintf(stderr, "PACK %d words with itbl ", instrs[pc+1] ); printPtr( (StgPtr)itbls[instrs[pc]] ); + fprintf(stderr, "\n"); pc += 2; break; case bci_TESTLT_I: diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index 7187b60..f993fee 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.7 $ - * $Date: 2001/01/03 16:44:30 $ + * $Revision: 1.8 $ + * $Date: 2001/01/05 15:24:28 $ * ---------------------------------------------------------------------------*/ #ifdef GHCI @@ -86,32 +86,34 @@ StgThreadReturnCode interpretBCO ( Capability* cap ) case INVALID_OBJECT: barf("Invalid object %p",(StgPtr)obj); - case AP_UPD: - { nat Words; - nat i; - StgAP_UPD *ap = (StgAP_UPD*)obj; -fprintf(stderr, "home-grown AP_UPD code\n"); - Words = ap->n_args; - - iSp -= sizeofW(StgUpdateFrame); - - { - StgUpdateFrame *__frame; - __frame = (StgUpdateFrame *)iSp; - SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info); - __frame->link = iSu; - __frame->updatee = (StgClosure *)(ap); - iSu = __frame; - } +#if 0 + case AP_UPD: + { nat Words; + nat i; + StgAP_UPD *ap = (StgAP_UPD*)obj; + Words = ap->n_args; + + iSp -= sizeofW(StgUpdateFrame); + + { + StgUpdateFrame *__frame; + __frame = (StgUpdateFrame *)iSp; + SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info); + __frame->link = iSu; + __frame->updatee = (StgClosure *)(ap); + iSu = __frame; + } - iSp -= Words; + /* WARNING: do a stack overflow check here ! */ + iSp -= Words; - /* Reload the stack */ - for (i=0; ipayload[i]; + /* Reload the stack */ + for (i=0; ipayload[i]; - iSp--; StackWord(0) = (W_)ap->fun; - goto nextEnter; - } + iSp--; StackWord(0) = (W_)ap->fun; + goto nextEnter; + } +#endif case BCO: @@ -159,7 +161,7 @@ fprintf(stderr, "home-grown AP_UPD code\n"); if (arg_words_avail >= arg_words_reqd) goto nextInsn; /* Handle arg check failure. Copy the spare args into a PAP frame. */ - fprintf(stderr, "arg check fail %d %d\n", arg_words_reqd, arg_words_avail ); + /* fprintf(stderr, "arg check fail %d %d\n", arg_words_reqd, arg_words_avail ); */ pap = (StgPAP*)allocate(PAP_sizeW(arg_words_avail)); SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/); pap->n_args = arg_words_avail; @@ -206,8 +208,8 @@ fprintf(stderr, "home-grown AP_UPD code\n"); case bci_PUSH_AS: { int o_bco = BCO_NEXT; int o_itbl = BCO_NEXT; - StackWord(-1) = BCO_LIT(o_itbl); - StackWord(-2) = BCO_PTR(o_bco); + StackWord(-2) = BCO_LIT(o_itbl); + StackWord(-1) = BCO_PTR(o_bco); iSp -= 2; goto nextInsn; } @@ -252,7 +254,7 @@ fprintf(stderr, "home-grown AP_UPD code\n"); int stkoff = BCO_NEXT; int n_payload = BCO_NEXT - 1; StgAP_UPD* ap = (StgAP_UPD*)StackWord(stkoff); - ASSERT(ap->n_args == n_payload); + ASSERT((int)ap->n_args == n_payload); ap->fun = (StgClosure*)StackWord(0); for (i = 0; i < n_payload; i++) ap->payload[i] = (StgClosure*)StackWord(i+1); @@ -307,7 +309,7 @@ fprintf(stderr, "home-grown AP_UPD code\n"); int discr = BCO_NEXT; int failto = BCO_NEXT; StgClosure* con = (StgClosure*)StackWord(0); - if (constrTag(con) < discr) + if (constrTag(con) >= discr) bciPtr = failto; goto nextInsn; } @@ -378,8 +380,10 @@ fprintf(stderr, "home-grown AP_UPD code\n"); default: { /* Can't handle this object; yield to sched. */ - fprintf(stderr, "entering unknown closure -- yielding to sched\n"); - printObj(obj); + IF_DEBUG(evaluator, + fprintf(stderr, "entering unknown closure -- yielding to sched\n"); + printObj(obj); + ) cap->rCurrentTSO->what_next = ThreadEnterGHC; iSp--; StackWord(0) = (W_)obj; RETURN(ThreadYielding); diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 4b85b20..ed47cfb 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Printer.c,v 1.30 2001/01/03 16:44:30 sewardj Exp $ + * $Id: Printer.c,v 1.31 2001/01/05 15:24:28 sewardj Exp $ * * (c) The GHC Team, 1994-2000. * @@ -384,15 +384,18 @@ StgPtr printStackObj( StgPtr sp ) } else { StgClosure* c = (StgClosure*)(*sp); printPtr((StgPtr)*sp); -#ifdef INTERPRETER - if (c == &ret_bco_info) { - fprintf(stderr, "\t\t"); - fprintf(stderr, "ret_bco_info\n" ); +#ifdef GHCI + if (c == (StgClosure*)&stg_ctoi_ret_R1_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_R1_info\n" ); } else - if (IS_HUGS_CONSTR_INFO(GET_INFO(c))) { - fprintf(stderr, "\t\t\t"); - fprintf(stderr, "ConstrInfoTable\n" ); - } else +#if 0 + if (c == (StgClosure*)&stg_ctoi_ret_F1_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" ); + } else + if (c == (StgClosure*)&stg_ctoi_ret_D1_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" ); + } else +#endif #endif if (get_itbl(c)->type == BCO) { fprintf(stderr, "\t\t\t"); -- 1.7.10.4