[MLton-commit] r4438
Matthew Fluet
MLton@mlton.org
Tue, 2 May 2006 19:58:46 -0700
Fix bootstrap
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
U mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
U mlton/branches/on-20050822-x86_64-branch/include/c-main.h
U mlton/branches/on-20050822-x86_64-branch/include/x86-main.h
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/ffi.fun
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
U mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2006-05-03 02:58:44 UTC (rev 4438)
@@ -6,6 +6,7 @@
*/
#define MLTON_GC_INTERNAL_TYPES
+#define MLTON_BASIS_FFI_STATIC
#include "platform.h"
#include "interpret.h"
@@ -62,7 +63,7 @@
#define quotRem1(qr, size) \
Word##size WordS##size##_##qr (Word##size w1, Word##size w2);
-#define quotRem2(qr) \
+#define quotRem2(qr) \
quotRem1 (qr, 8) \
quotRem1 (qr, 16) \
quotRem1 (qr, 32) \
Modified: mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/include/c-chunk.h 2006-05-03 02:58:44 UTC (rev 4438)
@@ -28,12 +28,12 @@
#endif
extern struct cont (*nextChunks []) ();
-extern Int nextFun;
-extern Int returnToC;
+extern int nextFun;
+extern int returnToC;
extern struct GC_state gcState;
#define GCState ((Pointer)&gcState)
-#define ExnStack *(Word*)(GCState + ExnStackOffset)
+#define ExnStack *(Word32*)(GCState + ExnStackOffset)
#define FrontierMem *(Pointer*)(GCState + FrontierOffset)
#define Frontier frontier
#define StackBottom *(Pointer*)(GCState + StackBottomOffset)
@@ -174,7 +174,7 @@
#define Return() \
do { \
- l_nextFun = *(Word*)(StackTop - sizeof(Word)); \
+ l_nextFun = *(Word32*)(StackTop - sizeof(Word32)); \
if (DEBUG_CCODEGEN) \
fprintf (stderr, "%s:%d: Return() l_nextFun = %d\n", \
__FILE__, __LINE__, l_nextFun); \
@@ -277,12 +277,12 @@
#define Real64_neg(x) (-(x))
typedef volatile union {
- Word tab[2];
+ Word32 tab[2];
Real64 d;
-} Real64Or2Words;
+} Real64Or2Word32s;
static inline Real64 Real64_fetch (Real64 *dp) {
- Real64Or2Words u;
+ Real64Or2Word32s u;
Word32 *p;
p = (Word32*)dp;
@@ -304,7 +304,7 @@
}
static inline void Real64_store (Real64 *dp, Real64 d) {
- Real64Or2Words u;
+ Real64Or2Word32s u;
Word32 *p;
p = (Word32*)dp;
@@ -335,7 +335,7 @@
}
#define wordShift(size, name, op) \
static inline Word##size Word##size##_##name \
- (Word##size w1, Word w2) { \
+ (Word##size w1, Word32 w2) { \
return w1 op w2; \
}
#define wordUnary(size, name, op) \
@@ -362,13 +362,13 @@
/* WordS_rshift isn't ANSI C, because ANSI doesn't guarantee sign \
* extension. We use it anyway cause it always seems to work. \
*/ \
- static inline Word##size WordS##size##_rshift (WordS##size w, Word s) { \
+ static inline Word##size WordS##size##_rshift (WordS##size w, Word32 s) { \
return w >> s; \
} \
- static inline Word##size Word##size##_rol (Word##size w1, Word w2) { \
+ static inline Word##size Word##size##_rol (Word##size w1, Word32 w2) { \
return (w1 >> (size - w2)) | (w1 << w2); \
} \
- static inline Word##size Word##size##_ror (Word##size w1, Word w2) { \
+ static inline Word##size Word##size##_ror (Word##size w1, Word32 w2) { \
return (w1 >> w2) | (w1 << (size - w2)); \
}
wordOps(8)
Modified: mlton/branches/on-20050822-x86_64-branch/include/c-main.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/c-main.h 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/include/c-main.h 2006-05-03 02:58:44 UTC (rev 4438)
@@ -31,7 +31,7 @@
s->atomicState += 3; \
/* Switch to the C Handler thread. */ \
GC_switchToThread (s, s->callFromCHandlerThread, 0); \
- nextFun = *(int*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
+ nextFun = *(Word32*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
cont.nextChunk = nextChunks[nextFun]; \
returnToC = FALSE; \
do { \
@@ -50,7 +50,7 @@
PrepFarJump(mc, ml); \
} else { \
/* Return to the saved world */ \
- nextFun = *(int*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ nextFun = *(Word32*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
cont.nextChunk = nextChunks[nextFun]; \
} \
/* Trampoline */ \
Modified: mlton/branches/on-20050822-x86_64-branch/include/x86-main.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/include/x86-main.h 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/include/x86-main.h 2006-05-03 02:58:44 UTC (rev 4438)
@@ -15,7 +15,7 @@
Word32 applyFFTemp2;
Word32 checkTemp;
Word32 cReturnTemp[16];
-Word32 c_stackP;
+Pointer c_stackP;
Word32 divTemp;
Word32 eq1Temp;
Word32 eq2Temp;
@@ -63,7 +63,7 @@
#define Main(al, mg, mfs, mmc, pk, ps, ml, reserveEsp) \
void MLton_jumpToSML (pointer jump) { \
- Word lc_stackP; \
+ Pointer lc_stackP; \
\
if (DEBUG_X86CODEGEN) \
fprintf (stderr, "MLton_jumpToSML(0x%08x) starting\n", (uint)jump); \
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/ffi.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/ffi.fun 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/ffi.fun 2006-05-03 02:58:44 UTC (rev 4438)
@@ -79,7 +79,7 @@
end
else ()
end)
- val _ = print "Int MLton_FFI_op;\n"
+ val _ = print "Int32 MLton_FFI_op;\n"
in
List.foreach
(!symbols, fn {name, ty} =>
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/basis-ffi.def 2006-05-03 02:58:44 UTC (rev 4438)
@@ -772,64 +772,64 @@
Posix.TTY.V.VSTOP = _const : C_Int.t
Posix.TTY.V.VSUSP = _const : C_Int.t
Posix.TTY.V.VTIME = _const : C_Int.t
-Real32.Math.acos = _import : Real32.t -> Real32.t
-Real32.Math.asin = _import : Real32.t -> Real32.t
-Real32.Math.atan = _import : Real32.t -> Real32.t
-Real32.Math.atan2 = _import : Real32.t * Real32.t -> Real32.t
-Real32.Math.cos = _import : Real32.t -> Real32.t
+Real32.Math.acos = _import static : Real32.t -> Real32.t
+Real32.Math.asin = _import static : Real32.t -> Real32.t
+Real32.Math.atan = _import static : Real32.t -> Real32.t
+Real32.Math.atan2 = _import static : Real32.t * Real32.t -> Real32.t
+Real32.Math.cos = _import static : Real32.t -> Real32.t
Real32.Math.cosh = _import : Real32.t -> Real32.t
Real32.Math.e = _symbol : Real32.t
-Real32.Math.exp = _import : Real32.t -> Real32.t
-Real32.Math.ln = _import : Real32.t -> Real32.t
-Real32.Math.log10 = _import : Real32.t -> Real32.t
+Real32.Math.exp = _import static : Real32.t -> Real32.t
+Real32.Math.ln = _import static : Real32.t -> Real32.t
+Real32.Math.log10 = _import static : Real32.t -> Real32.t
Real32.Math.pi = _symbol : Real32.t
Real32.Math.pow = _import : Real32.t * Real32.t -> Real32.t
-Real32.Math.sin = _import : Real32.t -> Real32.t
+Real32.Math.sin = _import static : Real32.t -> Real32.t
Real32.Math.sinh = _import : Real32.t -> Real32.t
-Real32.Math.sqrt = _import : Real32.t -> Real32.t
-Real32.Math.tan = _import : Real32.t -> Real32.t
+Real32.Math.sqrt = _import static : Real32.t -> Real32.t
+Real32.Math.tan = _import static : Real32.t -> Real32.t
Real32.Math.tanh = _import : Real32.t -> Real32.t
Real32.abs = _import : Real32.t -> Real32.t
Real32.class = _import : Real32.t -> C_Int.t
Real32.frexp = _import : Real32.t * C_Int.t ref -> Real32.t
Real32.gdtoa = _import : Real32.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
-Real32.ldexp = _import : Real32.t * C_Int.t -> Real32.t
+Real32.ldexp = _import static : Real32.t * C_Int.t -> Real32.t
Real32.maxFinite = _symbol : Real32.t
Real32.minNormalPos = _symbol : Real32.t
Real32.minPos = _symbol : Real32.t
Real32.modf = _import : Real32.t * Real32.t ref -> Real32.t
Real32.nextAfter = _import : Real32.t * Real32.t -> Real32.t
-Real32.round = _import : Real32.t -> Real32.t
+Real32.round = _import static : Real32.t -> Real32.t
Real32.signBit = _import : Real32.t -> C_Int.t
Real32.strto = _import : NullString8.t -> Real32.t
-Real64.Math.acos = _import : Real64.t -> Real64.t
-Real64.Math.asin = _import : Real64.t -> Real64.t
-Real64.Math.atan = _import : Real64.t -> Real64.t
-Real64.Math.atan2 = _import : Real64.t * Real64.t -> Real64.t
-Real64.Math.cos = _import : Real64.t -> Real64.t
+Real64.Math.acos = _import static : Real64.t -> Real64.t
+Real64.Math.asin = _import static : Real64.t -> Real64.t
+Real64.Math.atan = _import static : Real64.t -> Real64.t
+Real64.Math.atan2 = _import static : Real64.t * Real64.t -> Real64.t
+Real64.Math.cos = _import static : Real64.t -> Real64.t
Real64.Math.cosh = _import : Real64.t -> Real64.t
Real64.Math.e = _symbol : Real64.t
-Real64.Math.exp = _import : Real64.t -> Real64.t
-Real64.Math.ln = _import : Real64.t -> Real64.t
-Real64.Math.log10 = _import : Real64.t -> Real64.t
+Real64.Math.exp = _import static : Real64.t -> Real64.t
+Real64.Math.ln = _import static : Real64.t -> Real64.t
+Real64.Math.log10 = _import static : Real64.t -> Real64.t
Real64.Math.pi = _symbol : Real64.t
Real64.Math.pow = _import : Real64.t * Real64.t -> Real64.t
-Real64.Math.sin = _import : Real64.t -> Real64.t
+Real64.Math.sin = _import static : Real64.t -> Real64.t
Real64.Math.sinh = _import : Real64.t -> Real64.t
-Real64.Math.sqrt = _import : Real64.t -> Real64.t
-Real64.Math.tan = _import : Real64.t -> Real64.t
+Real64.Math.sqrt = _import static : Real64.t -> Real64.t
+Real64.Math.tan = _import static : Real64.t -> Real64.t
Real64.Math.tanh = _import : Real64.t -> Real64.t
Real64.abs = _import : Real64.t -> Real64.t
Real64.class = _import : Real64.t -> C_Int.t
Real64.frexp = _import : Real64.t * C_Int.t ref -> Real64.t
Real64.gdtoa = _import : Real64.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t
-Real64.ldexp = _import : Real64.t * C_Int.t -> Real64.t
+Real64.ldexp = _import static : Real64.t * C_Int.t -> Real64.t
Real64.maxFinite = _symbol : Real64.t
Real64.minNormalPos = _symbol : Real64.t
Real64.minPos = _symbol : Real64.t
Real64.modf = _import : Real64.t * Real64.t ref -> Real64.t
Real64.nextAfter = _import : Real64.t * Real64.t -> Real64.t
-Real64.round = _import : Real64.t -> Real64.t
+Real64.round = _import static : Real64.t -> Real64.t
Real64.signBit = _import : Real64.t -> C_Int.t
Real64.strto = _import : NullString8.t -> Real64.t
Socket.AF.INET = _const : C_Int.t
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-05-02 02:52:39 UTC (rev 4437)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gen/gen-basis-ffi.sml 2006-05-03 02:58:44 UTC (rev 4438)
@@ -161,7 +161,8 @@
datatype t =
Const of {name: Name.t,
ty: Type.t}
- | Import of {name: Name.t,
+ | Import of {maybeStatic: bool,
+ name: Name.t,
ty: {args: Type.t list,
ret: Type.t}}
| Symbol of {name: Name.t,
@@ -185,14 +186,26 @@
" ",
Name.toC name,
";"]
- | Import {name, ty = {args, ret}} =>
- String.concat
- [Type.toC ret,
- " ",
- Name.toC name,
- "(",
- String.concatWith "," (List.map Type.toC args),
- ");"]
+ | Import {maybeStatic, name, ty = {args, ret}} =>
+ let
+ val s =
+ String.concat
+ [Type.toC ret,
+ " ",
+ Name.toC name,
+ "(",
+ String.concatWith "," (List.map Type.toC args),
+ ");"]
+ in
+ if maybeStatic
+ then String.concat
+ ["#if (defined (MLTON_BASIS_FFI_STATIC))\n",
+ "static ", s, "\n",
+ "#else\n",
+ s, "\n",
+ "#endif"]
+ else s
+ end
| Symbol {name, ty} =>
String.concat
["extern ",
@@ -211,7 +224,7 @@
"\" : ",
Type.toML ty,
";"]
- | Import {name, ty = {args, ret}} =>
+ | Import {maybeStatic, name, ty = {args, ret}} =>
String.concat
["val ",
Name.last name,
@@ -256,6 +269,10 @@
let
val s = #2 (Substring.splitAt (s, 7))
val s = Substring.droplSpace s
+ val (maybeStatic, s) =
+ if Substring.isPrefix "static" s
+ then (true, Substring.droplSpace (#2 (Substring.splitAt (s, 6))))
+ else (false, s)
val s = if Substring.isPrefix ":" s
then #2 (Substring.splitAt (s, 1))
else raise Fail (concat ["Entry.parseImport: \"", Substring.string s, "\""])
@@ -264,7 +281,8 @@
then ()
else raise Fail (concat ["Entry.parseImport: \"", Substring.string s, "\""])
in
- Import {name = name,
+ Import {maybeStatic = maybeStatic,
+ name = name,
ty = {args = args, ret = ret}}
end