[project @ 2001-08-09 11:19:16 by sewardj]

C-side FFI support for Byte/Ptr arrays.

diff --git a/ghc/includes/Bytecodes.h b/ghc/includes/Bytecodes.h
index 579998b..fe32488 100644 (file)
--- a/ghc/includes/Bytecodes.h
+++ b/ghc/includes/Bytecodes.h
@@ -1,6 +1,6 @@
 
 /* -----------------------------------------------------------------------------
- * $Id: Bytecodes.h,v 1.7 2001/08/02 17:01:33 sewardj Exp $
+ * $Id: Bytecodes.h,v 1.8 2001/08/09 11:19:16 sewardj Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -53,7 +53,7 @@
 #define bci_STKCHECK  26
 #define bci_JMP       27
 #define bci_CCALL     28
-
+#define bci_SWIZZLE   29
 
 /* If a BCO definitely requires less than this many words of stack,
    don't include an explicit STKCHECK insn in it.  The interpreter

diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c
index e0b27e9..574f0a8 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.22 $
- * $Date: 2001/08/02 17:01:33 $
+ * $Revision: 1.23 $
+ * $Date: 2001/08/09 11:19:16 $
  * ---------------------------------------------------------------------------*/
 
 #ifdef DEBUG
@@ -44,9 +44,13 @@ int disInstr ( StgBCO *bco, int pc )
    StgInfoTable** itbls       = (StgInfoTable**)(&itbls_arr->payload[0]);
 
    switch (instrs[pc++]) {
+      case bci_SWIZZLE:
+         fprintf(stderr, "SWIZZLE stkoff %d by %d\n",
+                         instrs[pc], (signed int)instrs[pc+1]);
+         pc += 2; break;
       case bci_CCALL:
          fprintf(stderr, "CCALL    marshaller at 0x%x\n", 
-                         literals[instrs[pc+1]] );
+                         literals[instrs[pc]] );
          pc += 1; break;
       case bci_STKCHECK: 
          fprintf(stderr, "STKCHECK %d\n", instrs[pc] );

diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
index cb78cdd..cf5b99f 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.27 $
- * $Date: 2001/08/07 09:02:02 $
+ * $Revision: 1.28 $
+ * $Date: 2001/08/09 11:19:16 $
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
@@ -37,7 +37,7 @@
    scheduler.  Ie normally you don't want REFERENCE_INTERPRETER to be
    defined. */
 
-/* #define REFERENCE_INTERPRETER */
+#define REFERENCE_INTERPRETER
 
 /* Gather stats about entry, opcode, opcode-pair frequencies.  For
    tuning the interpreter. */
@@ -763,6 +763,12 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
                      }
                  }
               }
+              case bci_SWIZZLE: {
+                 int stkoff = BCO_NEXT;
+                 signed short n = (signed short)(BCO_NEXT);
+                 StackWord(stkoff) += (W_)n;
+                 goto nextInsn;
+              }
               case bci_CCALL: {
                  StgInt tok;
                  int o_itbl                = BCO_NEXT;

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index d71c436..e73b3f7 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.43 2001/08/04 06:09:24 ken Exp $
+ * $Id: Printer.c,v 1.44 2001/08/09 11:19:16 sewardj Exp $
  *
  * (c) The GHC Team, 1994-2000.
  *
@@ -121,6 +121,12 @@ void printClosure( StgClosure *obj )
             break;
         }
 
+    case FOREIGN:
+            fprintf(stderr,"FOREIGN("); 
+            printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
+            fprintf(stderr,")\n"); 
+            break;
+
     case IND:
             fprintf(stderr,"IND("); 
             printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
@@ -341,6 +347,7 @@ void printClosure( StgClosure *obj )
             //barf("printClosure %d",get_itbl(obj)->type);
             fprintf(stderr, "*** printClosure: unknown type %d ****\n",
                     get_itbl(obj)->type );
+            barf("printClosure %d",get_itbl(obj)->type);
             return;
     }
 }