[MLton-commit] r5710

Matthew Fluet fluet at mlton.org
Sun Jul 1 20:59:17 PDT 2007


Working on bytecode codegen; not fully working yet.
----------------------------------------------------------------------

U   mlton/trunk/Makefile
U   mlton/trunk/include/bytecode-main.h
U   mlton/trunk/mlton/codegen/bytecode/bytecode.fun
U   mlton/trunk/mlton/main/main.fun
U   mlton/trunk/runtime/Makefile
U   mlton/trunk/runtime/bytecode/interpret.c
U   mlton/trunk/runtime/bytecode/interpret.h
U   mlton/trunk/runtime/bytecode/opcode.h

----------------------------------------------------------------------

Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/Makefile	2007-07-02 03:59:14 UTC (rev 5710)
@@ -289,14 +289,14 @@
 		basis-library/config/c/$(TARGET_ARCH)-$(TARGET_OS)/c-types.sml	
 	$(CP) runtime/gen/basis-ffi.sml \
 		basis-library/primitive/basis-ffi.sml
-        # $(CP) runtime/bytecode/opcodes "$(LIB)/"
+	$(CP) runtime/bytecode/opcodes "$(LIB)/"
 	$(CP) runtime/*.h "$(INC)/"
 	mv "$(INC)/c-types.h" "$(LIB)/$(TARGET)/include"
 	for d in basis basis/Real basis/Word gc platform util; do	\
 		mkdir -p "$(INC)/$$d";					\
 		$(CP) runtime/$$d/*.h "$(INC)/$$d";			\
 	done
-        # $(CP) runtime/bytecode/interpret.h "$(INC)"
+	$(CP) runtime/bytecode/interpret.h "$(INC)"
 	for x in "$(LIB)"/"$(TARGET)"/*.a; do $(RANLIB) "$$x"; done
 
 .PHONY: script

Modified: mlton/trunk/include/bytecode-main.h
===================================================================
--- mlton/trunk/include/bytecode-main.h	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/include/bytecode-main.h	2007-07-02 03:59:14 UTC (rev 5710)
@@ -18,13 +18,12 @@
 struct Bytecode MLton_bytecode;
 
 static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
-        return *(GC_frameIndex*)(MLton_bytecode.code 
-                                 + ra - sizeof (GC_frameIndex*));
+        return *((GC_frameIndex*)(MLton_bytecode.code + ra - sizeof(GC_frameIndex)));
 }
 
 #define Main(al, mg, mfs, mmc, pk, ps, ml)                              \
 void MLton_callFromC () {                                               \
-        int nextFun;                                                    \
+        uintptr_t nextFun;                                              \
         GC_state s;                                                     \
                                                                         \
         if (DEBUG_CODEGEN)                                              \
@@ -34,7 +33,7 @@
         s->atomicState += 3;                                            \
         /* Switch to the C Handler thread. */                           \
         GC_switchToThread (s, s->callFromCHandlerThread, 0);            \
-        nextFun = *(int*)(s->stackTop - GC_RETURNADDRESS_SIZE);         \
+        nextFun = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE);   \
         MLton_Bytecode_interpret (&MLton_bytecode, nextFun);            \
         GC_switchToThread (s, s->savedThread, 0);                       \
         s->savedThread = BOGUS_OBJPTR;                                  \
@@ -42,14 +41,14 @@
                 fprintf (stderr, "MLton_callFromC done\n");             \
 }                                                                       \
 int main (int argc, char **argv) {                                      \
-        int nextFun;                                                    \
+        uintptr_t nextFun;                                              \
         Initialize (al, mg, mfs, mmc, pk, ps);                          \
         if (gcState.amOriginal) {                                       \
                 real_Init();                                            \
                 nextFun = ml;                                           \
         } else {                                                        \
                 /* Return to the saved world */                         \
-                nextFun = *(int*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+                nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
         }                                                               \
         MLton_Bytecode_interpret (&MLton_bytecode, nextFun);            \
 }

Modified: mlton/trunk/mlton/codegen/bytecode/bytecode.fun
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/bytecode.fun	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/mlton/codegen/bytecode/bytecode.fun	2007-07-02 03:59:14 UTC (rev 5710)
@@ -46,20 +46,11 @@
       datatype z = datatype Prim.Name.t
    in
       case Prim.name p of
-         Real_Math_acos _ => false
-       | Real_Math_asin _ => false
-       | Real_Math_atan _ => false
-       | Real_Math_atan2 _ => false
-       | Real_Math_cos _ => false
-       | Real_Math_exp _ => false
-       | Real_Math_ln _ => false
-       | Real_Math_log10 _ => false
-       | Real_Math_sin _ => false
-       | Real_Math_sqrt _ => false
-       | Real_Math_tan _ => false
-       | Real_ldexp _ => false
+         Real_ldexp _ => false
        | Real_muladd _ => false
        | Real_mulsub _ => false
+       | Word_quot _ => true
+       | Word_rem _ => true
        | _ => CCodegen.implementsPrim p
    end
 
@@ -79,11 +70,11 @@
                             | CType.Objptr => NONE 
                             | _ => SOME (f t))
          in
-            CType.memo (fn t =>
-                        valOf (case t of
-                                  CType.CPointer => m CType.Word32
-                                | CType.Objptr => m CType.Word32
-                                | _ => m t))
+            fn t =>
+            valOf (case t of
+                      CType.CPointer => m (CType.csize ())
+                    | CType.Objptr => m (CType.csize ())
+                    | _ => m t)
          end
 
       val noSigned =
