diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c
index c959e3ff168bff628620d4e5d0b47e17326c6760..738b8911d40e560fdc557fbf15a133731a3adf4d 100644
--- a/ghc/rts/Assembler.c
+++ b/ghc/rts/Assembler.c
@@ -5,8 +5,8 @@
* 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.
@@ -1554,6 +1554,16 @@ AsmVar asmClosure( AsmBCO bco, AsmObject p )
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
* ------------------------------------------------------------------------*/
diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c
index 9cd5054d2eb9ff09530f84c3d4123af73715a8e8..0cfc6b7f0c00e4547279b8ff79e685cf4d3de0f1 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.6 $
- * $Date: 1999/04/27 10:07:19 $
+ * $Revision: 1.7 $
+ * $Date: 1999/07/06 16:40:24 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
@@ -120,14 +120,14 @@ static InstrPtr disConstPtr16 ( StgBCO *bco, InstrPtr pc, char* i )
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;
}
diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c
index 66f4a897f7952d86fedcdc3a203acdb9ad3646e6..f7c814726dadc99a9a6e3af0077886e81fd726a3 100644
--- a/ghc/rts/Evaluator.c
+++ b/ghc/rts/Evaluator.c
@@ -5,8 +5,8 @@
* 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"
@@ -473,7 +473,11 @@ StgThreadReturnCode enter( StgClosure* obj0 )
);
#endif
- if (++eCount == 0) {
+ if (
+#ifdef DEBUG
+ 1 ||
+#endif
+ ++eCount == 0) {
if (context_switch) {
xPushCPtr(obj); /* code to restart with */
RETURN(ThreadYielding);
@@ -532,7 +536,7 @@ StgThreadReturnCode enter( StgClosure* obj0 )
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)));
@@ -813,6 +817,11 @@ StgThreadReturnCode enter( StgClosure* obj0 )
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));
@@ -1341,6 +1350,11 @@ StgThreadReturnCode enter( StgClosure* obj0 )
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:
@@ -1400,15 +1414,11 @@ StgThreadReturnCode enter( StgClosure* obj0 )
}
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);
diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c
index 91e464c8bc515e65b2633dd34922eda66bf4238b..016275eb73f622c9eb9da06f5b2e14d9cd6e0839 100644
--- a/ghc/rts/StgCRun.c
+++ b/ghc/rts/StgCRun.c
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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
*
@@ -38,6 +38,8 @@
static jmp_buf jmp_environment;
+#if 0
+
extern StgThreadReturnCode StgRun(StgFunPtr f)
{
jmp_buf save_buf;
@@ -45,7 +47,7 @@ extern StgThreadReturnCode StgRun(StgFunPtr f)
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");
@@ -64,6 +66,46 @@ EXTFUN(StgReturn)
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
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index ad32cd0cb0e11d384c66d5f7cf0f811051901404..10d8cd0d6774eaf06456cdc278819360c66d5172 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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
*
@@ -501,10 +501,8 @@ SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
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) \
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index e9ac61f1be4419df307d586847fbb4e87b04621d..5c64e4d6a24ac2dfbb380d6fcb15720809370a1d 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $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
*
@@ -70,7 +70,31 @@
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));