* 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
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 ");
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:
* 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
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; i<Words; i++) StackWord(i) = (W_)ap->payload[i];
+ /* Reload the stack */
+ for (i=0; i<Words; i++) StackWord(i) = (W_)ap->payload[i];
- iSp--; StackWord(0) = (W_)ap->fun;
- goto nextEnter;
- }
+ iSp--; StackWord(0) = (W_)ap->fun;
+ goto nextEnter;
+ }
+#endif
case BCO:
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;
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;
}
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);
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;
}
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);
/* -----------------------------------------------------------------------------
- * $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.
*
} 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");