@@ -318,7 +309,9 @@
             val function =
                concat ["(", "*(", CFunction.cPointerType f, " fptr)) "]
             val display =
-               concat ["{\n\tWord32 fptr = PopReg (Word32);\n\t",
+               concat ["{\n\t", CType.toStringOrig (CType.csize ()), 
+                       " fptr = PopReg (", CType.toStringOrig (CType.csize ()), 
+                       ");\n\t",
                        callC {function = function,
                               prototype = CFunction.prototype f},
                        "\t}\n"]
@@ -424,7 +417,7 @@
            | W16 => emitWord16
            | W32 => emitWord32
            | W64 => emitWord64) (WordX.toIntInf w)
-      val emitOpcode = emitWord8
+      val emitOpcode = emitWord16
       val emitPrim: 'a Prim.t -> unit =
          fn p => emitOpcode (opcode (Prim.toString p))
       fun emitCallC (index: int): unit =
@@ -445,13 +438,10 @@
             val () = List.push (occurrenceOffsets, !offset)
             val () = if !emitted then () else List.push (needToEmit, l)
          in
-            emitWord32 0
+            emitWordX (WordX.zero (WordSize.cpointer ()))
          end
       val emitLabel =
          Trace.trace ("Bytecode.emitLabel", Label.layout, Unit.layout) emitLabel
-      fun emitLoadWord32Zero () =
-         (emitOpcode (wordOpcode (Load, CType.Word32))
-          ; emitWord32 0)
       fun loadStoreStackOffset (offset, cty, ls) =
          (emitOpcode (stackOffset (ls, cty))
           ; emitWord16 (Bytes.toIntInf offset))
@@ -473,7 +463,7 @@
              | Contents {oper, ...} =>
                    (emitLoadOperand oper
                     ; emitOpcode (contents (ls, cty)))
-             | File => emitLoadWord32Zero ()
+             | File => emitOperand (Null, ls)
              | Frontier => emitOpcode (frontier ls)
              | GCState => emitOpcode (gcState ls)
              | Global g =>
@@ -484,7 +474,8 @@
              | Label l =>
                   (emitOpcode (wordOpcode (ls, cty))
                    ; emitLabel l)
-             | Line => emitLoadWord32Zero ()
+             | Line => (emitOpcode (wordOpcode (ls, cty))
+                        ; emitWordX (WordX.zero (WordSize.cint ())))
              | Null => (emitOpcode (wordOpcode (ls, cty))
                         ; emitWordX (WordX.zero (WordSize.cpointer ())))
              | Offset {base, offset = off, ...} =>
@@ -503,6 +494,10 @@
                      Load => (emitOpcode (wordOpcode (ls, cty)); emitWordX w)
                    | Store => Error.bug "Bytecode.emitOperand: Word, Store"
          end
