[MLton-commit] r6675
Wesley Terpstra
wesley at mlton.org
Sun Jul 27 12:04:43 PDT 2008
This commit handles Thread_returnToC differently from my proposed patch to
the mailing list. Previously, both c-codegen and bytecode failed to push
the return address to the stack and fail to flush the frontier and stack.
The old patch worked around this by creating a thread that we would never
re-use before invoking returnToC and forcing a flush. The new patch instead
fixes both codegens to leave the stack in a good state.
This patch adds support for shared and static libraries to MLton. So far,
the shared libraries probably only work on *nix. I have yet to make DLLs or
dylibs for windows and mac osx respectively. However, the patch has already
grown large enough and seems stable enough that I think this is a good
check-point for committing it. I have tested all the codegens with all three
compile modes (executable, archive, library) and they all work except
amd64+shared. The problem here is that the output amd64 assembly code is not
PIC. The amd64 codegen needs to be changed to use relocatable symbols, which
shouldn't be too hard. In any case, both C and bytecode work on amd64. The
x86 codegen also is not PIC, but x86 shared libraries work even when not
relocatable. Nevertheless, when the amd64 codegen is updated, the x86 should
be as well.
Here is a summary of the changes:
* Add a new header export.h to control symbol visibility
* Correctly tag all symbols in the codegen (and related headers)
* Compile the runtime and gdtoa with hidden (internal) visibility only
* Add an option to control output format (executable,library,archive)
* Add an option to configure the path to 'ar'
* Expose the current format in MLton.Platform.Format
* Add two functions LIBNAME_open and LIBNAME_close to every codegen
* Fix a bug where returnToC could leave inconsistent stack/heap, causing a segfault on the first GC after the main thread returns. (This only affected the C and bytecode codegens)
* Add a PIC version of mlton and gdtoa for relocatable libraries
* Add appropriate link flags based on output format
* Don't output a main function in library code
* Set the suffix of library to returnToC (involves saving the current thread, creating a thread to perform the return, then restoring the saved thread from the runtime)
What remains to be done:
* Make the amd64/x86 codegens output PIC code when format = Library
* Test whether 'gcc -shared' suffices for a .dll, If it does, modify the '.so' prefix for the MinGW/cygwin targets.
* Test whether 'gcc -shared' suffices for a .dylib. If it does, modify the '.so' prefix for osx targets.
----------------------------------------------------------------------
U mlton/trunk/basis-library/mlton/mlton.sml
U mlton/trunk/basis-library/mlton/platform.sig
U mlton/trunk/basis-library/mlton/platform.sml
U mlton/trunk/basis-library/primitive/prim-mlton.sml
U mlton/trunk/bin/mlton-script
U mlton/trunk/doc/changelog
U mlton/trunk/include/amd64-main.h
U mlton/trunk/include/bytecode-main.h
U mlton/trunk/include/bytecode.h
U mlton/trunk/include/c-common.h
U mlton/trunk/include/c-main.h
U mlton/trunk/include/common-main.h
U mlton/trunk/include/x86-main.h
U mlton/trunk/mlton/atoms/ffi.fun
U mlton/trunk/mlton/codegen/amd64-codegen/amd64-codegen.fun
U mlton/trunk/mlton/codegen/amd64-codegen/amd64.fun
U mlton/trunk/mlton/codegen/bytecode/bytecode.fun
U mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun
U mlton/trunk/mlton/codegen/x86-codegen/x86.fun
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/compile.fun
U mlton/trunk/mlton/main/lookup-constant.fun
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/Makefile
U mlton/trunk/runtime/bytecode/interpret.c
A mlton/trunk/runtime/export.h
U mlton/trunk/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/mlton/mlton.sml
===================================================================
--- mlton/trunk/basis-library/mlton/mlton.sml 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/basis-library/mlton/mlton.sml 2008-07-27 19:04:30 UTC (rev 6675)
@@ -149,8 +149,27 @@
end
val _ =
+ let
+ open MLtonPlatform.Format
+
+ fun librarySuffix () =
+ let
+ val () = Primitive.MLton.Thread.returnToC ()
+ val () = Cleaner.clean Cleaner.atExit
+ val () = Primitive.MLton.Thread.returnToC ()
+ in
+ ()
+ end
+
+ val suffix =
+ case host of
+ Archive => librarySuffix
+ | Executable => Exit.defaultTopLevelSuffix
+ | Library => librarySuffix
+ in
(Primitive.TopLevel.setHandler MLtonExn.defaultTopLevelHandler
- ; Primitive.TopLevel.setSuffix Exit.defaultTopLevelSuffix)
+ ; Primitive.TopLevel.setSuffix suffix)
+ end
end
(* Patch OS.FileSys.tmpName to use mkstemp. *)
Modified: mlton/trunk/basis-library/mlton/platform.sig
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sig 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/basis-library/mlton/platform.sig 2008-07-27 19:04:30 UTC (rev 6675)
@@ -17,6 +17,15 @@
val toString: t -> string
end
+ structure Format:
+ sig
+ datatype t = Archive | Executable | Library
+
+ val fromString: string -> t option
+ val host: t
+ val toString: t -> string
+ end
+
structure OS:
sig
datatype t = AIX | Cygwin | Darwin | FreeBSD | HPUX
Modified: mlton/trunk/basis-library/mlton/platform.sml
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sml 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/basis-library/mlton/platform.sml 2008-07-27 19:04:30 UTC (rev 6675)
@@ -39,6 +39,25 @@
fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
end
+ structure Format =
+ struct
+ open Format
+
+ val all = [
+ (Archive, "Archive"),
+ (Executable, "Executable"),
+ (Library, "Library")]
+
+ fun fromString s =
+ let
+ val s = String.toLower s
+ in
+ omap (peek (all, fn (_, s') => s = String.toLower s'), #1)
+ end
+
+ fun toString a = #2 (valOf (peek (all, fn (a', _) => a = a')))
+ end
+
structure OS =
struct
open OS
Modified: mlton/trunk/basis-library/primitive/prim-mlton.sml
===================================================================
--- mlton/trunk/basis-library/primitive/prim-mlton.sml 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/basis-library/primitive/prim-mlton.sml 2008-07-27 19:04:30 UTC (rev 6675)
@@ -183,6 +183,21 @@
val hostIsBigEndian = _const "MLton_Platform_Arch_bigendian": bool;
end
+ structure Format =
+ struct
+ datatype t =
+ Archive
+ | Executable
+ | Library
+
+ val host: t =
+ case _build_const "MLton_Platform_Format": String8.string; of
+ "archive" => Archive
+ | "executable" => Executable
+ | "library" => Library
+ | _ => raise Primitive.Exn.Fail8 "strange MLton_Platform_Format"
+ end
+
structure OS =
struct
datatype t =
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/bin/mlton-script 2008-07-27 19:04:30 UTC (rev 6675)
@@ -85,7 +85,7 @@
-cc-opt-quote "-I$lib/include" \
-cc-opt '-O1' \
-cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w' \
- -link-opt '-lgdtoa -lm -lgmp' \
+ -link-opt '-lm -lgmp' \
-mlb-path-map "$lib/mlb-path-map" \
-target-as-opt amd64 '-m64' \
-target-cc-opt amd64 '-m64' \
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/doc/changelog 2008-07-27 19:04:30 UTC (rev 6675)
@@ -1,5 +1,15 @@
Here are the changes from version 20070826 to version YYYYMMDD.
+* 2008-07-24
+ - Added support for compiling to a C library. The relevant new compiler
+ options are '-ar' and '-format'. Libraries are named based on the
+ name of the -export-header file. Libraries have two extra methods:
+ * NAME_open(argc, argv) initializes the library and runs the SML code
+ until it reaches the end of the program. If the SML code exits or
+ raises an uncaught exception, the entire program will terminate.
+ * NAME_close() will execute any registered atExit functions, any
+ outstanding finalizers, and frees the ML heap.
+
* 2008-07-16
- Fixed bug in the name mangling of _import-ed functions with the
stdcall convention.
Modified: mlton/trunk/include/amd64-main.h
===================================================================
--- mlton/trunk/include/amd64-main.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/amd64-main.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -11,21 +11,21 @@
#include "common-main.h"
/* Globals */
-Word64 applyFFTempFun;
-Word64 applyFFTempStackArg;
-Word64 applyFFTempRegArg[6];
-Real32 applyFFTempXmmsRegArgD[8];
-Real64 applyFFTempXmmsRegArgS[8];
-Word32 checkTemp;
-Word64 cReturnTemp[16];
-Pointer c_stackP;
-Word64 fpcvtTemp;
-Word32 fpeqTemp;
-Word64 divTemp;
-Word64 indexTemp;
-Word64 raTemp1;
-Word64 spill[32];
-Word64 stackTopTemp;
+INTERNAL Word64 applyFFTempFun;
+INTERNAL Word64 applyFFTempStackArg;
+INTERNAL Word64 applyFFTempRegArg[6];
+INTERNAL Real32 applyFFTempXmmsRegArgD[8];
+INTERNAL Real64 applyFFTempXmmsRegArgS[8];
+INTERNAL Word32 checkTemp;
+INTERNAL Word64 cReturnTemp[16];
+INTERNAL Pointer c_stackP;
+INTERNAL Word64 fpcvtTemp;
+INTERNAL Word32 fpeqTemp;
+INTERNAL Word64 divTemp;
+INTERNAL Word64 indexTemp;
+INTERNAL Word64 raTemp1;
+INTERNAL Word64 spill[32];
+INTERNAL Word64 stackTopTemp;
#ifndef DEBUG_AMD64CODEGEN
#define DEBUG_AMD64CODEGEN FALSE
@@ -35,9 +35,9 @@
return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex)));
}
-#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+#define MLtonCallFromC \
void MLton_jumpToSML (pointer jump); \
-void MLton_callFromC () { \
+static void MLton_callFromC () { \
pointer jump; \
GC_state s; \
\
@@ -60,8 +60,11 @@
if (DEBUG_AMD64CODEGEN) \
fprintf (stderr, "MLton_callFromC() done\n"); \
return; \
-} \
-int MLton_main (int argc, char* argv[]) { \
+}
+
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED int MLton_main (int argc, char* argv[]) { \
pointer jump; \
extern pointer ml; \
\
@@ -76,4 +79,26 @@
return 1; \
}
+#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
+ pointer jump; \
+ extern pointer ml; \
+ \
+ Initialize (al, mg, mfs, mmc, pk, ps); \
+ if (gcState.amOriginal) { \
+ real_Init(); \
+ jump = (pointer)&ml; \
+ } else { \
+ jump = *(pointer*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ } \
+ MLton_jumpToSML(jump); \
+} \
+EXPORTED void LIB_CLOSE(LIBNAME) () { \
+ pointer jump; \
+ jump = *(pointer*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ MLton_jumpToSML(jump); \
+ GC_done(&gcState); \
+}
+
#endif /* #ifndef _AMD64_MAIN_H_ */
Modified: mlton/trunk/include/bytecode-main.h
===================================================================
--- mlton/trunk/include/bytecode-main.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/bytecode-main.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -15,14 +15,14 @@
#define DEBUG_CODEGEN FALSE
#endif
-struct Bytecode MLton_bytecode;
+INTERNAL struct Bytecode MLton_bytecode;
static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
return *((GC_frameIndex*)(MLton_bytecode.code + ra - sizeof(GC_frameIndex)));
}
-#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
-void MLton_callFromC () { \
+#define MLtonCallFromC \
+static void MLton_callFromC () { \
uintptr_t nextFun; \
GC_state s; \
\
@@ -46,7 +46,10 @@
if (DEBUG_CODEGEN) \
fprintf (stderr, "MLton_callFromC done\n"); \
} \
-int MLton_main (int argc, char* argv[]) { \
+
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED int MLton_main (int argc, char* argv[]) { \
uintptr_t nextFun; \
Initialize (al, mg, mfs, mmc, pk, ps); \
if (gcState.amOriginal) { \
@@ -57,6 +60,28 @@
nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
} \
MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+ return 1; \
}
+#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
+ uintptr_t nextFun; \
+ Initialize (al, mg, mfs, mmc, pk, ps); \
+ if (gcState.amOriginal) { \
+ real_Init(); \
+ nextFun = ml; \
+ } else { \
+ /* Return to the saved world */ \
+ nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ } \
+ MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+} \
+EXPORTED void LIB_CLOSE(LIBNAME) () { \
+ uintptr_t nextFun; \
+ nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ MLton_Bytecode_interpret (&MLton_bytecode, nextFun); \
+ GC_done(&gcState); \
+}
+
#endif /* #ifndef _BYTECODE_MAIN_H */
Modified: mlton/trunk/include/bytecode.h
===================================================================
--- mlton/trunk/include/bytecode.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/bytecode.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -8,6 +8,7 @@
#include <stdint.h>
#include "ml-types.h"
#include "c-types.h"
+#include "export.h"
typedef Pointer CPointer;
typedef Pointer Objptr;
Modified: mlton/trunk/include/c-common.h
===================================================================
--- mlton/trunk/include/c-common.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/c-common.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -13,6 +13,8 @@
#define DEBUG_CCODEGEN FALSE
#endif
+#include "export.h"
+
struct cont {
void *nextChunk;
};
@@ -25,7 +27,7 @@
#define ChunkName(n) Chunk ## n
#define DeclareChunk(n) \
- struct cont ChunkName(n)(void)
+ INTERNAL struct cont ChunkName(n)(void)
#define Chunkp(n) &(ChunkName(n))
Modified: mlton/trunk/include/c-main.h
===================================================================
--- mlton/trunk/include/c-main.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/c-main.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -16,11 +16,11 @@
return (GC_frameIndex)ra;
}
-#define MLtonMain(al, mg, mfs, mmc, pk, ps, mc, ml) \
+#define MLtonCallFromC \
/* Globals */ \
-uintptr_t nextFun; \
-int returnToC; \
-void MLton_callFromC () { \
+INTERNAL uintptr_t nextFun; \
+INTERNAL int returnToC; \
+static void MLton_callFromC () { \
struct cont cont; \
GC_state s; \
\
@@ -47,8 +47,11 @@
s->limit = 0; \
if (DEBUG_CCODEGEN) \
fprintf (stderr, "MLton_callFromC done\n"); \
-} \
-int MLton_main (int argc, char* argv[]) { \
+}
+
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, mc, ml) \
+MLtonCallFromC \
+EXPORTED int MLton_main (int argc, char* argv[]) { \
struct cont cont; \
Initialize (al, mg, mfs, mmc, pk, ps); \
if (gcState.amOriginal) { \
@@ -70,6 +73,36 @@
cont=(*(struct cont(*)(void))cont.nextChunk)(); \
cont=(*(struct cont(*)(void))cont.nextChunk)(); \
} \
+ return 1; \
}
+#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, mc, ml) \
+MLtonCallFromC \
+EXPORTED void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
+ struct cont cont; \
+ Initialize (al, mg, mfs, mmc, pk, ps); \
+ if (gcState.amOriginal) { \
+ real_Init(); \
+ PrepFarJump(mc, ml); \
+ } else { \
+ /* Return to the saved world */ \
+ nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ cont.nextChunk = nextChunks[nextFun]; \
+ } \
+ /* Trampoline */ \
+ do { \
+ cont=(*(struct cont(*)(void))cont.nextChunk)(); \
+ } while (not returnToC); \
+} \
+EXPORTED void LIB_CLOSE(LIBNAME) () { \
+ struct cont cont; \
+ nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ cont.nextChunk = nextChunks[nextFun]; \
+ returnToC = false; \
+ do { \
+ cont=(*(struct cont(*)(void))cont.nextChunk)(); \
+ } while (not returnToC); \
+ GC_done(&gcState); \
+}
+
#endif /* #ifndef _C_MAIN_H */
Modified: mlton/trunk/include/common-main.h
===================================================================
--- mlton/trunk/include/common-main.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/common-main.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -35,7 +35,7 @@
#define LoadArray(a, f) if (fread (a, sizeof(*a), cardof(a), f) != cardof(a)) return -1;
#define SaveArray(a, f) if (fwrite(a, sizeof(*a), cardof(a), f) != cardof(a)) return -1;
-Pointer gcStateAddress;
+INTERNAL Pointer gcStateAddress;
#define Initialize(al, mg, mfs, mmc, pk, ps) \
gcStateAddress = &gcState; \
@@ -72,6 +72,10 @@
gcState.profiling.stack = ps; \
MLton_init (argc, argv, &gcState); \
-void MLton_callFromC ();
+#define LIB_PASTE(x,y) x ## y
+#define LIB_OPEN(x) LIB_PASTE(x, _open)
+#define LIB_CLOSE(x) LIB_PASTE(x, _close)
+static void MLton_callFromC ();
+
#endif /* #ifndef _COMMON_MAIN_H_ */
Modified: mlton/trunk/include/x86-main.h
===================================================================
--- mlton/trunk/include/x86-main.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/include/x86-main.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -11,28 +11,28 @@
#include "common-main.h"
/* Globals */
-Word32 applyFFTemp;
-Word32 applyFFTemp2;
-Word32 checkTemp;
-Word32 cReturnTemp[16];
-Pointer c_stackP;
-Word32 divTemp;
-Word32 fildTemp;
-Word32 fpswTemp;
-Word32 indexTemp;
-Word32 raTemp1;
-Real64 raTemp2;
-Real64 realTemp1D;
-Real64 realTemp2D;
-Real64 realTemp3D;
-Real32 realTemp1S;
-Real32 realTemp2S;
-Real32 realTemp3S;
-Word32 spill[16];
-Word32 stackTopTemp;
-Word8 wordTemp1B;
-Word16 wordTemp1W;
-Word32 wordTemp1L;
+INTERNAL Word32 applyFFTemp;
+INTERNAL Word32 applyFFTemp2;
+INTERNAL Word32 checkTemp;
+INTERNAL Word32 cReturnTemp[16];
+INTERNAL Pointer c_stackP;
+INTERNAL Word32 divTemp;
+INTERNAL Word32 fildTemp;
+INTERNAL Word32 fpswTemp;
+INTERNAL Word32 indexTemp;
+INTERNAL Word32 raTemp1;
+INTERNAL Real64 raTemp2;
+INTERNAL Real64 realTemp1D;
+INTERNAL Real64 realTemp2D;
+INTERNAL Real64 realTemp3D;
+INTERNAL Real32 realTemp1S;
+INTERNAL Real32 realTemp2S;
+INTERNAL Real32 realTemp3S;
+INTERNAL Word32 spill[16];
+INTERNAL Word32 stackTopTemp;
+INTERNAL Word8 wordTemp1B;
+INTERNAL Word16 wordTemp1W;
+INTERNAL Word32 wordTemp1L;
#ifndef DEBUG_X86CODEGEN
#define DEBUG_X86CODEGEN FALSE
@@ -42,9 +42,9 @@
return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex)));
}
-#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+#define MLtonCallFromC \
void MLton_jumpToSML (pointer jump); \
-void MLton_callFromC () { \
+static void MLton_callFromC () { \
pointer jump; \
GC_state s; \
\
@@ -68,8 +68,11 @@
if (DEBUG_X86CODEGEN) \
fprintf (stderr, "MLton_callFromC() done\n"); \
return; \
-} \
-int MLton_main (int argc, char* argv[]) { \
+}
+
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED int MLton_main (int argc, char* argv[]) { \
pointer jump; \
extern pointer ml; \
\
@@ -84,5 +87,26 @@
return 1; \
}
+#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \
+MLtonCallFromC \
+EXPORTED void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
+ pointer jump; \
+ extern pointer ml; \
+ \
+ Initialize (al, mg, mfs, mmc, pk, ps); \
+ if (gcState.amOriginal) { \
+ real_Init(); \
+ jump = (pointer)&ml; \
+ } else { \
+ jump = *(pointer*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ } \
+ MLton_jumpToSML(jump); \
+} \
+EXPORTED void LIB_CLOSE(LIBNAME) () { \
+ pointer jump; \
+ jump = *(pointer*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
+ MLton_jumpToSML(jump); \
+ GC_done(&gcState); \
+}
+
#endif /* #ifndef _X86_MAIN_H_ */
-
Modified: mlton/trunk/mlton/atoms/ffi.fun
===================================================================
--- mlton/trunk/mlton/atoms/ffi.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/atoms/ffi.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -44,7 +44,7 @@
fun declareExports {print} =
let
- val _ = print "Pointer MLton_FFI_opArgsResPtr;\n"
+ val _ = print "INTERNAL Pointer MLton_FFI_opArgsResPtr;\n"
in
List.foreach
(!symbols, fn {name, ty} =>
@@ -85,7 +85,7 @@
1 + (Vector.length args)
+ (case res of NONE => 0 | SOME _ => 1)
in
- print (concat [header, " {\n"])
+ print (concat ["EXPORTED ", header, " {\n"])
; print (concat ["\tPointer localOpArgsRes[", Int.toString n,"];\n"])
; print (concat ["\tMLton_FFI_opArgsResPtr = (Pointer)(localOpArgsRes);\n"])
; print (concat ["\tInt32 localOp = ", Int.toString id, ";\n",
Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64-codegen.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64-codegen.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -145,7 +145,7 @@
Int.max (max, regMax t))
val m = m + 1
in
- print (concat [CType.toString t,
+ print (concat ["INTERNAL ", CType.toString t,
" local", CType.toString t,
"[", Int.toString m, "];\n"])
end)
Modified: mlton/trunk/mlton/codegen/amd64-codegen/amd64.fun
===================================================================
--- mlton/trunk/mlton/codegen/amd64-codegen/amd64.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/amd64-codegen/amd64.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -3143,6 +3143,8 @@
","))]
| Global l
=> seq [str ".globl ",
+ Label.layout l,
+ str "\n.hidden ",
Label.layout l]
| IndirectSymbol l
=> seq [str ".indirect_symbol ",
Modified: mlton/trunk/mlton/codegen/bytecode/bytecode.fun
===================================================================
--- mlton/trunk/mlton/codegen/bytecode/bytecode.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/bytecode/bytecode.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -82,7 +82,6 @@
| Real_rndToWord _ => true
| Real_round _ => true
| Real_sub _ => true
- | Thread_returnToC => true
| Word_add _ => true
| Word_addCheck _ => true
| Word_andb _ => true
@@ -324,7 +323,8 @@
datatype z = datatype Target.t
in
case target of
- Direct name =>
+ Direct "Thread_returnToC" => ()
+ | Direct name =>
let
val hash = String.hash name
in
@@ -380,6 +380,7 @@
val jumpOnOverflow = opcode "JumpOnOverflow"
val raisee = opcode "Raise"
val returnOp = opcode "Return"
+ val returnToC = opcode "Thread_returnToC"
datatype z = datatype WordSize.prim
val switch: WordSize.t -> Opcode.t =
let
@@ -699,7 +700,8 @@
datatype z = datatype Target.t
val () =
case target of
- Direct name => emitCallC (directIndex name)
+ Direct "Thread_returnToC" => emitOpcode returnToC
+ | Direct name => emitCallC (directIndex name)
| Indirect => emitCallC (indirectIndex func)
val () =
if maySwitchThreads
@@ -825,7 +827,7 @@
val () = done ()
val {done, print, ...} = outputC ()
fun declareCallC () =
- (print "void MLton_callC (int i) {\n"
+ (print "INTERNAL void MLton_callC (int i) {\n"
; print "switch (i) {\n"
; List.foreach (!callCs, fn {display, index} =>
(print (concat ["case ", Int.toString index, ":\n\t"])
Modified: mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -172,7 +172,6 @@
| Real_rndToWord _ => true
| Real_round _ => true
| Real_sub _ => true
- | Thread_returnToC => true
| Word_add _ => true
| Word_addCheck _ => true
| Word_andb _ => true
@@ -400,7 +399,10 @@
| Control.ProfileTimeField => "PROFILE_TIME_FIELD"
| Control.ProfileTimeLabel => "PROFILE_TIME_LABEL"
in
- C.callNoSemi ("MLtonMain",
+ C.callNoSemi (case !Control.format of
+ Control.Archive => "MLtonLibrary"
+ | Control.Executable => "MLtonMain"
+ | Control.Library => "MLtonLibrary",
[C.int align,
magic,
C.bytes maxFrameSize,
@@ -412,7 +414,7 @@
; print "\n"
end
fun declareMain () =
- if !Control.emitMain
+ if !Control.emitMain andalso !Control.format = Control.Executable
then List.foreach
(["int main (int argc, char* argv[]) {",
"return (MLton_main (argc, argv));",
@@ -453,7 +455,7 @@
end
in
outputIncludes (includes, print)
- ; declareGlobals ("", print)
+ ; declareGlobals ("INTERNAL ", print)
; declareExports ()
; declareLoadSaveGlobals ()
; declareIntInfs ()
@@ -1195,7 +1197,7 @@
val {print, done, ...} = outputC ()
fun rest () =
(List.foreach (chunks, fn c => declareChunk (c, print))
- ; print "struct cont ( *nextChunks []) () = {"
+ ; print "INTERNAL struct cont ( *nextChunks []) () = {"
; Vector.foreach (entryLabels, fn l =>
let
val {chunkLabel, ...} = labelInfo l
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86-codegen.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -145,7 +145,7 @@
Int.max (max, regMax t))
val m = m + 1
in
- print (concat [CType.toString t,
+ print (concat ["INTERNAL ", CType.toString t,
" local", CType.toString t,
"[", Int.toString m, "];\n"])
end)
Modified: mlton/trunk/mlton/codegen/x86-codegen/x86.fun
===================================================================
--- mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/codegen/x86-codegen/x86.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -3350,6 +3350,8 @@
","))]
| Global l
=> seq [str ".globl ",
+ Label.layout l,
+ str "\n.hidden ",
Label.layout l]
| IndirectSymbol l
=> seq [str ".indirect_symbol ",
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/control/control-flags.sig 2008-07-27 19:04:30 UTC (rev 6675)
@@ -145,6 +145,20 @@
val exnHistory: bool ref
+ structure Format:
+ sig
+ datatype t =
+ Archive
+ | Executable
+ | Library
+ val all: t list
+ val toString: t -> string
+ end
+
+ datatype format = datatype Format.t
+
+ val format: Format.t ref
+
(* *)
datatype gcCheck =
Limit
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/control/control-flags.sml 2008-07-27 19:04:30 UTC (rev 6675)
@@ -614,6 +614,27 @@
default = false,
toString = Bool.toString}
+structure Format =
+ struct
+ datatype t =
+ Archive
+ | Executable
+ | Library
+
+ val all = [Archive, Executable, Library]
+
+ val toString: t -> string =
+ fn Archive => "archive"
+ | Executable => "executable"
+ | Library => "library"
+ end
+
+datatype format = datatype Format.t
+
+val format = control {name = "generated output format",
+ default = Format.Executable,
+ toString = Format.toString}
+
structure GcCheck =
struct
datatype t =
Modified: mlton/trunk/mlton/main/compile.fun
===================================================================
--- mlton/trunk/mlton/main/compile.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/main/compile.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -424,6 +424,10 @@
val _ = print "typedef void* CPointer;\n"
val _ = print "typedef Pointer Objptr;\n"
val _ = print "\n"
+ val _ =
+ if !Control.format = Control.Executable then () else
+ (print ("void " ^ File.base f ^ "_open(int argc, const char** argv);\n")
+ ;print ("void " ^ File.base f ^ "_close();\n"))
val _ = Ffi.declareHeaders {print = print}
in
()
Modified: mlton/trunk/mlton/main/lookup-constant.fun
===================================================================
--- mlton/trunk/mlton/main/lookup-constant.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/main/lookup-constant.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -33,6 +33,10 @@
| x86Codegen => 2
| amd64Codegen => 3)),
("MLton_FFI_numExports", fn () => int (Ffi.numExports ())),
+ ("MLton_Platform_Format", fn () => case !format of
+ Archive => "archive"
+ | Executable => "executable"
+ | Library => "library"),
("MLton_Profile_isOn", fn () => bool (case !profile of
ProfileNone => false
| ProfileCallStack => false
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/mlton/main/main.fun 2008-07-27 19:04:30 UTC (rev 6675)
@@ -53,6 +53,7 @@
end
val gcc: string ref = ref "<unset>"
+val ar: string ref = ref "ar"
val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
val linkOpts: {opt: string, pred: OptPred.t} list ref = ref []
@@ -203,6 +204,8 @@
| "8" => Align8
| _ => usage (concat ["invalid -align flag: ",
s]))))),
+ (Expert, "ar", " <ar>", "path to ar executable",
+ SpaceString (fn s => ar := s)),
(Normal, "as-opt", " <opt>", "pass option to assembler",
(SpaceString o tokenizeOpt)
(fn s => List.push (asOpts, {opt = s, pred = OptPred.Yes}))),
@@ -353,6 +356,21 @@
boolRef expert),
(Normal, "export-header", " <file>", "write C header file for _export's",
SpaceString (fn s => exportHeader := SOME s)),
+ (Expert, "format",
+ concat [" {",
+ String.concatWith
+ (List.keepAllMap
+ (Control.Format.all, fn cg => SOME (Control.Format.toString cg)),
+ "|"),
+ "}"],
+ "generated output format",
+ SpaceString (fn s =>
+ Control.format
+ := (case List.peek
+ (Control.Format.all, fn cg =>
+ s = Control.Format.toString cg) of
+ SOME cg => cg
+ | NONE => usage (concat ["invalid -format flag: ", s])))),
(Expert, "gc-check", " {limit|first|every}", "force GCs",
SpaceString (fn s =>
gcCheck :=
@@ -869,6 +887,18 @@
file = s ^ "-" ^ gccFile}
end
| Self => !gcc
+ val ar =
+ case target of
+ Cross s =>
+ let
+ val {dir = arDir, file = arFile} =
+ OS.Path.splitDirFile (!ar)
+ in
+ OS.Path.joinDirFile
+ {dir = arDir,
+ file = s ^ "-" ^ arFile}
+ end
+ | Self => !ar
fun addTargetOpts opts =
List.fold
@@ -887,8 +917,13 @@
val ccOpts = addTargetOpts ccOpts
val ccOpts = concat ["-I", !libTargetDir, "/include"] :: ccOpts
val linkOpts =
- List.concat [[concat ["-L", !libTargetDir],
- if !debugRuntime then "-lmlton-gdb" else "-lmlton"],
+ List.concat [[concat ["-L", !libTargetDir]],
+ if !format = Library then
+ ["-lmlton-pic", "-lgdtoa-pic"]
+ else if !debugRuntime then
+ ["-lmlton-gdb", "-lgdtoa-gdb"]
+ else
+ ["-lmlton", "-lgdtoa"],
addTargetOpts linkOpts]
val _ =
if not (hasCodegen (!codegen))
@@ -1061,6 +1096,10 @@
case !output of
NONE => suffix suf
| SOME f => f
+ fun libname () =
+ case !exportHeader of
+ NONE => "lib"
+ | SOME f => File.base f
val _ =
atMLtons :=
Vector.fromList
@@ -1081,17 +1120,28 @@
| StabsPlus => (["-gstabs+", "-g2"], "-Wa,--gstabs")
fun compileO (inputs: File.t list): unit =
let
- val output = maybeOut ""
+ val output =
+ case !format of
+ Archive => maybeOut ".a"
+ | Executable => maybeOut ""
+ | Library => maybeOut ".so"
+ val libOpts =
+ [ "-shared", "-Wl,-Bsymbolic" ]
val _ =
trace (Top, "Link")
(fn () =>
- System.system
- (gcc,
- List.concat
- [["-o", output],
- if !debug then gccDebug else [],
- inputs,
- linkOpts]))
+ if !format = Archive
+ then (File.remove output
+ ;System.system
+ (ar, List.concat [["rcs", output], inputs]))
+ else System.system
+ (gcc,
+ List.concat
+ [["-o", output],
+ if !format = Library then libOpts else [],
+ if !debug then gccDebug else [],
+ inputs,
+ linkOpts]))
()
(* gcc on Cygwin appends .exe, which I don't want, so
* move the output file to it's rightful place.
@@ -1132,11 +1182,16 @@
let
val debugSwitches = gccDebug @ ["-DASSERT=1"]
val output = mkOutputO (c, input)
+
val _ =
System.system
(gcc,
List.concat
[[ "-std=gnu99", "-c" ],
+ if !format = Executable
+ then [] else [ "-DLIBNAME=" ^ libname () ],
+ if !format = Library
+ then [ "-fPIC", "-DPIC" ] else [],
if !debug then debugSwitches else [],
ccOpts,
["-o", output],
Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/runtime/Makefile 2008-07-27 19:04:30 UTC (rev 6675)
@@ -33,13 +33,21 @@
FLAGS :=
EXE :=
OPTFLAGS := -O2 -fomit-frame-pointer
+DEBUGFLAGS := -O1 -fno-inline -fkeep-inline-functions -g2
+PICFLAGS := -fPIC -DPIC
GCOPTFLAGS :=
-DEBUGFLAGS := -O1 -fno-inline -fkeep-inline-functions -g2
GCDEBUGFLAGS :=
+GCPICFLAGS :=
WARNFLAGS :=
OPTWARNFLAGS :=
DEBUGWARNFLAGS :=
+PICWARNFLAGS :=
+# Make mlton static library symbols private
+ifeq ($(findstring $(GCC_MAJOR_VERSION), 4),$(GCC_MAJOR_VERSION))
+FLAGS += -fvisibility=hidden
+endif
+
ifeq ($(TARGET_ARCH), amd64)
FLAGS += -m64
ifeq ($(findstring $(GCC_VERSION), 3.4 4.0 4.1),$(GCC_VERSION))
@@ -113,8 +121,10 @@
CFLAGS := -I. -Iplatform $(FLAGS)
OPTCFLAGS := $(CFLAGS) $(CPPFLAGS) $(OPTFLAGS)
DEBUGCFLAGS := $(CFLAGS) $(CPPFLAGS) -DASSERT=1 $(DEBUGFLAGS)
+PICCFLAGS := $(CFLAGS) $(CPPFLAGS) $(OPTFLAGS) $(PICFLAGS)
GCOPTCFLAGS = $(GCOPTFLAGS)
GCDEBUGCFLAGS = $(GCDEBUGFLAGS)
+GCPICCFLAGS = $(GCOPTFLAGS) $(GCPICFLAGS)
WARNCFLAGS :=
WARNCFLAGS += -pedantic -Wall
ifeq ($(findstring $(GCC_MAJOR_VERSION), 3),$(GCC_MAJOR_VERSION))
@@ -167,6 +177,7 @@
OPTWARNCFLAGS := $(WARNCFLAGS) -Wdisabled-optimization $(OPTWARNFLAGS)
DEBUGWARNCFLAGS := $(WARNCFLAGS) $(DEBUGWARNFLAGS)
+PICWARNCFLAGS := $(WARNCFLAGS) $(OPTWARNFLAGS) $(PICWARNFLAGS)
UTILHFILES := \
util.h \
@@ -212,25 +223,35 @@
gc-gdb.o \
platform-gdb.o \
platform/$(TARGET_OS)-gdb.o
+PIC_OBJS := \
+ util-pic.o \
+ gc-pic.o \
+ platform-pic.o \
+ platform/$(TARGET_OS)-pic.o
OMIT_BYTECODE := no
ifeq ($(OMIT_BYTECODE), yes)
else
OBJS += bytecode/interpret.o
DEBUG_OBJS += bytecode/interpret-gdb.o
+ PIC_OBJS += bytecode/interpret-pic.o
endif
ifeq ($(COMPILE_FAST), yes)
OBJS += basis.o
DEBUG_OBJS += basis-gdb.o
+ PIC_OBJS += basis-pic.o
else
OBJS += \
$(foreach f, $(basename $(BASISCFILES)), $(f).o)
DEBUG_OBJS += \
$(foreach f, $(basename $(BASISCFILES)), $(f)-gdb.o)
+ PIC_OBJS += \
+ $(foreach f, $(basename $(BASISCFILES)), $(f)-pic.o)
endif
-ALL := libgdtoa.a libmlton.a libmlton-gdb.a
+ALL := libgdtoa.a libgdtoa-gdb.a libgdtoa-pic.a \
+ libmlton.a libmlton-gdb.a libmlton-pic.a
ALL += gen/c-types.sml gen/basis-ffi.sml gen/sizes
ifeq ($(OMIT_BYTECODE), yes)
else
@@ -248,6 +269,24 @@
$(AR) libgdtoa.a gdtoa/*.o
$(RANLIB) libgdtoa.a
+libgdtoa-gdb.a: gdtoa/arith.h
+ cd gdtoa && \
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) \
+ -w -O1 -c -DINFNAN_CHECK \
+ *.c
+ $(RM) gdtoa/arithchk.o
+ $(AR) libgdtoa-gdb.a gdtoa/*.o
+ $(RANLIB) libgdtoa-gdb.a
+
+libgdtoa-pic.a: gdtoa/arith.h
+ cd gdtoa && \
+ $(CC) $(PICCFLAGS) $(PICWARNCFLAGS) \
+ -w -O1 -c -DINFNAN_CHECK \
+ *.c
+ $(RM) gdtoa/arithchk.o
+ $(AR) libgdtoa-pic.a gdtoa/*.o
+ $(RANLIB) libgdtoa-pic.a
+
gdtoa/arithchk.c:
gzip -dc gdtoa.tgz | tar xf -
patch -s -p0 <gdtoa-patch
@@ -266,7 +305,11 @@
$(AR) libmlton-gdb.a $(DEBUG_OBJS)
$(RANLIB) libmlton-gdb.a
+libmlton-pic.a: $(PIC_OBJS)
+ $(AR) libmlton-pic.a $(PIC_OBJS)
+ $(RANLIB) libmlton-pic.a
+
basis.c: $(BASISCFILES)
rm -f basis.c
cat $(BASISCFILES) >> basis.c
@@ -305,12 +348,18 @@
rm -f bytecode/print-opcodes$(EXE)
+util-pic.o: util.c $(UTILCFILES) cenv.h $(UTILHFILES)
+ $(CC) $(PICCFLAGS) $(PICWARNCFLAGS) -c -o $@ $<
+
util-gdb.o: util.c $(UTILCFILES) cenv.h $(UTILHFILES)
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -c -o $@ $<
util.o: util.c $(UTILCFILES) cenv.h $(UTILHFILES)
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -c -o $@ $<
+gc-pic.o: gc.c $(GCCFILES) $(HFILES)
+ $(CC) $(PICCFLAGS) $(GCPICCFLAGS) $(PICWARNCFLAGS) -c -o $@ $<
+
gc-gdb.o: gc.c $(GCCFILES) $(HFILES)
$(CC) $(DEBUGCFLAGS) $(GCDEBUGCFLAGS) $(DEBUGWARNCFLAGS) -c -o $@ $<
@@ -318,10 +367,12 @@
$(CC) $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -c -o $@ $<
## Needs -Wno-float-equal for Real<N>_equal, included via "c-chunk.h".
+bytecode/interpret-pic.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
+ $(CC) -I../include $(PICCFLAGS) $(PICWARNCFLAGS) -Wno-float-equal -c -o $@ $<
+
bytecode/interpret-gdb.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
$(CC) -I../include $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -c -o $@ $<
-## Needs -Wno-float-equal for Real<N>_equal, included via "c-chunk.h".
bytecode/interpret.o: bytecode/interpret.c $(HFILES) $(BYTECODEHFILES)
$(CC) -I../include $(OPTCFLAGS) $(GCOPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -c -o $@ $<
@@ -329,31 +380,34 @@
## Needs -Wno-float-equal for Real<N>_equal;
## needs -Wno-format-nonliteralfor Date_strfTime;
## needs -Wno-redundant-decls for 'extern struct GC_state gcState'.
+basis-pic.o: basis.c $(BASISCFILES) $(HFILES)
+ $(CC) -Ibasis -Ibasis/Word -Ibasis/Real $(PICCFLAGS) $(PICWARNCFLAGS) -Wno-float-equal -Wno-format-nonliteral -Wno-redundant-decls -c -o $@ $<
basis-gdb.o: basis.c $(BASISCFILES) $(HFILES)
$(CC) -Ibasis -Ibasis/Word -Ibasis/Real $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -Wno-format-nonliteral -Wno-redundant-decls -c -o $@ $<
+basis.o: basis.c $(BASISCFILES) $(HFILES)
+ $(CC) -Ibasis -Ibasis/Word -Ibasis/Real $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -Wno-format-nonliteral -Wno-redundant-decls -c -o $@ $<
## Needs -Wno-float-equal for Real<N>_equal.
+basis/Real/Real-pic.o: basis/Real/Real.c $(HFILES)
+ $(CC) $(PICCFLAGS) $(PICWARNCFLAGS) -Wno-float-equal -c -o $@ $<
basis/Real/Real-gdb.o: basis/Real/Real.c $(HFILES)
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-float-equal -c -o $@ $<
+basis/Real/Real.o: basis/Real/Real.c $(HFILES)
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -c -o $@ $<
## Needs -Wno-format-nonliteralfor Date_strfTime.
+basis/System/Date-pic.o: basis/System/Date.c $(HFILES)
+ $(CC) $(PICCFLAGS) $(PICWARNCFLAGS) -Wno-format-nonliteral -c -o $@ $<
basis/System/Date-gdb.o: basis/System/Date.c $(HFILES)
+ $(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -Wno-format-nonliteral -c -o $@ $<
+basis/System/Date.o: basis/System/Date.c $(HFILES)
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-format-nonliteral -c -o $@ $<
+
+%-pic.o: %.c $(HFILES)
+ $(CC) $(PICCFLAGS) $(PICWARNCFLAGS) -c -o $@ $<
+
%-gdb.o: %.c $(HFILES)
$(CC) $(DEBUGCFLAGS) $(DEBUGWARNCFLAGS) -c -o $@ $<
-
-## Needs -Wno-float-equal for Real<N>_equal;
-## needs -Wno-format-nonliteral for Date_strfTime;
-## needs -Wno-redundant-decls for 'extern struct GC_state gcState'.
-basis.o: basis.c $(BASISCFILES) $(HFILES)
- $(CC) -Ibasis -Ibasis/Word -Ibasis/Real $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -Wno-format-nonliteral -Wno-redundant-decls -c -o $@ $<
-## Needs -Wno-float-equal for Real<N>_equal.
-basis/Real/Real.o: basis/Real/Real.c $(HFILES)
- $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-float-equal -c -o $@ $<
-## Needs -Wno-format-nonliteralfor Date_strfTime.
-basis/System/Date.o: basis/System/Date.c $(HFILES)
- $(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -Wno-format-nonliteral -c -o $@ $<
-
%.o: %.c $(HFILES)
$(CC) $(OPTCFLAGS) $(OPTWARNCFLAGS) -c -o $@ $<
Modified: mlton/trunk/runtime/bytecode/interpret.c
===================================================================
--- mlton/trunk/runtime/bytecode/interpret.c 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/runtime/bytecode/interpret.c 2008-07-27 19:04:30 UTC (rev 6675)
@@ -597,7 +597,10 @@
Switch(32);
Switch(64);
case opcodeSym (Thread_returnToC):
- maybe goto done;
+ if (disassemble) goto mainLoop;
+ FlushFrontier ();
+ FlushStackTop ();
+ goto done;
default:
assert (FALSE);
}
Added: mlton/trunk/runtime/export.h
===================================================================
--- mlton/trunk/runtime/export.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/runtime/export.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -0,0 +1,24 @@
+/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+#ifndef _MLTON_EXPORT_H_
+#define _MLTON_EXPORT_H_
+
+/* ------------------------------------------------- */
+/* Symbols */
+/* ------------------------------------------------- */
+
+#if __GNUC__ >= 4
+#define EXPORTED __attribute__((visibility("default")))
+#define INTERNAL __attribute__((visibility("hidden")))
+#else
+#define EXPORTED
+#define INTERNAL
+#endif
+
+#endif /* _MLTON_EXPORT_H_ */
Modified: mlton/trunk/runtime/platform.h
===================================================================
--- mlton/trunk/runtime/platform.h 2008-07-27 17:22:57 UTC (rev 6674)
+++ mlton/trunk/runtime/platform.h 2008-07-27 19:04:30 UTC (rev 6675)
@@ -13,6 +13,7 @@
#include "util.h"
#include "ml-types.h"
#include "c-types.h"
+#include "export.h"
#ifndef MLton_Platform_Arch_host
#error MLton_Platform_Arch_host not defined
More information about the MLton-commit
mailing list