* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.8 $
- * $Date: 1999/04/27 10:07:15 $
+ * $Revision: 1.9 $
+ * $Date: 1999/07/06 16:40:22 $
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
return bco->sp;
}
+AsmVar asmGHCClosure( AsmBCO bco, AsmObject p )
+{
+ // A complete hack. Pushes the address as a tagged int
+ // and then uses SLIDE to get rid of the tag. Appalling.
+ asmConstInt(bco, (AsmInt)p);
+ emit_i_SLIDE(bco,0,1); bco->sp -= 1;
+ return bco->sp;
+}
+
+
/* --------------------------------------------------------------------------
* Building InfoTables
* ------------------------------------------------------------------------*/
* Copyright (c) 1994-1998.
*
* $RCSfile: Disassembler.c,v $
- * $Revision: 1.6 $
- * $Date: 1999/04/27 10:07:19 $
+ * $Revision: 1.7 $
+ * $Date: 1999/07/06 16:40:24 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
static InstrPtr disConstInt ( StgBCO *bco, InstrPtr pc, char* i )
{
StgInt x = bcoConstInt(bco,bcoInstr(bco,pc++));
- fprintf(stderr,"%s %d",i,x);
+ fprintf(stderr,"%s %d (0x%x)",i,x,x);
return pc;
}
static InstrPtr disConstInt16 ( StgBCO *bco, InstrPtr pc, char* i )
{
StgInt x = bcoConstInt(bco,bcoInstr16(bco,pc)); pc += 2;
- fprintf(stderr,"%s %d",i,x);
+ fprintf(stderr,"%s %d (0x%x)",i,x,x);
return pc;
}
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
- * $Revision: 1.16 $
- * $Date: 1999/05/11 16:47:50 $
+ * $Revision: 1.17 $
+ * $Date: 1999/07/06 16:40:24 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
);
#endif
- if (++eCount == 0) {
+ if (
+#ifdef DEBUG
+ 1 ||
+#endif
+ ++eCount == 0) {
if (context_switch) {
xPushCPtr(obj); /* code to restart with */
RETURN(ThreadYielding);
fprintf(stderr,"Sp = %p\tSu = %p\tpc = %d\t", xSp, xSu, PC);
SSS;
disInstr(bco,PC);
- { int i;
+ if (0) { int i;
fprintf(stderr,"\n");
for (i = 8; i >= 0; i--)
fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i)));
ASSERT( itbl->type == CONSTR
|| itbl->type == CONSTR_STATIC
|| itbl->type == CONSTR_NOCAF_STATIC
+ || itbl->type == CONSTR_1_0
+ || itbl->type == CONSTR_0_1
+ || itbl->type == CONSTR_2_0
+ || itbl->type == CONSTR_1_1
+ || itbl->type == CONSTR_0_2
);
while (--i>=0) {
xPushCPtr(payloadCPtr(o,i));
goto enterLoop;
}
case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_2_0:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
case CONSTR_STATIC:
}
default:
{
- SSS;
- fprintf(stderr, "enterCountI = %d\n", enterCountI);
- fprintf(stderr, "panic: enter: entered unknown closure\n");
- printObj(obj);
- fprintf(stderr, "what it points at is\n");
- printObj( ((StgEvacuated*)obj) ->evacuee);
- LLL;
- exit(1);
- /* formerly ... */
+ //SSS;
+ //fprintf(stderr, "enterCountI = %d\n", enterCountI);
+ //fprintf(stderr, "entering unknown closure -- yielding to sched\n");
+ //printObj(obj);
+ //LLL;
CurrentTSO->whatNext = ThreadEnterGHC;
xPushCPtr(obj); /* code to restart with */
RETURN(ThreadYielding);
/* -----------------------------------------------------------------------------
- * $Id: StgCRun.c,v 1.5 1999/03/11 11:21:47 simonm Exp $
+ * $Id: StgCRun.c,v 1.6 1999/07/06 16:40:27 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
static jmp_buf jmp_environment;
+#if 0
+
extern StgThreadReturnCode StgRun(StgFunPtr f)
{
jmp_buf save_buf;
memcpy((void *) jmp_environment, (void *) save_buf, sizeof(jmp_buf));
if (setjmp(jmp_environment) == 0) {
while ( 1 ) {
- IF_DEBUG(evaluator,
+ IF_DEBUG(evaluator,
fprintf(stderr,"Jumping to ");
printPtr((P_)f);
fprintf(stderr,"\n");
longjmp(jmp_environment, 1);
}
+#else
+
+extern StgThreadReturnCode StgRun(StgFunPtr f)
+{
+ char* nm;
+ while ( f ) {
+
+#if 0
+ //IF_DEBUG(evaluator,
+ fprintf(stderr,"Jumping to ");
+ nm = nameOfObjSym ( f );
+ if (nm)
+ fprintf(stderr, "%s (%p)", nm, f); else
+ printPtr((P_)f);
+ fprintf(stderr,"\n");
+ // );
+if (0&& MainRegTable.rSp) {
+ int i;
+ StgWord* p = MainRegTable.rSp;
+fprintf(stderr, "SP = %p\n", p);
+ p += (8-1);
+ for (i = 0; i < 8; i++, p--)
+ fprintf (stderr, "-- %p: %p\n", p, *p );
+}
+#endif
+
+ f = (StgFunPtr) (f)();
+ }
+
+ return (StgThreadReturnCode)R1.i;
+}
+
+EXTFUN(StgReturn)
+{
+ return 0;
+}
+#endif
+
+
+
#else /* !USE_MINIINTERPRETER */
#ifdef LEADING_UNDERSCORE
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.25 1999/06/08 10:26:39 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.26 1999/07/06 16:40:27 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
STGFUN(Hugs_CONSTR_entry)
{
- Sp -= 1;
- ((StgPtr*)Sp)[0] = R1.p;
- /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */
- JMP_(ENTRY_CODE(((StgPtr*)Sp)[1]));
+ /* R1 points at the constructor */
+ JMP_(ENTRY_CODE(((StgPtr*)Sp)[0]));
}
#define RET_BCO_ENTRY_TEMPLATE(label) \
/* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.17 1999/05/13 17:31:14 simonm Exp $
+ * $Id: Updates.hc,v 1.18 1999/07/06 16:40:28 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
FE_ \
}
-UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
+//UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
+ STGFUN(Upd_frame_entry);
+ STGFUN(Upd_frame_entry)
+ {
+ StgClosure *updatee;
+ FB_
+ /* tick - ToDo: check this is right */
+ TICK_UPD_EXISTING();
+
+ updatee = ((StgUpdateFrame *)Sp)->updatee;
+
+ /* update the updatee with an indirection to the return value */
+ UPD_IND(updatee,R1.p);
+
+ /* reset Su to the next update frame */
+ Su = ((StgUpdateFrame *)Sp)->link;
+
+ /* remove the update frame from the stack */
+ Sp += sizeofW(StgUpdateFrame);
+
+ JMP_(ENTRY_CODE(Sp[0]));
+ FE_
+ }
+
+
UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));