Generating C libraries from MLton (patch)
|
View:
New views
2 Messages
—
Rating Filter:
Alert me
|
 |
Generating C libraries from MLton (patch)
by Wesley W. Terpstra-5
::
Rate this Message:
Since the previous attempt to build C libraries with MLton seems to have fizzled out, I have taken it over. :-) The attached 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. I would commit this myself as I'm fairly confident I didn't break anything, but I've misplaced my password. -.- When committing, please try to resist changing the patch too much, because I spent a lot of time testing it and would rather not have to do it all again. [library-support.patch] Index: include/common-main.h =================================================================== --- include/common-main.h (revision 6672) +++ include/common-main.h (working copy) @@ -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_ */ Index: include/amd64-main.h =================================================================== --- include/amd64-main.h (revision 6672) +++ include/amd64-main.h (working copy) @@ -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,27 @@ 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); \ + GC_switchToThread (&gcState, GC_getSavedThread (&gcState), 0); \ +} \ +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_ */ Index: include/bytecode.h =================================================================== --- include/bytecode.h (revision 6672) +++ include/bytecode.h (working copy) @@ -8,6 +8,7 @@ #include <stdint.h> #include "ml-types.h" #include "c-types.h" +#include "export.h" typedef Pointer CPointer; typedef Pointer Objptr; Index: include/bytecode-main.h =================================================================== --- include/bytecode-main.h (revision 6672) +++ include/bytecode-main.h (working copy) @@ -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,29 @@ 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); \ + GC_switchToThread (&gcState, GC_getSavedThread (&gcState), 0); \ +} \ +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 */ Index: include/c-main.h =================================================================== --- include/c-main.h (revision 6672) +++ include/c-main.h (working copy) @@ -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,37 @@ 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); \ + GC_switchToThread (&gcState, GC_getSavedThread (&gcState), 0); \ +} \ +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 */ Index: include/x86-main.h =================================================================== --- include/x86-main.h (revision 6672) +++ include/x86-main.h (working copy) @@ -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,27 @@ 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); \ + GC_switchToThread (&gcState, GC_getSavedThread (&gcState), 0); \ +} \ +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_ */ - Index: include/c-chunk.h =================================================================== --- include/c-chunk.h (revision 6672) +++ include/c-chunk.h (working copy) @@ -144,7 +144,7 @@ fprintf (stderr, "%s:%d: Thread_returnToC()\n", \ __FILE__, __LINE__); \ returnToC = TRUE; \ - return cont; \ + goto leaveChunk; \ } while (0) /* ------------------------------------------------- */ @@ -212,7 +212,7 @@ #define MLTON_CODEGEN_MEMCPY(decl) #endif MLTON_CODEGEN_MEMCPY(void * memcpy(void *, const void*, size_t);) -#include "basis-ffi.h" +/* imported via FFI, so elided: #include "basis-ffi.h" */ #include "basis/coerce.h" #include "basis/cpointer.h" #include "basis/Real/Real-ops.h" Index: include/c-common.h =================================================================== --- include/c-common.h (revision 6672) +++ include/c-common.h (working copy) @@ -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)) Index: runtime/bytecode/interpret.c =================================================================== --- runtime/bytecode/interpret.c (revision 6672) +++ runtime/bytecode/interpret.c (working copy) @@ -597,6 +597,8 @@ Switch(32); Switch(64); case opcodeSym (Thread_returnToC): + FlushFrontier (); + FlushStackTop (); maybe goto done; default: assert (FALSE); Index: runtime/export.h =================================================================== --- runtime/export.h (revision 0) +++ runtime/export.h (revision 0) @@ -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_ */ Index: runtime/platform.h =================================================================== --- runtime/platform.h (revision 6672) +++ runtime/platform.h (working copy) @@ -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 Index: runtime/Makefile =================================================================== --- runtime/Makefile (revision 6672) +++ runtime/Makefile (working copy) @@ -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 $@ $< Index: mlton/control/control-flags.sig =================================================================== --- mlton/control/control-flags.sig (revision 6672) +++ mlton/control/control-flags.sig (working copy) @@ -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 Index: mlton/control/control-flags.sml =================================================================== --- mlton/control/control-flags.sml (revision 6672) +++ mlton/control/control-flags.sml (working copy) @@ -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 = Index: mlton/atoms/ffi.fun =================================================================== --- mlton/atoms/ffi.fun (revision 6672) +++ mlton/atoms/ffi.fun (working copy) @@ -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} => @@ -69,7 +69,8 @@ "(Pointer)(&", x, ");\n"]) end) val header = - concat [case res of + concat ["EXPORTED ", + case res of NONE => "void" | SOME t => CType.toString t, if convention <> Convention.Cdecl Index: mlton/main/compile.fun =================================================================== --- mlton/main/compile.fun (revision 6672) +++ mlton/main/compile.fun (working copy) @@ -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 () Index: mlton/main/lookup-constant.fun =================================================================== --- mlton/main/lookup-constant.fun (revision 6672) +++ mlton/main/lookup-constant.fun (working copy) @@ -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 Index: mlton/main/main.fun =================================================================== --- mlton/main/main.fun (revision 6672) +++ mlton/main/main.fun (working copy) @@ -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], Index: mlton/codegen/c-codegen/c-codegen.fun =================================================================== --- mlton/codegen/c-codegen/c-codegen.fun (revision 6672) +++ mlton/codegen/c-codegen/c-codegen.fun (working copy) @@ -400,7 +400,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 +415,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 +456,7 @@ end in outputIncludes (includes, print) - ; declareGlobals ("", print) + ; declareGlobals ("INTERNAL ", print) ; declareExports () ; declareLoadSaveGlobals () ; declareIntInfs () @@ -1195,7 +1198,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 Index: mlton/codegen/x86-codegen/x86.fun =================================================================== --- mlton/codegen/x86-codegen/x86.fun (revision 6672) +++ mlton/codegen/x86-codegen/x86.fun (working copy) @@ -3350,6 +3350,8 @@ ","))] | Global l => seq [str ".globl ", + Label.layout l, + str "\n.hidden ", Label.layout l] | IndirectSymbol l => seq [str ".indirect_symbol ", Index: mlton/codegen/x86-codegen/x86-codegen.fun =================================================================== --- mlton/codegen/x86-codegen/x86-codegen.fun (revision 6672) +++ mlton/codegen/x86-codegen/x86-codegen.fun (working copy) @@ -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) Index: mlton/codegen/amd64-codegen/amd64.fun =================================================================== --- mlton/codegen/amd64-codegen/amd64.fun (revision 6672) +++ mlton/codegen/amd64-codegen/amd64.fun (working copy) @@ -3143,6 +3143,8 @@ ","))] | Global l => seq [str ".globl ", + Label.layout l, + str "\n.hidden ", Label.layout l] | IndirectSymbol l => seq [str ".indirect_symbol ", Index: mlton/codegen/amd64-codegen/amd64-codegen.fun =================================================================== --- mlton/codegen/amd64-codegen/amd64-codegen.fun (revision 6672) +++ mlton/codegen/amd64-codegen/amd64-codegen.fun (working copy) @@ -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) Index: mlton/codegen/bytecode/bytecode.fun =================================================================== --- mlton/codegen/bytecode/bytecode.fun (revision 6672) +++ mlton/codegen/bytecode/bytecode.fun (working copy) @@ -825,7 +825,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"]) Index: basis-library/mlton/platform.sig =================================================================== --- basis-library/mlton/platform.sig (revision 6672) +++ basis-library/mlton/platform.sig (working copy) @@ -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 Index: basis-library/mlton/platform.sml =================================================================== --- basis-library/mlton/platform.sml (revision 6672) +++ basis-library/mlton/platform.sml (working copy) @@ -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 Index: basis-library/mlton/mlton.sml =================================================================== --- basis-library/mlton/mlton.sml (revision 6672) +++ basis-library/mlton/mlton.sml (working copy) @@ -149,8 +149,29 @@ end val _ = - (Primitive.TopLevel.setHandler MLtonExn.defaultTopLevelHandler - ; Primitive.TopLevel.setSuffix Exit.defaultTopLevelSuffix) + let + open Primitive.TopLevel + open MLtonPlatform.Format + + fun librarySuffix () = + let + open Cleaner + val () = MLtonThread.libraryReturnToC () + val () = clean atExit + val () = MLtonThread.libraryReturnToC () + in + () + end + + val suffix = + case host of + Archive => librarySuffix + | Executable => Exit.defaultTopLevelSuffix + | Library => librarySuffix + in + setHandler MLtonExn.defaultTopLevelHandler + ; setSuffix suffix + end end (* Patch OS.FileSys.tmpName to use mkstemp. *) Index: basis-library/mlton/thread.sig =================================================================== --- basis-library/mlton/thread.sig (revision 6672) +++ basis-library/mlton/thread.sig (working copy) @@ -62,6 +62,7 @@ include MLTON_THREAD val amInSignalHandler: unit -> bool + val libraryReturnToC: unit -> unit val register: int * (MLtonPointer.t -> unit) -> unit val setSignalHandler: (Runnable.t -> Runnable.t) -> unit val switchToSignalHandler: unit -> unit Index: basis-library/mlton/thread.sml =================================================================== --- basis-library/mlton/thread.sml (revision 6672) +++ basis-library/mlton/thread.sml (working copy) @@ -263,4 +263,15 @@ end end + (* Returning to C ends the life of a thread (it cannot be resumed). + * So we create a thread, save the main thread and switch to the new thread. + * The library main loop pops the saved thread after execution. + *) + fun libraryReturnToC () = + let + val doomed = toPrimitive (new Prim.returnToC) + val () = Prim.setSaved (gcState, Prim.current gcState) + in + Prim.switchTo doomed + end end Index: basis-library/primitive/prim-mlton.sml =================================================================== --- basis-library/primitive/prim-mlton.sml (revision 6672) +++ basis-library/primitive/prim-mlton.sml (working copy) @@ -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 = Index: doc/changelog =================================================================== --- doc/changelog (revision 6672) +++ doc/changelog (working copy) @@ -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. Index: bin/mlton-script =================================================================== --- bin/mlton-script (revision 6672) +++ bin/mlton-script (working copy) @@ -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' \ _______________________________________________ MLton mailing list MLton@... http://mlton.org/mailman/listinfo/mlton |
|
|
Re: Generating C libraries from MLton (patch)
by Matthew Fluet-3
::
Rate this Message:
On Thu, 24 Jul 2008, Wesley W. Terpstra wrote:
> Since the previous attempt to build C libraries with MLton seems to have > fizzled out, I have taken it over. :-) I strongly suggest that you add a 'doc/examples/ffi-shared' directory and populate it with some sample code (and a Makefile) that demonstrates how to build and use libraries and shared libraries. It would go a long way towards making testing on different platforms easier. The overall architecture seems good, and I know that a lot of commits have already been made. (In retrospect, perhaps this would have been better undertaken on a branch, but it hasn't seemed too disruptive to normal executable compiles.) I would also suggest that commit messages comment directly on the commit in question; some of them seem to dump a lot of information that isn't relevant to the particular commit. The information is good -- just send it directly to the mailing list or put it on the wiki. Another thing that would be helpful would be to document some things on the wiki. Something I would be interested in seeing is pointers/links to other documentation that informs the design/implementation. Particularly with regards to the changes in the codegen, it would be comforting to see an ABI document, and not simply working from the output of 'gcc -S'. _______________________________________________ MLton mailing list MLton@... http://mlton.org/mailman/listinfo/mlton |
| Free Forum Powered by Nabble | Forum Help |