[project @ 1999-07-06 16:40:22 by sewardj]

Assembler/Disassembler: handle and print calls to compiled code
Evaluator: return to scheduler when entering unknown closure
StgCRun: debugging trace in miniinterpreter (temporary)
Updates: fix normal and vectored returns to Hugs

6 files changed, 112 insertions, 28 deletions

diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c
index c959e3ff16..738b8911d4 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 9cd5054d2e..0cfc6b7f0c 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 66f4a897f7..f7c814726d 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 91e464c8bc..016275eb73 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 ad32cd0cb0..10d8cd0d67 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 e9ac61f1be..5c64e4d6a2 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));