[MLton-commit] r6646
Matthew Fluet
fluet at mlton.org
Fri Jun 6 09:10:45 PDT 2008
Feature request of John Reppy.
Is it possible to set things up so that one can define a main()
function in C code that gets called before the MLton main?
Added expert command line switch '-emit-main {true|false}'.
This allows a user to interpose his own main() startup function
(supplied via an additional .c or .o file); such a function should
conclude with a call to
int MLton_main(int argc, char* argv[]);
(declared in "mlton-main.h"); this function does not return.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/include/amd64-main.h
U mlton/trunk/include/bytecode-main.h
U mlton/trunk/include/c-main.h
A mlton/trunk/include/common-main.h
D mlton/trunk/include/main.h
A mlton/trunk/include/mlton-main.h
U mlton/trunk/include/x86-main.h
U mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/doc/changelog 2008-06-06 16:10:43 UTC (rev 6646)
@@ -1,5 +1,8 @@
Here are the changes from version 20070826 to version YYYYMMDD.
+* 2008-06-06
+ - Added expert command line switch -emit-main {true|false}.
+
* 2008-05-17
- Fixed bug in Windows code to page the heap to disk when unable to
grow the heap to a desired size.
Modified: mlton/trunk/include/amd64-main.h
===================================================================
--- mlton/trunk/include/amd64-main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/amd64-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -8,7 +8,7 @@
#ifndef _AMD64_MAIN_H_
#define _AMD64_MAIN_H_
-#include "main.h"
+#include "common-main.h"
/* Globals */
Word64 applyFFTempFun;
@@ -35,7 +35,7 @@
return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex)));
}
-#define Main(al, mg, mfs, mmc, pk, ps, ml) \
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
void MLton_jumpToSML (pointer jump); \
void MLton_callFromC () { \
pointer jump; \
@@ -61,7 +61,7 @@
fprintf (stderr, "MLton_callFromC() done\n"); \
return; \
} \
-int main (int argc, char **argv) { \
+int MLton_main (int argc, char* argv[]) { \
pointer jump; \
extern pointer ml; \
\
Modified: mlton/trunk/include/bytecode-main.h
===================================================================
--- mlton/trunk/include/bytecode-main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/bytecode-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -8,7 +8,7 @@
#ifndef _BYTECODE_MAIN_H_
#define _BYTECODE_MAIN_H_
-#include "main.h"
+#include "common-main.h"
#include "interpret.h"
#ifndef DEBUG_CODEGEN
@@ -21,7 +21,7 @@
return *((GC_frameIndex*)(MLton_bytecode.code + ra - sizeof(GC_frameIndex)));
}
-#define Main(al, mg, mfs, mmc, pk, ps, ml) \
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
void MLton_callFromC () { \
uintptr_t nextFun; \
GC_state s; \
@@ -46,7 +46,7 @@
if (DEBUG_CODEGEN) \
fprintf (stderr, "MLton_callFromC done\n"); \
} \
-int main (int argc, char **argv) { \
+int MLton_main (int argc, char* argv[]) { \
uintptr_t nextFun; \
Initialize (al, mg, mfs, mmc, pk, ps); \
if (gcState.amOriginal) { \
Modified: mlton/trunk/include/c-main.h
===================================================================
--- mlton/trunk/include/c-main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/c-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -9,14 +9,14 @@
#ifndef _C_MAIN_H_
#define _C_MAIN_H_
-#include "main.h"
+#include "common-main.h"
#include "c-common.h"
static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
return (GC_frameIndex)ra;
}
-#define Main(al, mg, mfs, mmc, pk, ps, mc, ml) \
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, mc, ml) \
/* Globals */ \
uintptr_t nextFun; \
int returnToC; \
@@ -48,7 +48,7 @@
if (DEBUG_CCODEGEN) \
fprintf (stderr, "MLton_callFromC done\n"); \
} \
-int main (int argc, char **argv) { \
+int MLton_main (int argc, char* argv[]) { \
struct cont cont; \
Initialize (al, mg, mfs, mmc, pk, ps); \
if (gcState.amOriginal) { \
Copied: mlton/trunk/include/common-main.h (from rev 6644, mlton/trunk/include/main.h)
===================================================================
--- mlton/trunk/include/main.h 2008-06-05 20:34:40 UTC (rev 6644)
+++ mlton/trunk/include/common-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -0,0 +1,77 @@
+/* Copyright (C) 1999-2008 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 _COMMON_MAIN_H_
+#define _COMMON_MAIN_H_
+
+#include "mlton-main.h"
+
+#define MLTON_GC_INTERNAL_TYPES
+#define MLTON_GC_INTERNAL_BASIS
+#include "platform.h"
+
+typedef Pointer CPointer;
+typedef Pointer Objptr;
+
+/* The label must be declared as weak because gcc's optimizer may prove that
+ * the code that declares the label is dead and hence eliminate the declaration.
+ */
+#define DeclareProfileLabel(l) \
+ extern char l __attribute__ ((weak))
+
+#define BeginIntInfs static struct GC_intInfInit intInfInits[] = {
+#define IntInf(g, n) { g, n },
+#define EndIntInfs };
+
+#define BeginVectors static struct GC_vectorInit vectorInits[] = {
+#define Vector(a, b, c, d) { a, b, c, d },
+#define EndVectors };
+
+#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;
+
+#define Initialize(al, mg, mfs, mmc, pk, ps) \
+ gcStateAddress = &gcState; \
+ gcState.alignment = al; \
+ gcState.atMLtons = atMLtons; \
+ gcState.atMLtonsLength = cardof(atMLtons); \
+ gcState.frameLayouts = frameLayouts; \
+ gcState.frameLayoutsLength = cardof(frameLayouts); \
+ gcState.globals = globalObjptr; \
+ gcState.globalsLength = cardof(globalObjptr); \
+ gcState.intInfInits = intInfInits; \
+ gcState.intInfInitsLength = cardof(intInfInits); \
+ gcState.loadGlobals = loadGlobals; \
+ gcState.magic = mg; \
+ gcState.maxFrameSize = mfs; \
+ gcState.mutatorMarksCards = mmc; \
+ gcState.objectTypes = objectTypes; \
+ gcState.objectTypesLength = cardof(objectTypes); \
+ gcState.returnAddressToFrameIndex = returnAddressToFrameIndex; \
+ gcState.saveGlobals = saveGlobals; \
+ gcState.vectorInits = vectorInits; \
+ gcState.vectorInitsLength = cardof(vectorInits); \
+ gcState.sourceMaps.frameSources = frameSources; \
+ gcState.sourceMaps.frameSourcesLength = cardof(frameSources); \
+ gcState.sourceMaps.sourceLabels = sourceLabels; \
+ gcState.sourceMaps.sourceLabelsLength = cardof(sourceLabels); \
+ gcState.sourceMaps.sourceNames = sourceNames; \
+ gcState.sourceMaps.sourceNamesLength = cardof(sourceNames); \
+ gcState.sourceMaps.sourceSeqs = sourceSeqs; \
+ gcState.sourceMaps.sourceSeqsLength = cardof(sourceSeqs); \
+ gcState.sourceMaps.sources = sources; \
+ gcState.sourceMaps.sourcesLength = cardof(sources); \
+ gcState.profiling.kind = pk; \
+ gcState.profiling.stack = ps; \
+ MLton_init (argc, argv, &gcState); \
+
+void MLton_callFromC ();
+
+#endif /* #ifndef _COMMON_MAIN_H_ */
Deleted: mlton/trunk/include/main.h
===================================================================
--- mlton/trunk/include/main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -1,75 +0,0 @@
-/* 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 _MAIN_H_
-#define _MAIN_H_
-
-#define MLTON_GC_INTERNAL_TYPES
-#define MLTON_GC_INTERNAL_BASIS
-#include "platform.h"
-
-typedef Pointer CPointer;
-typedef Pointer Objptr;
-
-/* The label must be declared as weak because gcc's optimizer may prove that
- * the code that declares the label is dead and hence eliminate the declaration.
- */
-#define DeclareProfileLabel(l) \
- extern char l __attribute__ ((weak))
-
-#define BeginIntInfs static struct GC_intInfInit intInfInits[] = {
-#define IntInf(g, n) { g, n },
-#define EndIntInfs };
-
-#define BeginVectors static struct GC_vectorInit vectorInits[] = {
-#define Vector(a, b, c, d) { a, b, c, d },
-#define EndVectors };
-
-#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;
-
-#define Initialize(al, mg, mfs, mmc, pk, ps) \
- gcStateAddress = &gcState; \
- gcState.alignment = al; \
- gcState.atMLtons = atMLtons; \
- gcState.atMLtonsLength = cardof(atMLtons); \
- gcState.frameLayouts = frameLayouts; \
- gcState.frameLayoutsLength = cardof(frameLayouts); \
- gcState.globals = globalObjptr; \
- gcState.globalsLength = cardof(globalObjptr); \
- gcState.intInfInits = intInfInits; \
- gcState.intInfInitsLength = cardof(intInfInits); \
- gcState.loadGlobals = loadGlobals; \
- gcState.magic = mg; \
- gcState.maxFrameSize = mfs; \
- gcState.mutatorMarksCards = mmc; \
- gcState.objectTypes = objectTypes; \
- gcState.objectTypesLength = cardof(objectTypes); \
- gcState.returnAddressToFrameIndex = returnAddressToFrameIndex; \
- gcState.saveGlobals = saveGlobals; \
- gcState.vectorInits = vectorInits; \
- gcState.vectorInitsLength = cardof(vectorInits); \
- gcState.sourceMaps.frameSources = frameSources; \
- gcState.sourceMaps.frameSourcesLength = cardof(frameSources); \
- gcState.sourceMaps.sourceLabels = sourceLabels; \
- gcState.sourceMaps.sourceLabelsLength = cardof(sourceLabels); \
- gcState.sourceMaps.sourceNames = sourceNames; \
- gcState.sourceMaps.sourceNamesLength = cardof(sourceNames); \
- gcState.sourceMaps.sourceSeqs = sourceSeqs; \
- gcState.sourceMaps.sourceSeqsLength = cardof(sourceSeqs); \
- gcState.sourceMaps.sources = sources; \
- gcState.sourceMaps.sourcesLength = cardof(sources); \
- gcState.profiling.kind = pk; \
- gcState.profiling.stack = ps; \
- MLton_init (argc, argv, &gcState); \
-
-void MLton_callFromC ();
-
-#endif /* #ifndef _MAIN_H_ */
Added: mlton/trunk/include/mlton-main.h
===================================================================
--- mlton/trunk/include/mlton-main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/mlton-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -0,0 +1,14 @@
+/* Copyright (C) 1999-2008 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_MAIN_H_
+#define _MLTON_MAIN_H_
+
+int MLton_main(int argc, char* argv[]);
+
+#endif /* #ifndef _MLTON_MAIN_H_ */
Modified: mlton/trunk/include/x86-main.h
===================================================================
--- mlton/trunk/include/x86-main.h 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/include/x86-main.h 2008-06-06 16:10:43 UTC (rev 6646)
@@ -8,7 +8,7 @@
#ifndef _X86_MAIN_H_
#define _X86_MAIN_H_
-#include "main.h"
+#include "common-main.h"
/* Globals */
Word32 applyFFTemp;
@@ -42,7 +42,7 @@
return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex)));
}
-#define Main(al, mg, mfs, mmc, pk, ps, ml) \
+#define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \
void MLton_jumpToSML (pointer jump); \
void MLton_callFromC () { \
pointer jump; \
@@ -69,7 +69,7 @@
fprintf (stderr, "MLton_callFromC() done\n"); \
return; \
} \
-int main (int argc, char **argv) { \
+int MLton_main (int argc, char* argv[]) { \
pointer jump; \
extern pointer ml; \
\
Modified: mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/mlton/codegen/c-codegen/c-codegen.fun 2008-06-06 16:10:43 UTC (rev 6646)
@@ -380,7 +380,7 @@
C.int bytesNonObjptrs, ", ",
C.int numObjptrs, " }"]
end)
- fun declareMain () =
+ fun declareMLtonMain () =
let
val align =
case !Control.align of
@@ -400,7 +400,7 @@
| Control.ProfileTimeField => "PROFILE_TIME_FIELD"
| Control.ProfileTimeLabel => "PROFILE_TIME_LABEL"
in
- C.callNoSemi ("Main",
+ C.callNoSemi ("MLtonMain",
[C.int align,
magic,
C.bytes maxFrameSize,
@@ -411,6 +411,13 @@
print)
; print "\n"
end
+ fun declareMain () =
+ if !Control.emitMain
+ then List.foreach
+ (["int main (int argc, char* argv[]) {",
+ "return (MLton_main (argc, argv));",
+ "}"], fn s => (print s; print "\n"))
+ else ()
fun declareProfileInfo () =
let
fun doit (ProfileInfo.T {frameSources, labels, names, sourceSeqs,
@@ -458,6 +465,7 @@
; declareProfileInfo ()
; declareAtMLtons ()
; rest ()
+ ; declareMLtonMain ()
; declareMain ()
end
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/mlton/control/control-flags.sig 2008-06-06 16:10:43 UTC (rev 6646)
@@ -139,6 +139,8 @@
*)
val elaborateOnly: bool ref
+ val emitMain: bool ref
+
val exportHeader: File.t option ref
val exnHistory: bool ref
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/mlton/control/control-flags.sml 2008-06-06 16:10:43 UTC (rev 6646)
@@ -600,6 +600,11 @@
default = false,
toString = Bool.toString}
+val emitMain =
+ control {name = "emit main",
+ default = true,
+ toString = Bool.toString}
+
val exportHeader =
control {name = "export header",
default = NONE,
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2008-06-06 15:54:16 UTC (rev 6645)
+++ mlton/trunk/mlton/main/main.fun 2008-06-06 16:10:43 UTC (rev 6646)
@@ -347,6 +347,8 @@
end,
(Expert, "error-threshhold", " <n>", "error threshhold (20)",
intRef errorThreshhold),
+ (Expert, "emit-main", " {true|false}", "emit main() startup function",
+ boolRef emitMain),
(Expert, "expert", " {false|true}", "enable expert status",
boolRef expert),
(Normal, "export-header", " <file>", "write C header file for _export's",
More information about the MLton-commit
mailing list