[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