+      val emitLoadOperand =
+         Trace.trace
+         ("Bytecode.emitLoadOperand", Operand.layout, Unit.layout)
+         emitLoadOperand
       val emitOperand =
          Trace.trace2
          ("Bytecode.emitOperand", Operand.layout, LoadStore.layout, Unit.layout)

Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/mlton/main/main.fun	2007-07-02 03:59:14 UTC (rev 5710)
@@ -116,8 +116,7 @@
    in
       case !Control.Target.arch of
          AMD64 => (case cg of
-                      Bytecode => false
-                    | x86Codegen => false
+                      x86Codegen => false
                     | _ => true)
        | X86 => (case cg of
                     amd64Codegen => false
@@ -228,8 +227,7 @@
         SpaceString (fn s =>
                      explicitCodegen
                      := SOME (case s of
-                                 "bytecode" => (* Bytecode *)
-                                               usage "can't use bytecode codegen"
+                                 "bytecode" => Bytecode
                                | "c" => CCodegen
                                | "x86" => x86Codegen
                                | "amd64" => amd64Codegen

Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/runtime/Makefile	2007-07-02 03:59:14 UTC (rev 5710)
@@ -210,7 +210,7 @@
 	platform-gdb.o						\
 	platform/$(TARGET_OS)-gdb.o
 
-OMIT_BYTECODE := yes
+OMIT_BYTECODE := no
 ifeq ($(OMIT_BYTECODE), yes)
 else
   OBJS += bytecode/interpret.o
@@ -309,10 +309,10 @@
 	$(CC) $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -c -o $@ $<
 
 bytecode/interpret-gdb.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
-	$(CC) -I../include $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -Wno-shadow -c -o $@ $<
+	$(CC) -I../include $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -Wno-shadow -w -c -o $@ $<
 
 bytecode/interpret.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
-	$(CC) -I../include $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -Wno-shadow -c -o $@ $<
+	$(CC) -I../include $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -Wno-shadow -c -w -o $@ $<
 
 basis-gdb.o: basis.c $(BASISCFILES) $(HFILES)
 	$(CC) -Ibasis -Ibasis/Word -Ibasis/Real $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-redundant-decls -c -o $@ $<

Modified: mlton/trunk/runtime/bytecode/interpret.c
===================================================================
--- mlton/trunk/runtime/bytecode/interpret.c	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/runtime/bytecode/interpret.c	2007-07-02 03:59:14 UTC (rev 5710)
@@ -34,16 +34,16 @@
   DEBUG_BYTECODE = FALSE,
 };
 
-typedef Word32 ArrayIndex;
+typedef GC_arrayLength ArrayIndex;
 typedef Word16 ArrayOffset;
 typedef Word16 CallCIndex;
 typedef Word16 GlobalIndex;
-typedef Word32 Label;
+typedef uintptr_t Label;
 typedef Int16 Offset;  // Offset must be signed.
 typedef Pointer ProgramCounter;
 typedef Word16 RegIndex;
 typedef Word8 Scale;
-typedef Word16 StackOffset;  // StackOffset must be signed.
+typedef Int16 StackOffset;  // StackOffset must be signed.
 typedef Pointer StackTop;
 
 struct GC_state gcState;
@@ -58,12 +58,8 @@
         static ty ty##VReg[1000];               \
         ty ty##Reg[1000]
 
-extern Pointer globalCPointer[];
-static Pointer CPointerVReg[1000];
-extern Pointer globalObjptr[];
-extern Pointer globalObjptrNonRoot[];
-static Pointer ObjptrVReg[1000];
-
+regs(CPointer);
+regs(Objptr);
 regs(Real32);
 regs(Real64);
 regs(Word8);
@@ -71,6 +67,8 @@
 regs(Word32);
 regs(Word64);
 
+extern Objptr globalObjptrNonRoot[];
+
 #undef regs
 
 //
@@ -119,13 +117,21 @@
         {                                                                       \
                 ArrayOffset arrayOffset;                                        \
                 Pointer arrayBase;                                              \
-                Word32 arrayIndex;                                              \
+                ArrayIndex arrayIndex;                                          \
                 Scale arrayScale;                                               \
                 Fetch (ArrayOffset, arrayOffset);                               \
                 Fetch (Scale, arrayScale);                                      \
                 if (disassemble) goto mainLoop;                                 \
-                arrayIndex = PopReg (Word32);                                   \
-                arrayBase = (Pointer) (PopReg (Word32));                        \
+                if (sizeof(ArrayIndex) == 4) {                                  \
+                        arrayIndex = PopReg (Word32);                           \
+                } else if (sizeof(ArrayIndex) == 8) {                           \
+                        arrayIndex = PopReg (Word64);                           \
+                } else { assert (FALSE); }                                      \
+                if (sizeof(Pointer) == 4) {                                     \
+                        arrayBase = (Pointer) (PopReg (Word32));                \
+                } else if (sizeof(Pointer) == 8) {                              \
+                        arrayBase = (Pointer) (PopReg (Word64));                \
+                } else { assert (FALSE); }                                      \
                 loadStore (mode, ty,                                            \
                                 *(ty*)(arrayBase + (arrayIndex * arrayScale) + arrayOffset)); \
                 goto mainLoop;                                                  \
@@ -135,7 +141,12 @@
         case opcodeSymOfTy2 (ty, mode##Contents):               \
                 if (disassemble) goto mainLoop;                 \
         {                                                       \
-                Pointer base = (Pointer) (PopReg (Word32));     \
+                Pointer base;                                   \
+                if (sizeof(Pointer) == 4) {                     \
+                        base = (Pointer) (PopReg (Word32));     \
+                } else if (sizeof(Pointer) == 8) {              \
+                        base = (Pointer) (PopReg (Word64));     \
+                } else { assert (FALSE); }                      \
                 loadStore (mode, ty, C (ty, base));             \
                 goto mainLoop;                                  \
         }
@@ -143,32 +154,58 @@
 #define loadStoreFrontier(mode)                                 \
         case opcodeSym (mode##Frontier):                        \
                 if (disassemble) goto mainLoop;                 \
-                loadStoreGen (mode, Pointer, Word32, Frontier); \
+                if (sizeof(Pointer) == 4) {                     \
+                        loadStoreGen (mode, Pointer, Word32, Frontier); \
+                } else if (sizeof(Pointer) == 8) {              \
+                        loadStoreGen (mode, Pointer, Word64, Frontier); \
+                } else { assert (FALSE); }                      \
                 goto mainLoop;
 
 #define loadGCState()                                   \
         case opcodeSym (loadGCState):                   \
                 if (disassemble) goto mainLoop;         \
-                StoreReg (Word32, (Word32)&gcState);    \
+                if (sizeof(Pointer) == 4) {             \
+                        StoreReg (Word32, (Word32)&gcState); \
+                } else if (sizeof(Pointer) == 8) {      \
+                        StoreReg (Word64, (Word64)&gcState); \
+                } else { assert (FALSE); }              \
                 goto mainLoop;
 
-#define loadStoreGlobal(mode, ty, ty2)                                  \
+#define loadStoreGlobal(mode, ty)                                       \
         case opcodeSymOfTy2 (ty, mode##Global):                         \
         {                                                               \
                 GlobalIndex globalIndex;                                \
                 Fetch (GlobalIndex, globalIndex);                       \
                 if (disassemble) goto mainLoop;                         \
-                loadStoreGen (mode, ty, ty2, G (ty, globalIndex));      \
+                loadStoreGen (mode, ty, ty, G (ty, globalIndex));       \
                 goto mainLoop;                                          \
         }
 
+#define loadStoreGlobalPointer(mode, ty)                                        \
+        case opcodeSymOfTy2 (ty, mode##Global):                                 \
+        {                                                                       \
+                GlobalIndex globalIndex;                                        \
+                Fetch (GlobalIndex, globalIndex);                               \
+                if (disassemble) goto mainLoop;                                 \
+                if (sizeof(Pointer) == 4) {                                     \
+                        loadStoreGen (mode, ty, Word32, G (ty, globalIndex));   \
+                } else if (sizeof(Pointer) == 8) {                              \
+                        loadStoreGen (mode, ty, Word64, G (ty, globalIndex));   \
+                } else { assert (FALSE); }                                      \
+                goto mainLoop;                                                  \
+        }
+
 #define loadStoreGPNR(mode)                                                     \
         case opcodeSym (mode##GPNR):                                            \
         {                                                                       \
                 GlobalIndex globalIndex;                                        \
                 Fetch (GlobalIndex, globalIndex);                               \
                 if (disassemble) goto mainLoop;                                 \
-                loadStoreGen (mode, Pointer, Word32, GPNR (globalIndex));       \
+                if (sizeof(Pointer) == 4) {                                     \
+                        loadStoreGen (mode, Objptr, Word32, GPNR (globalIndex)); \
+                } else if (sizeof(Pointer) == 8) {                              \
+                        loadStoreGen (mode, Objptr, Word64, GPNR (globalIndex)); \
+                } else { assert (FALSE); }                                      \
                 goto mainLoop;                                                  \
         }
 
@@ -179,21 +216,39 @@
                 Offset offset;                                          \
                 Fetch (Offset, offset);                                 \
                 if (disassemble) goto mainLoop;                         \
-                base = (Pointer) (PopReg (Word32));                     \
+                if (sizeof(Pointer) == 4) {                             \
+                        base = (Pointer) (PopReg (Word32));             \
+                } else if (sizeof(Pointer) == 8) {                      \
+                        base = (Pointer) (PopReg (Word64));             \
+                } else { assert (FALSE); }                              \
                 maybe loadStore (mode, ty, O (ty, base, offset));       \
                 goto mainLoop;                                          \
         }
 
-#define loadStoreRegister(mode, ty, ty2)                        \
+#define loadStoreRegister(mode, ty)                             \
         case opcodeSymOfTy2 (ty, mode##Register):               \
         {                                                       \
                 RegIndex regIndex;                              \
                 Fetch (RegIndex, regIndex);                     \
                 if (disassemble) goto mainLoop;                 \
-                loadStoreGen (mode, ty, ty2, R (ty, regIndex)); \
+                loadStoreGen (mode, ty, ty, R (ty, regIndex));  \
                 goto mainLoop;                                  \
         }
 
+#define loadStoreRegisterPointer(mode, ty)                                      \
+        case opcodeSymOfTy2 (ty, mode##Register):                               \
+        {                                                                       \
+                RegIndex regIndex;                                              \
+                Fetch (RegIndex, regIndex);                                     \
+                if (disassemble) goto mainLoop;                                 \
+                if (sizeof(Pointer) == 4) {                                     \
+                        loadStoreGen (mode, ty, Word32, R (ty, regIndex));      \
+                } else if (sizeof(Pointer) == 8) {                              \
+                        loadStoreGen (mode, ty, Word64, R (ty, regIndex));      \
+                } else { assert (FALSE); }                                      \
+                goto mainLoop;                                                  \
+        }
+
 #define loadStoreStackOffset(mode, ty)                          \
         case opcodeSymOfTy2 (ty, mode##StackOffset):            \
         {                                                       \
@@ -207,7 +262,11 @@
 #define loadStoreStackTop(mode)                                 \
         case opcodeSym (mode##StackTop):                        \
                 if (disassemble) goto mainLoop;                 \
-                loadStoreGen (mode, Pointer, Word32, StackTop); \
+                if (sizeof(Pointer) == 4) {                     \
+                        loadStoreGen (mode, Pointer, Word32, StackTop); \
+                } else if (sizeof(Pointer) == 8) {              \
+                        loadStoreGen (mode, Pointer, Word64, StackTop); \
+                } else { assert (FALSE); }                      \
                 goto mainLoop;
 
 #define loadWord(size)                                  \
@@ -220,10 +279,6 @@
                 goto mainLoop;                          \
         }
 
-#define opcode(ty, size, name) OPCODE_##ty##size##_##name
-
-#define coerceOp(f, t) OPCODE_##f##_to##t
-
 #define binary(ty, f)                           \
         case opcodeSym (f):                     \
                 if (disassemble) goto mainLoop; \
@@ -254,26 +309,13 @@
                 goto mainLoop;                                  \
         }
 
-#define unaryCheck(ty, f)                                       \
-        case opcodeSym (f):                                     \
-                if (disassemble) goto mainLoop;                 \
-        {                                                       \
-                ty t0 = PopReg (ty);                            \
-                f (PushReg (ty), t0, f##Overflow);              \
-                overflow = FALSE;                               \
-                goto mainLoop;                                  \
-        f##Overflow:                                            \
-                PushReg (ty) = 0; /* overflow, push 0 */        \
-                overflow = TRUE;                                \
-                goto mainLoop;                                  \
-        }
-
-#define coerce(f1, t1, f2, t2)                          \
-        case coerceOp (f2, t2):                         \
+#define coerceOp(n, f, t)  opcodeSym (f##_##n##To##t)
+#define coerce(n, f1, t1, f2, t2)                       \
+        case coerceOp (n, f2, t2):                      \
                 if (disassemble) goto mainLoop;         \
         {                                               \
                 f1 t0 = PopReg (f1);                    \
-                PushReg (t1) = f2##_to##t2 (t0);        \
+                PushReg (t1) = f2##_##n##To##t2 (t0);   \
                 goto mainLoop;                          \
         }
 
@@ -287,6 +329,94 @@
                 goto mainLoop;                  \
         }
 
+#define cpointerBinary(f)                               \
+        case opcodeSym (f):                             \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                Pointer t0;                             \
+                if (sizeof(Pointer) == 4) {             \
+                        t0 = (Pointer) PopReg (Word32); \
+                        Word32 t1 = PopReg (Word32);    \
+                        PushReg (Word32) = (Word32) f (t0, t1); \
+                } else if (sizeof(Pointer) == 8) {      \
+                        t0 = (Pointer) PopReg (Word64); \
+                        Word64 t1 = PopReg (Word64);    \
+                        PushReg (Word64) = (Word64) f (t0, t1); \
+                } else { assert (FALSE); }              \
+                goto mainLoop;                          \
+        }
+#define cpointerCompare(f)                              \
+        case opcodeSym (f):                             \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                Pointer t0, t1;                         \
+                if (sizeof(Pointer) == 4) {             \
+                        t0 = (Pointer) PopReg (Word32); \
+                        t1 = (Pointer) PopReg (Word32); \
+                } else if (sizeof(Pointer) == 8) {      \
+                        t0 = (Pointer) PopReg (Word64); \
+                        t1 = (Pointer) PopReg (Word64); \
+                } else { assert (FALSE); }              \
+                PushReg (Word32) = f (t0, t1);          \
+                goto mainLoop;                          \
+        }
+#define cpointerCoerceFrom(f)                           \
+        case opcodeSym (f):                             \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                if (sizeof(Pointer) == 4) {             \
+                        Word32 t0 = PopReg (Word32);    \
+                        PushReg (Word32) = (Word32) f (t0); \
+                } else if (sizeof(Pointer) == 8) {      \
+                        Word64 t0 = PopReg (Word64);    \
+                        PushReg (Word64) = (Word64) f (t0); \
+                } else { assert (FALSE); }              \
+                goto mainLoop;                          \
+        }
+#define cpointerCoerceTo(f)                             \
+        case opcodeSym (f):                             \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                Pointer t0;                             \
+                if (sizeof(size_t) == 4) {              \
+                        t0 = (Pointer) PopReg (Word32); \
+                        PushReg (Word32) = f (t0);      \
+                } else if (sizeof(size_t) == 8) {       \
+                        t0 = (Pointer) PopReg (Word64); \
+                        PushReg (Word64) = f (t0);      \
+                } else { assert (FALSE); }              \
+                goto mainLoop;                          \
+        }
+#define cpointerDiff(f)                                 \
+        case opcodeSym (f):                             \
+                if (disassemble) goto mainLoop;         \
+        {                                               \
+                Pointer t0, t1;                         \
+                if (sizeof(Pointer) == 4) {             \
+                        t0 = (Pointer) PopReg (Word32); \
+                        t1 = (Pointer) PopReg (Word32); \
+                        PushReg (Word32) = f (t0, t1);  \
+                } else if (sizeof(Pointer) == 8) {      \
+                        t0 = (Pointer) PopReg (Word64); \
+                        t1 = (Pointer) PopReg (Word64); \
+                        PushReg (Word64) = f (t0, t1);  \
+                } else { assert (FALSE); }              \
+                goto mainLoop;                          \
+        }
+#define cpointerLoadWord(f)                             \
+        case opcodeSym (f):                             \
+        {                                               \
+                size_t t0;                              \
+                if (sizeof(size_t) == 4) {              \
+                        Fetch (Word32, t0);             \
+                } else if (sizeof(size_t) == 8) {       \
+                        Fetch (Word64, t0);             \
+                } else { assert (FALSE); }              \
+                if (disassemble) goto mainLoop;         \
+                StoreReg (CPointer, (CPointer)t0);      \
+                goto mainLoop;                          \
+        }
+
 #define shift(ty, f)                            \
         case opcodeSym (f):                     \
                 if (disassemble) goto mainLoop; \
@@ -307,6 +437,25 @@
                 goto mainLoop;                  \
         }
 
+/* The bytecode interpreter relies on the fact that the overflow checking 
+ * primitives implemented in c-chunk.h only set the result if the operation does
+ * not overflow.  When the result overflow, the interpreter pushes a zero on
+ * the stack for the result.
+ */
+#define unaryCheck(ty, f)                                       \
+        case opcodeSym (f):                                     \
+                if (disassemble) goto mainLoop;                 \
+        {                                                       \
+                ty t0 = PopReg (ty);                            \
+                f (PushReg (ty), t0, f##Overflow);              \
+                overflow = FALSE;                               \
+                goto mainLoop;                                  \
+        f##Overflow:                                            \
+                PushReg (ty) = 0; /* overflow, push 0 */        \
+                overflow = TRUE;                                \
+                goto mainLoop;                                  \
+        }
+
 #define Goto(l)                                 \
         do {                                    \
                 maybe pc = code + l;            \
@@ -322,7 +471,11 @@
                 Word16 numCases;                                        \
                                                                         \
                 Fetch (Word16, numCases);                               \
-                lastCase = pc + (4 + size/8) * numCases;                \
+                if (sizeof(Label) == 4) {                               \
+                        lastCase = pc + (4 + size/8) * numCases;        \
+                } else if (sizeof(Label) == 8) {                        \
+                        lastCase = pc + (8 + size/8) * numCases;        \
+                } else { assert (FALSE); }                              \
                 maybe test = PopReg (Word##size);                       \
                 assertRegsEmpty ();                                     \
                 while (pc < lastCase) {                                 \
@@ -354,23 +507,25 @@
         } while (0)
 
 
-#define disp(ty)                                                \
+#define disp(ty,ty2,fmt)                                        \
         for (i = 0; i < ty##RegI; ++i)                          \
-                fprintf (stderr, "\n" #ty "Reg[%d] = 0x%08x",   \
-                                i, (unsigned int)(ty##Reg[i]));
+                fprintf (stderr, "\n" #ty "Reg[%d] = "fmt,      \
+                                i, (ty2)(ty##Reg[i]))
 
 static inline void displayRegs (void) {
         int i;
 
-        disp (Word8);
-        disp (Word16);
-        disp (Word32);
-        disp (Word64);
-        disp (Real32);
-        disp (Real64);
+        disp (CPointer,uintptr_t,FMTPTR);
+        disp (Objptr,uintptr_t,FMTPTR);
+        disp (Word8,Word8,"0x%02"PRIx8);
+        disp (Word16,Word16,"0x%04"PRIx16);
+        disp (Word32,Word32,"0x%08"PRIx32);
+        disp (Word64,Word64,"0x%016"PRIx64);
+        disp (Real32,Real32,"%f");
+        disp (Real64,Real64,"%f");
 }
 
-static void interpret (Bytecode b, Word32 codeOffset, Bool disassemble) {
+static void interpret (Bytecode b, CodeOffset codeOffset, Bool disassemble) {
         CallCIndex callCIndex;
         Pointer code;
         Pointer frontier;
@@ -399,7 +554,7 @@
         }
         Cache ();
 mainLoop:
-        if (FALSE)
+        if (DEBUG_BYTECODE)
                 displayRegs ();
         if (DEBUG or DEBUG_BYTECODE or disassemble) {
                 if (pc == pcMax)
@@ -471,16 +626,16 @@
         return;
 }
 
-static void disassemble (Bytecode b, Word32 codeOffset) {
+static void disassemble (Bytecode b, CodeOffset codeOffset) {
         interpret (b, codeOffset, TRUE);
         fprintf (stderr, "\n");
 }
 
-void MLton_Bytecode_interpret (Bytecode b, Word32 codeOffset) {
+void MLton_Bytecode_interpret (Bytecode b, CodeOffset codeOffset) {
         if (DEBUG or DEBUG_BYTECODE) {
-                fprintf (stderr, "MLton_Bytecode_interpret (0x%08x, %u)\n",
-                                (unsigned int)b,
-                                (unsigned int)codeOffset);
+                fprintf (stderr, "MLton_Bytecode_interpret ("FMTPTR", %"PRIuPTR")\n",
+                                (uintptr_t)b,
+                                codeOffset);
                 disassemble (b, codeOffset);
                 fprintf (stderr, "interpret starting\n");
         }

Modified: mlton/trunk/runtime/bytecode/interpret.h
===================================================================
--- mlton/trunk/runtime/bytecode/interpret.h	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/runtime/bytecode/interpret.h	2007-07-02 03:59:14 UTC (rev 5710)
@@ -15,6 +15,8 @@
         extern int ty##RegI;                    \
         extern ty ty##Reg[]
 
+regs(CPointer);
+regs(Objptr);
 regs(Real32);
 regs(Real64);
 regs(Word8);
@@ -26,31 +28,36 @@
 
 #define assertRegsEmpty()                       \
         do {                                    \
+                assert (0 == CPointerRegI);     \
+                assert (0 == ObjptrRegI);       \
+                assert (0 == Real32RegI);       \
+                assert (0 == Real64RegI);       \
                 assert (0 == Word8RegI);        \
                 assert (0 == Word16RegI);       \
                 assert (0 == Word32RegI);       \
                 assert (0 == Word64RegI);       \
-                assert (0 == Real32RegI);       \
-                assert (0 == Real64RegI);       \
         } while (0)
 
+typedef uintptr_t CodeOffset;
+
 struct NameOffsets {
-        Word32 codeOffset;  // An offset into code.
+        CodeOffset codeOffset;  // An offset into code.
         Word32 nameOffset;  // An offset into addressNames.
 };
 
 typedef struct Bytecode {
         char *addressNames;
         Pointer code;
-        Word32 codeSize;
+        CodeOffset codeSize;
         struct NameOffsets *nameOffsets;
         Word32 nameOffsetsSize;
 } *Bytecode;
 
+
 #define PopReg(ty) (assert (ty##RegI > 0), ty##Reg [--ty##RegI])
 #define PushReg(ty) ty##Reg [ty##RegI++]
 
 void MLton_callC (int i);  // provided by client
-void MLton_Bytecode_interpret (Bytecode b, Word32 codeOffset);
+void MLton_Bytecode_interpret (Bytecode b, CodeOffset codeOffset);
 
 #endif

Modified: mlton/trunk/runtime/bytecode/opcode.h
===================================================================
--- mlton/trunk/runtime/bytecode/opcode.h	2007-07-02 03:28:03 UTC (rev 5709)
+++ mlton/trunk/runtime/bytecode/opcode.h	2007-07-02 03:59:14 UTC (rev 5710)
@@ -8,42 +8,43 @@
 #ifndef _OPCODE_H_
 #define _OPCODE_H_
 
-#define coercePrims()                                   \
-        coerce (Real32, Real64, Real32, Real64)         \
-        coerce (Real32, Word32, Real32, WordS32)        \
-        coerce (Real64, Real32, Real64, Real32)         \
-        coerce (Real64, Word32, Real64, WordS32)        \
-        coerce (Word16, Real32, WordS16, Real32)        \
-        coerce (Word16, Real64, WordS16, Real64)        \
-        coerce (Word16, Word32, WordS16, Word32)        \
-        coerce (Word16, Word64, WordS16, Word64)        \
-        coerce (Word32, Real32, WordS32, Real32)        \
-        coerce (Word32, Real64, WordS32, Real64)        \
-        coerce (Word32, Word64, WordS32, Word64)        \
-        coerce (Word8, Real32, WordS8, Real32)          \
-        coerce (Word8, Real64, WordS8, Real64)          \
-        coerce (Word8, Word16, WordS8, Word16)          \
-        coerce (Word8, Word32, WordS8, Word32)          \
-        coerce (Word8, Word64, WordS8, Word64)          \
-        coerce (Word16, Word32, WordU16, Word32)        \
-        coerce (Word16, Word64, WordU16, Word64)        \
-        coerce (Word16, Word8, WordU16, Word8)          \
-        coerce (Word32, Word16, WordU32, Word16)        \
-        coerce (Word32, Word64, WordU32, Word64)        \
-        coerce (Word32, Word8, WordU32, Word8)          \
-        coerce (Word64, Word16, WordU64, Word16)        \
-        coerce (Word64, Word32, WordU64, Word32)        \
-        coerce (Word64, Word8, WordU64, Word8)          \
-        coerce (Word8, Word16, WordU8, Word16)          \
-        coerce (Word8, Word32, WordU8, Word32)          \
-        coerce (Word8, Word64, WordU8, Word64)
+#define coercePrims()                           \
+        allWordCoercePrims(8)                   \
+        allWordCoercePrims(16)                  \
+        allWordCoercePrims(32)                  \
+        allWordCoercePrims(64)                  \
+        coerce(rnd, Real32, Real32, Real32, Real32)     \
+        coerce(rnd, Real32, Real64, Real32, Real64)     \
+        coerce(rnd, Real64, Real32, Real64, Real32)     \
+        coerce(rnd, Real64, Real64, Real64, Real64)     \
+        coerce(cast, Real32, Word32, Real32, Word32)    \
+        coerce(cast, Word32, Real32, Word32, Real32)    \
+        coerce(cast, Real64, Word64, Real64, Word64)    \
+        coerce(cast, Word64, Real64, Word64, Real64)
 
+#define allWordCoercePrims(size)                        \
+        bothFromWordCoercePrims(rnd, size, Real32)      \
+        bothFromWordCoercePrims(rnd, size, Real64)      \
+        bothToWordCoercePrims(rnd, Real32, size)        \
+        bothToWordCoercePrims(rnd, Real64, size)        \
+        bothFromWordCoercePrims(extd, size, Word8)      \
+        bothFromWordCoercePrims(extd, size, Word16)     \
+        bothFromWordCoercePrims(extd, size, Word32)     \
+        bothFromWordCoercePrims(extd, size, Word64)
+
+#define bothFromWordCoercePrims(name, from, to)                 \
+        coerce (name, Word##from, to, Word##S##from, to)        \
+        coerce (name, Word##from, to, Word##U##from, to)
+#define bothToWordCoercePrims(name, from, to)                   \
+        coerce (name, from, Word##to, from, Word##S##to)        \
+        coerce (name, from, Word##to, from, Word##U##to)
+
 #define loadStorePrimsOfTy(mode, ty)            \
         loadStoreArrayOffset (mode, ty)         \
         loadStoreContents (mode, ty)            \
-        loadStoreGlobal (mode, ty, ty)          \
+        loadStoreGlobal (mode, ty)              \
         loadStoreOffset (mode, ty)              \
-        loadStoreRegister (mode, ty, ty)        \
+        loadStoreRegister (mode, ty)            \
         loadStoreStackOffset (mode, ty)
 
 #define loadStorePrims(mode)                            \
@@ -53,10 +54,10 @@
         loadStorePrimsOfTy (mode, Word16)               \
         loadStorePrimsOfTy (mode, Word32)               \
         loadStorePrimsOfTy (mode, Word64)               \
-        loadStoreGlobal (mode, CPointer, Word32)        \
-        loadStoreRegister (mode, CPointer, Word32)      \
-        loadStoreGlobal (mode, Objptr, Word32)          \
-        loadStoreRegister (mode, Objptr, Word32)        \
+        loadStoreGlobalPointer (mode, CPointer)         \
+        loadStoreGlobalPointer (mode, Objptr)           \
+        loadStoreRegisterPointer (mode, CPointer)       \
+        loadStoreRegisterPointer (mode, Objptr)         \
         loadStoreFrontier (mode)                        \
         loadStoreStackTop (mode)
 
@@ -69,9 +70,20 @@
         binary (Real##size, Real##size##_mul)           \
         unary (Real##size, Real##size##_neg)            \
         unary (Real##size, Real##size##_round)          \
-        binary (Real##size, Real##size##_sub)
+        binary (Real##size, Real##size##_sub)           \
+        unary (Real##size, Real##size##_Math_acos)      \
+        unary (Real##size, Real##size##_Math_asin)      \
+        unary (Real##size, Real##size##_Math_atan)      \
+        binary (Real##size, Real##size##_Math_atan2)    \
+        unary (Real##size, Real##size##_Math_cos)       \
+        unary (Real##size, Real##size##_Math_exp)       \
+        unary (Real##size, Real##size##_Math_ln)        \
+        unary (Real##size, Real##size##_Math_log10)     \
+        unary (Real##size, Real##size##_Math_sin)       \
+        unary (Real##size, Real##size##_Math_sqrt)      \
+        unary (Real##size, Real##size##_Math_tan)
 
-#define wordPrimsOfSizeNoMul(size)                      \
+#define wordPrimsOfSize(size)                           \
         binary (Word##size, Word##size##_add)           \
         binary (Word##size, Word##size##_andb)          \
         compare (Word##size, Word##size##_equal)        \
@@ -95,17 +107,25 @@
         binary (Word##size, Word##size##_xorb)          \
         binaryCheck (Word##size, WordS##size##_addCheck)        \
         binaryCheck (Word##size, WordU##size##_addCheck)        \
+        binaryCheck (Word##size, WordS##size##_mulCheck)        \
+        binaryCheck (Word##size, WordU##size##_mulCheck)        \
         unaryCheck (Word##size, Word##size##_negCheck)          \
         binaryCheck (Word##size, WordS##size##_subCheck)        \
         loadWord (size)
 
-#define wordPrimsOfSize(size)                                   \
-        wordPrimsOfSizeNoMul(size)                              \
-        binaryCheck (Word##size, WordS##size##_mulCheck)        \
-        binaryCheck (Word##size, WordU##size##_mulCheck)        \
+#define cpointerPrims()                                 \
+        cpointerBinary (CPointer_add)                   \
+        cpointerBinary (CPointer_sub)                   \
+        cpointerCompare(CPointer_equal)                 \
+        cpointerCompare(CPointer_lt)                    \
+        cpointerCoerceFrom (CPointer_fromWord)          \
+        cpointerCoerceTo (CPointer_toWord)              \
+        cpointerDiff (CPointer_diff)                    \
+        cpointerLoadWord (CPointer_loadWord)
 
 #define prims()                                         \
         coercePrims ()                                  \
+        cpointerPrims ()                                \
         loadGCState ()                                  \
         loadStorePrims (load)                           \
         loadStorePrims (store)                          \
@@ -114,7 +134,7 @@
         wordPrimsOfSize (8)                             \
         wordPrimsOfSize (16)                            \
         wordPrimsOfSize (32)                            \
-        wordPrimsOfSizeNoMul (64)
+        wordPrimsOfSize (64)
 
 #define opcodes()                               \
         prims()                                 \
@@ -141,14 +161,24 @@
 
 #define binary(ty, f)  opcodeGen (f)
 #define binaryCheck(ty, f)  opcodeGen (f)
+#define coerceOp(n, f, t)  opcodeGen (f##_##n##To##t)
+#define coerce(n, f1, t1, f2, t2)  coerceOp (n, f2, t2)
 #define compare(ty, f)  opcodeGen (f)
+#define cpointerBinary(f)  opcodeGen (f)
+#define cpointerCompare(f)  opcodeGen (f)
+#define cpointerCoerceFrom(f)  opcodeGen (f)
+#define cpointerCoerceTo(f)  opcodeGen (f)
+#define cpointerDiff(f)  opcodeGen (f)
+#define cpointerLoadWord(f)  opcodeGen (f)
 #define loadStoreArrayOffset(mode, ty)  opcodeName2 (ty, mode##ArrayOffset)
 #define loadStoreContents(mode, ty)  opcodeName2 (ty, mode##Contents)
 #define loadStoreFrontier(mode) opcodeGen (mode##Frontier)
 #define loadGCState() opcodeGen (loadGCState)
-#define loadStoreGlobal(mode, ty, ty2)  opcodeName2 (ty, mode##Global)
+#define loadStoreGlobal(mode, ty)  opcodeName2 (ty, mode##Global)
+#define loadStoreGlobalPointer(mode, ty)  opcodeName2 (ty, mode##Global)
 #define loadStoreOffset(mode, ty)  opcodeName2 (ty, mode##Offset)
-#define loadStoreRegister(mode, ty, ty2)  opcodeName2 (ty, mode##Register)
+#define loadStoreRegister(mode, ty)  opcodeName2 (ty, mode##Register)
+#define loadStoreRegisterPointer(mode, ty)  opcodeName2 (ty, mode##Register)
 #define loadStoreStackOffset(mode, ty)  opcodeName2 (ty, mode##StackOffset)
 #define loadStoreStackTop(mode)  opcodeGen (mode##StackTop)
 #define loadWord(size)  opcodeName (Word, size, loadWord)
@@ -156,10 +186,6 @@
 #define unary(ty, f)  opcodeGen (f)
 #define unaryCheck(ty, f)  opcodeGen (f)
 
-#define coerceOp(f, t)  opcodeGen (f##_to##t)
-
-#define coerce(f1, t1, f2, t2)  coerceOp (f2, t2)
-
 // Define the opcode strings.
 
 #define opcodeGen(z)  #z,
@@ -178,20 +204,28 @@
         opcodes ()
 };
 
-typedef Word8 Opcode;
+typedef Word16 Opcode;
 
+#undef binary
+#undef binaryCheck
 #undef coerce
 #undef coerceOp
-#undef binary
-#undef binaryCheck
 #undef compare
+#undef cpointerBinary
+#undef cpointerCompare
+#undef cpointerCoerceFrom
+#undef cpointerCoerceTo
+#undef cpointerDiff
+#undef cpointerLoadWord
 #undef loadGCState
 #undef loadStoreArrayOffset
 #undef loadStoreContents
 #undef loadStoreFrontier
 #undef loadStoreGlobal
+#undef loadStoreGlobalPointer
 #undef loadStoreOffset
 #undef loadStoreRegister
+#undef loadStoreRegisterPointer
 #undef loadStoreStackOffset
 #undef loadStoreStackTop
 #undef loadWord




More information about the MLton-commit mailing list