[project @ 2001-01-05 15:24:28 by sewardj]

Various bug fixes.

diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c
index 29d40d6..65809d3 100644 (file)
--- 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 (file)
--- 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; 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:
 
@@ -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 (file)
--- 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");