Index: basis-library/posix/proc-env.sml =================================================================== --- basis-library/posix/proc-env.sml (revision 6242) +++ basis-library/posix/proc-env.sml (working copy) @@ -33,7 +33,8 @@ val setuid = fn uid => SysCall.simple (fn () => setuid uid) end - fun setsid () = SysCall.simpleResult (Prim.setsid) + fun setsid () = + SysCall.simpleResult' ({ errVal = ~1 : C_PId.t }, Prim.setsid) val uidToWord = C_UId.castToSysWord val wordToUid = C_UId.castFromSysWord Index: basis-library/primitive/basis-ffi.sml =================================================================== --- basis-library/primitive/basis-ffi.sml (revision 6242) +++ basis-library/primitive/basis-ffi.sml (working copy) @@ -80,8 +80,8 @@ structure Process = struct val cwait = _import "MLton_Process_cwait" : C_PId.t * (C_Status.t) ref -> (C_PId.t) C_Errno.t; -val spawne = _import "MLton_Process_spawne" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_Int.t) C_Errno.t; -val spawnp = _import "MLton_Process_spawnp" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_Int.t) C_Errno.t; +val spawne = _import "MLton_Process_spawne" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_PId.t) C_Errno.t; +val spawnp = _import "MLton_Process_spawnp" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_PId.t) C_Errno.t; end structure Rlimit = struct Index: mlton/codegen/amd64-codegen/amd64-generate-transfers.fun =================================================================== --- mlton/codegen/amd64-codegen/amd64-generate-transfers.fun (revision 6242) +++ mlton/codegen/amd64-codegen/amd64-generate-transfers.fun (working copy) @@ -1218,22 +1218,35 @@ size = #2 fptrArg}), args) end + (* Cygwin/64 doesn't exist yet. Will it use ms_abi? *) + val ms_abi = + let open Control.Target + in !os = MinGW orelse !os = Cygwin end val (setup_args, (reg_args, xmmreg_args), size_stack_args, _) = List.fold (args, (AppendList.empty, ([],[]),0, - ([Register.rdi,Register.rsi,Register.rdx, - Register.rcx,Register.r8,Register.r9], - [(XmmRegister.xmm0D,XmmRegister.xmm0S), - (XmmRegister.xmm1D,XmmRegister.xmm1S), - (XmmRegister.xmm2D,XmmRegister.xmm2S), - (XmmRegister.xmm3D,XmmRegister.xmm3S), - (XmmRegister.xmm4D,XmmRegister.xmm4S), - (XmmRegister.xmm5D,XmmRegister.xmm5S), - (XmmRegister.xmm6D,XmmRegister.xmm6S), - (XmmRegister.xmm7D,XmmRegister.xmm7S)])), + (if ms_abi + then [Register.rcx,Register.rdx, + Register.r8, Register.r9] + else [Register.rdi,Register.rsi,Register.rdx, + Register.rcx,Register.r8,Register.r9], + if ms_abi + then [(XmmRegister.xmm0D,XmmRegister.xmm0S), + (XmmRegister.xmm1D,XmmRegister.xmm1S), + (XmmRegister.xmm2D,XmmRegister.xmm2S), + (XmmRegister.xmm3D,XmmRegister.xmm3S), + (XmmRegister.xmm4D,XmmRegister.xmm4S)] + else [(XmmRegister.xmm0D,XmmRegister.xmm0S), + (XmmRegister.xmm1D,XmmRegister.xmm1S), + (XmmRegister.xmm2D,XmmRegister.xmm2S), + (XmmRegister.xmm3D,XmmRegister.xmm3S), + (XmmRegister.xmm4D,XmmRegister.xmm4S), + (XmmRegister.xmm5D,XmmRegister.xmm5S), + (XmmRegister.xmm6D,XmmRegister.xmm6S), + (XmmRegister.xmm7D,XmmRegister.xmm7S)])), fn ((arg, size), (setup_args, (reg_args, xmmreg_args), Index: mlton/main/main.fun =================================================================== --- mlton/main/main.fun (revision 6242) +++ mlton/main/main.fun (working copy) @@ -850,7 +850,12 @@ fun tokenize l = String.tokens (concat (List.separate (l, " ")), Char.isSpace) - val gcc = !gcc + (* When cross-compiling, use the named cross compiler. + * Older gcc versions used -b for multiple targets. + * If this is still needed, a shell script wrapper can hide this. + *) + val gcc = case target of Cross s => s ^ "-" ^ !gcc | Self => !gcc + fun addTargetOpts opts = List.fold (!opts, [], fn ({opt, pred}, ac) => @@ -871,15 +876,6 @@ List.concat [[concat ["-L", !libTargetDir], if !debugRuntime then "-lmlton-gdb" else "-lmlton"], addTargetOpts linkOpts] - (* With gcc 3.4, the '-b ' must be the first argument. *) - val targetOpts = - case target of - Cross s => - if Cygwin = MLton.Platform.OS.host - andalso String.hasSubstring (s, {substring = "mingw"}) - then ["-mno-cygwin"] - else ["-b", s] - | Self => [] val _ = if not (hasCodegen (!codegen)) then usage (concat ["can't use ", @@ -1078,8 +1074,7 @@ System.system (gcc, List.concat - [targetOpts, - ["-o", output], + [["-o", output], if !debug then gccDebug else [], inputs, linkOpts])) @@ -1127,8 +1122,7 @@ System.system (gcc, List.concat - [targetOpts, - [ "-std=gnu99", "-c" ], + [[ "-std=gnu99", "-c" ], if !debug then debugSwitches else [], ccOpts, ["-o", output], @@ -1143,8 +1137,7 @@ System.system (gcc, List.concat - [targetOpts, - ["-c"], + [["-c"], if !debug then [asDebug] else [], asOpts, ["-o", output], Index: runtime/basis-ffi.h =================================================================== --- runtime/basis-ffi.h (revision 6242) +++ runtime/basis-ffi.h (working copy) @@ -51,8 +51,8 @@ C_Errno_t(C_Int_t) MLton_Itimer_set(C_Int_t,C_Time_t,C_SUSeconds_t,C_Time_t,C_SUSeconds_t); extern const C_Int_t MLton_Itimer_VIRTUAL; C_Errno_t(C_PId_t) MLton_Process_cwait(C_PId_t,Ref(C_Status_t)); -C_Errno_t(C_Int_t) MLton_Process_spawne(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t),String8_t,Array(C_Pointer_t),Vector(C_Size_t)); -C_Errno_t(C_Int_t) MLton_Process_spawnp(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t)); +C_Errno_t(C_PId_t) MLton_Process_spawne(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t),String8_t,Array(C_Pointer_t),Vector(C_Size_t)); +C_Errno_t(C_PId_t) MLton_Process_spawnp(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t)); extern const C_Int_t MLton_Rlimit_AS; extern const C_Int_t MLton_Rlimit_CORE; extern const C_Int_t MLton_Rlimit_CPU; Index: runtime/basis/MLton/Process/spawne.c =================================================================== --- runtime/basis/MLton/Process/spawne.c (revision 6242) +++ runtime/basis/MLton/Process/spawne.c (working copy) @@ -2,7 +2,7 @@ #if HAS_SPAWN -C_Errno_t(C_Int_t) MLton_Process_spawne (NullString8_t pNStr, +C_Errno_t(C_PId_t) MLton_Process_spawne (NullString8_t pNStr, String8_t aStr, Array(C_Pointer_t) aPtr, Vector(C_Size_t) aOff, @@ -14,7 +14,7 @@ char **env; int aLen; int eLen; - int res; + C_PId_t res; path = (const char *) pNStr; args = (char **) aPtr; @@ -38,7 +38,7 @@ #else __attribute__ ((noreturn)) -C_Errno_t(C_Int_t) MLton_Process_spawne (__attribute__ ((unused))NullString8_t pNStr, +C_Errno_t(C_PId_t) MLton_Process_spawne (__attribute__ ((unused))NullString8_t pNStr, __attribute__ ((unused))String8_t aStr, __attribute__ ((unused))Array(C_Pointer_t) aPtr, __attribute__ ((unused))Vector(C_Size_t) aOff, Index: runtime/basis/MLton/Process/spawnp.c =================================================================== --- runtime/basis/MLton/Process/spawnp.c (revision 6242) +++ runtime/basis/MLton/Process/spawnp.c (working copy) @@ -2,14 +2,14 @@ #if HAS_SPAWN -C_Errno_t(C_Int_t) MLton_Process_spawnp (NullString8_t pNStr, +C_Errno_t(C_PId_t) MLton_Process_spawnp (NullString8_t pNStr, String8_t aStr, Array(C_Pointer_t) aPtr, Vector(C_Size_t) aOff) { const char *path; char **args; int aLen; - int res; + C_PId_t res; path = (const char *) pNStr; args = (char **) aPtr; @@ -26,7 +26,7 @@ #else __attribute__ ((noreturn)) -C_Errno_t(C_Int_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t pNStr, +C_Errno_t(C_PId_t) MLton_Process_spawnp (__attribute__ ((unused)) NullString8_t pNStr, __attribute__ ((unused)) String8_t aStr, __attribute__ ((unused)) Array(C_Pointer_t) aPtr, __attribute__ ((unused)) Vector(C_Size_t) aOff) { Index: runtime/cenv.h =================================================================== --- runtime/cenv.h (revision 6242) +++ runtime/cenv.h (working copy) @@ -116,6 +116,22 @@ #error unknown platform arch #endif +/* This works on *most* platforms. Some lack (or have broken!) UINTPTR_MAX */ +#ifndef POINTER_BITS +#if UINTPTR_MAX == UINT32_MAX +#define POINTER_BITS 32 +#elif UINTPTR_MAX == UINT64_MAX +#define POINTER_BITS 64 +#else +#error Platform did not set POINTER_BITS and could not guess it. +#endif +#endif + +/* How many of the pointer bits are real address space? */ +#ifndef ADDRESS_BITS +#define ADDRESS_BITS POINTER_BITS +#endif + #include "gmp.h" COMPILE_TIME_ASSERT(sizeof_uintptr_t__is__sizeof_voidStar, Index: runtime/gc.h =================================================================== --- runtime/gc.h (revision 6242) +++ runtime/gc.h (working copy) @@ -15,19 +15,14 @@ typedef struct GC_state *GC_state; typedef GC_state GCState_t; -#if defined(__WORDSIZE) -#if __WORDSIZE == 32 +/* POINTER_BITS is set by the platform's OS header */ +#if POINTER_BITS == 32 #define GC_MODEL_NATIVE32 -#elif __WORDSIZE == 64 +#elif POINTER_BITS == 64 #define GC_MODEL_NATIVE64 #else -#error unknown __WORDSIZE +#error POINTER_BITS was not setup by cenv.h #endif -#elif defined(__LP64__) -#define GC_MODEL_NATIVE64 -#else -#define GC_MODEL_NATIVE32 -#endif #include "gc/debug.h" Index: runtime/gc/heap.c =================================================================== --- runtime/gc/heap.c (revision 6242) +++ runtime/gc/heap.c (working copy) @@ -171,7 +171,12 @@ for (h->size = desiredSize; h->size >= minSize; h->size -= backoff) { const unsigned int countLog2 = 5; const unsigned int count = 0x1 << countLog2; - const size_t step = (size_t)0x1 << ((POINTER_SIZE * CHAR_BIT) - countLog2); + const size_t step = (size_t)0x1 << (ADDRESS_BITS - countLog2); +#if ADDRESS_BITS == POINTER_BITS + const size_t address_end = 0; +#else + const size_t address_end = (size_t)0x1 << ADDRESS_BITS; +#endif static bool direction = TRUE; unsigned int i; @@ -180,9 +185,15 @@ for (i = 1; i <= count; i++) { size_t address; + /* The last step, no matter the direction uses address == 0. + * This is important so that mmapAnon can find free space itself. + */ address = (size_t)i * step; if (direction) - address = (size_t)0x0 - address; + address = address_end - address; + else if (address == address_end) + address = 0; + h->start = GC_mmapAnon ((pointer)address, h->size); if ((void*)-1 == h->start) h->start = (void*)NULL; Index: runtime/gc/init.c =================================================================== --- runtime/gc/init.c (revision 6242) +++ runtime/gc/init.c (working copy) @@ -116,11 +116,7 @@ s->controls.messages = TRUE; } else if (0 == strcmp (arg, "gc-summary")) { i++; -#if (defined (__MINGW32__)) - fprintf (stderr, "Warning: MinGW doesn't support gc-summary.\n"); -#else s->controls.summary = TRUE; -#endif } else if (0 == strcmp (arg, "grow-ratio")) { i++; if (i == argc) Index: runtime/gen/basis-ffi.def =================================================================== --- runtime/gen/basis-ffi.def (revision 6242) +++ runtime/gen/basis-ffi.def (working copy) @@ -43,8 +43,8 @@ MLton.Itimer.VIRTUAL = _const : C_Int.t MLton.Itimer.set = _import : C_Int.t * C_Time.t * C_SUSeconds.t * C_Time.t * C_SUSeconds.t -> C_Int.t C_Errno.t MLton.Process.cwait = _import : C_PId.t * C_Status.t ref -> C_PId.t C_Errno.t -MLton.Process.spawne = _import : NullString8.t * String8.t * C_Pointer.t array * C_Size.t vector * String8.t * C_Pointer.t array * C_Size.t vector -> C_Int.t C_Errno.t -MLton.Process.spawnp = _import : NullString8.t * String8.t * C_Pointer.t array * C_Size.t vector -> C_Int.t C_Errno.t +MLton.Process.spawne = _import : NullString8.t * String8.t * C_Pointer.t array * C_Size.t vector * String8.t * C_Pointer.t array * C_Size.t vector -> C_PId.t C_Errno.t +MLton.Process.spawnp = _import : NullString8.t * String8.t * C_Pointer.t array * C_Size.t vector -> C_PId.t C_Errno.t MLton.Rlimit.AS = _const : C_Int.t MLton.Rlimit.CORE = _const : C_Int.t MLton.Rlimit.CPU = _const : C_Int.t Index: runtime/gen/basis-ffi.h =================================================================== --- runtime/gen/basis-ffi.h (revision 6242) +++ runtime/gen/basis-ffi.h (working copy) @@ -51,8 +51,8 @@ C_Errno_t(C_Int_t) MLton_Itimer_set(C_Int_t,C_Time_t,C_SUSeconds_t,C_Time_t,C_SUSeconds_t); extern const C_Int_t MLton_Itimer_VIRTUAL; C_Errno_t(C_PId_t) MLton_Process_cwait(C_PId_t,Ref(C_Status_t)); -C_Errno_t(C_Int_t) MLton_Process_spawne(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t),String8_t,Array(C_Pointer_t),Vector(C_Size_t)); -C_Errno_t(C_Int_t) MLton_Process_spawnp(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t)); +C_Errno_t(C_PId_t) MLton_Process_spawne(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t),String8_t,Array(C_Pointer_t),Vector(C_Size_t)); +C_Errno_t(C_PId_t) MLton_Process_spawnp(NullString8_t,String8_t,Array(C_Pointer_t),Vector(C_Size_t)); extern const C_Int_t MLton_Rlimit_AS; extern const C_Int_t MLton_Rlimit_CORE; extern const C_Int_t MLton_Rlimit_CPU; Index: runtime/gen/basis-ffi.sml =================================================================== --- runtime/gen/basis-ffi.sml (revision 6242) +++ runtime/gen/basis-ffi.sml (working copy) @@ -80,8 +80,8 @@ structure Process = struct val cwait = _import "MLton_Process_cwait" : C_PId.t * (C_Status.t) ref -> (C_PId.t) C_Errno.t; -val spawne = _import "MLton_Process_spawne" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_Int.t) C_Errno.t; -val spawnp = _import "MLton_Process_spawnp" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_Int.t) C_Errno.t; +val spawne = _import "MLton_Process_spawne" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_PId.t) C_Errno.t; +val spawnp = _import "MLton_Process_spawnp" : NullString8.t * String8.t * (C_Pointer.t) array * (C_Size.t) vector -> (C_PId.t) C_Errno.t; end structure Rlimit = struct Index: runtime/gen/gen-sizes.c =================================================================== --- runtime/gen/gen-sizes.c (revision 6242) +++ runtime/gen/gen-sizes.c (working copy) @@ -13,8 +13,12 @@ __attribute__ ((unused)) char* argv[]) { FILE *sizesFd; + /* Just to be sure we don't break objptr */ + assert (sizeof(void*)*8 == POINTER_BITS); + assert (ADDRESS_BITS <= POINTER_BITS); + sizesFd = fopen_safe ("sizes", "w"); - + fprintf (sizesFd, "cint = %"PRIuMAX"\n", (uintmax_t)sizeof(C_Int_t)); fprintf (sizesFd, "cpointer = %"PRIuMAX"\n", (uintmax_t)sizeof(C_Pointer_t)); fprintf (sizesFd, "cptrdiff = %"PRIuMAX"\n", (uintmax_t)sizeof(C_Ptrdiff_t)); Index: runtime/Makefile =================================================================== --- runtime/Makefile (revision 6242) +++ runtime/Makefile (working copy) @@ -9,13 +9,24 @@ PATH := ../bin:$(shell echo $$PATH) TARGET := self + +ifeq ($(TARGET), self) +CC := gcc -std=gnu99 +AR := ar rc +RANLIB := ranlib +else +CC := $(TARGET)-gcc -std=gnu99 +AR := $(TARGET)-ar rc +RANLIB := $(TARGET)-ranlib +endif + TARGET_ARCH := $(shell ../bin/host-arch) TARGET_OS := $(shell ../bin/host-os) GCC_MAJOR_VERSION := \ - $(shell gcc -v 2>&1 | grep 'gcc version' | \ + $(shell $(CC) -v 2>&1 | grep 'gcc version' | \ sed 's/.*gcc version \([0-9][0-9]*\)\.\([0-9][0-9]*\).*/\1/') GCC_MINOR_VERSION := \ - $(shell gcc -v 2>&1 | grep 'gcc version' | \ + $(shell $(CC) -v 2>&1 | grep 'gcc version' | \ sed 's/.*gcc version \([0-9][0-9]*\)\.\([0-9][0-9]*\).*/\2/') GCC_VERSION := $(GCC_MAJOR_VERSION).$(GCC_MINOR_VERSION) @@ -90,16 +101,6 @@ FLAGS += -funroll-all-loops endif -ifeq ($(TARGET), self) -AR := ar rc -RANLIB := ranlib -else -AR := $(TARGET)-ar rc -RANLIB := $(TARGET)-ranlib -FLAGS += -b $(TARGET) -endif - -CC := gcc -std=gnu99 CPPFLAGS := CFLAGS := -I. -Iplatform $(FLAGS) OPTCFLAGS := $(CFLAGS) $(CPPFLAGS) $(OPTFLAGS) Index: runtime/platform/amd64.h =================================================================== --- runtime/platform/amd64.h (revision 6242) +++ runtime/platform/amd64.h (working copy) @@ -1 +1,3 @@ #define MLton_Platform_Arch_host "amd64" +#define ADDRESS_BITS 43 +/* Only 43 of the bits are left to userland */ Index: runtime/platform/mingw.c =================================================================== --- runtime/platform/mingw.c (revision 6242) +++ runtime/platform/mingw.c (working copy) @@ -8,6 +8,10 @@ Windows_decommit (base, length); } +void *GC_mremap (void *base, size_t old, size_t new) { + return Windows_mremap (base, old, new); +} + void *GC_mmapAnon (void *start, size_t length) { return Windows_mmapAnon (start, length); } @@ -18,11 +22,17 @@ } uintmax_t GC_physMem (void) { +#ifdef _WIN64 + MEMORYSTATUSEX memstat; + memstat.dwLength = sizeof(memstat); + GlobalMemoryStatusEx(&memstat); + return (uintmax_t)memstat.ullTotalPhys; +#else MEMORYSTATUS memstat; - memstat.dwLength = sizeof(memstat); GlobalMemoryStatus(&memstat); return (uintmax_t)memstat.dwTotalPhys; +#endif } size_t GC_pageSize (void) { @@ -33,7 +43,7 @@ HANDLE fileDesHandle (int fd) { // The temporary prevents a "cast does not match function type" warning. - long t; + intptr_t t; t = _get_osfhandle (fd); return (HANDLE)t; @@ -66,7 +76,8 @@ /* Based on notes by Wu Yongwei: * http://mywebpage.netscape.com/yongweiwutime.htm */ -int gettimeofday (struct timeval *tv, struct timezone *tz) { +int mlton_gettimeofday (struct timeval *tv, + __attribute__ ((unused)) struct timezone *tz) { FILETIME ft; LARGE_INTEGER li; __int64 t; @@ -150,29 +161,50 @@ /* GetProcessTimes and GetSystemTimeAsFileTime are documented at: * http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/getprocesstimes.asp - * http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getsystemtimeasfiletime.asp */ -int getrusage (__attribute__ ((unused)) int who, struct rusage *usage) { - FILETIME ct, et, kt, ut; - LARGE_INTEGER li, lj; - if (GetProcessTimes(GetCurrentProcess(), &ct, &et, &kt, &ut)) { - usage->ru_utime.tv_sec = ut.dwHighDateTime; - usage->ru_utime.tv_usec = ut.dwLowDateTime/10; - usage->ru_stime.tv_sec = kt.dwHighDateTime; - usage->ru_stime.tv_usec = kt.dwLowDateTime/10; +int getrusage (int who, struct rusage *usage) { + /* FILETIME has dw{High,Low}DateTime which store the number of + * 100-nanoseconds since January 1, 1601 + */ + FILETIME creation_time; + FILETIME exit_time; + FILETIME kernel_time; + FILETIME user_time; + + uint64_t user_usecs, kernel_usecs; + + if (who == RUSAGE_CHILDREN) { + // !!! could use exit_time - creation_time from cwait + memset(usage, 0, sizeof(struct rusage)); return 0; } - /* if GetProcessTimes failed, use real time [for Windows] */ - GetSystemTimeAsFileTime(&ut); - li.LowPart = ut.dwLowDateTime; - li.HighPart = ut.dwHighDateTime; - lj.LowPart = Time_sec; - lj.HighPart = Time_usec; - li.QuadPart -= lj.QuadPart; - usage->ru_utime.tv_sec = li.HighPart; - usage->ru_utime.tv_usec = li.LowPart/10; - usage->ru_stime.tv_sec = 0; - usage->ru_stime.tv_usec = 0; + + if (who != RUSAGE_SELF) { + errno = EINVAL; + return -1; + } + + if (GetProcessTimes(GetCurrentProcess(), + &creation_time, &exit_time, + &kernel_time, &user_time) == 0) { + errno = EFAULT; + return -1; + } + + kernel_usecs = kernel_time.dwHighDateTime; + kernel_usecs <<= sizeof(kernel_time.dwHighDateTime)*8; + kernel_usecs |= kernel_time.dwLowDateTime; + kernel_usecs /= 10; + + user_usecs = user_time.dwHighDateTime; + user_usecs <<= sizeof(user_time.dwHighDateTime)*8; + user_usecs |= user_time.dwLowDateTime; + user_usecs /= 10; + + usage->ru_utime.tv_sec = user_usecs / 1000000; + usage->ru_utime.tv_usec = user_usecs % 1000000; + usage->ru_stime.tv_sec = kernel_usecs / 1000000; + usage->ru_stime.tv_usec = kernel_usecs % 1000000; return 0; } @@ -195,7 +227,7 @@ HANDLE fh, fhmap; DWORD fileSize, fileSizeHi; void* pMem = NULL; - long tmp; + intptr_t tmp; tmp = _get_osfhandle (fd); fh = (HANDLE)tmp; @@ -331,8 +363,8 @@ /* This requires Win98+ * Choosing text/binary mode is defered till a later setbin/text call */ - filedes[0] = _open_osfhandle((long)read_h, _O_RDONLY); - filedes[1] = _open_osfhandle((long)write_h, _O_WRONLY); + filedes[0] = _open_osfhandle((intptr_t)read_h, _O_RDONLY); + filedes[1] = _open_osfhandle((intptr_t)write_h, _O_WRONLY); if (filedes[0] == -1 or filedes[1] == -1) { if (filedes[0] == -1) CloseHandle(read_h); @@ -474,14 +506,15 @@ if (level > 6) level = 6; platform = "i%d86"; break; - case PROCESSOR_ARCHITECTURE_IA64: platform = "ia64"; break; -#ifndef PROCESSOR_ARCHITECTURE_AMD64 -#define PROCESSOR_ARCHITECTURE_AMD64 9 -#endif - case PROCESSOR_ARCHITECTURE_AMD64: platform = "amd64"; break; - - case PROCESSOR_ARCHITECTURE_ALPHA: platform = "alpha"; break; - case PROCESSOR_ARCHITECTURE_MIPS: platform = "mips"; break; + case PROCESSOR_ARCHITECTURE_IA64: platform = "ia64"; break; + case PROCESSOR_ARCHITECTURE_AMD64: platform = "amd64"; break; + case PROCESSOR_ARCHITECTURE_PPC: platform = "ppc"; break; + case PROCESSOR_ARCHITECTURE_ALPHA: platform = "alpha"; break; + case PROCESSOR_ARCHITECTURE_MIPS: platform = "mips"; break; + case PROCESSOR_ARCHITECTURE_ARM: platform = "arm"; break; + case PROCESSOR_ARCHITECTURE_ALPHA64: platform = "alpha64"; break; + /* SHX? MSIL? IA32_ON_WIN64? */ + default: platform = "unknown"; break; } sprintf (buf->machine, platform, level); } @@ -510,6 +543,9 @@ case VER_PLATFORM_WIN32s: os = "31"; /* aka DOS + Windows 3.1 */ break; + default: + os = "unknown"; + break; } sprintf (buf->sysname, "MINGW32_%s-%d.%d", os, (int)osv.dwMajorVersion, (int)osv.dwMinorVersion); @@ -520,9 +556,9 @@ unless (0 == gethostname (buf->nodename, sizeof (buf->nodename))) { strcpy (buf->nodename, "unknown"); } - sprintf (buf->release, "%d", __MINGW32_MINOR_VERSION); + sprintf (buf->release, "%d", 0); //__MINGW32_MINOR_VERSION); setSysname (buf); - sprintf (buf->version, "%d", __MINGW32_MAJOR_VERSION); + sprintf (buf->version, "%d", 0); //__MINGW32_MAJOR_VERSION); return 0; } @@ -580,7 +616,7 @@ } __attribute__ ((noreturn)) -pid_t fork (void) { +int fork (void) { die ("fork not implemented"); } @@ -882,7 +918,7 @@ die ("socketpair not implemented"); } -void MLton_initSockets () { +void MLton_initSockets (void) { static Bool isInitialized = FALSE; WORD version; WSADATA wsaData; @@ -1000,7 +1036,7 @@ } { - void* result = GetProcAddress(hmodule, symbol); + void* result = (void*)GetProcAddress(hmodule, symbol); if (!result) dlerror_last = GetLastError(); @@ -1030,5 +1066,5 @@ /* ------------------------------------------------- */ C_Size_t MinGW_getTempPath(C_Size_t buf_size, Array(Char8_t) buf) { - return GetTempPath(buf_size, buf); + return GetTempPath(buf_size, (char*)buf); } Index: runtime/platform/mingw.h =================================================================== --- runtime/platform/mingw.h (revision 6242) +++ runtime/platform/mingw.h (working copy) @@ -24,6 +24,13 @@ #include #undef max +// MinGW/win64 has broken UINTPTR_MAX! +#ifdef _WIN64 +#define POINTER_BITS 64 +#else +#define POINTER_BITS 32 +#endif + #define HAS_FEROUND TRUE // As of 20051104, MinGW has fpclassify, but it is broken. In particular, it // classifies subnormals as normals. So, we disable it here, which causes the @@ -32,7 +39,7 @@ #define HAS_FPCLASSIFY32 FALSE #define HAS_FPCLASSIFY64 FALSE #define HAS_MSG_DONTWAIT TRUE -#define HAS_REMAP FALSE +#define HAS_REMAP TRUE #define HAS_SIGALTSTACK FALSE #define HAS_SIGNBIT TRUE #define HAS_SPAWN TRUE @@ -88,13 +95,12 @@ /* Date */ /* ------------------------------------------------- */ -struct timezone { - int tz_dsttime; - int tz_minuteswest; -}; +/* MinGW provides gettimeofday in -lmingwex, which we don't link. + * In order to avoid a name conflict, we use a different name. + */ +int mlton_gettimeofday (struct timeval *tv, struct timezone *tz); +#define gettimeofday mlton_gettimeofday -int gettimeofday (struct timeval *tv, struct timezone *tz); - /* ------------------------------------------------- */ /* MLton.Itimer */ /* ------------------------------------------------- */ @@ -207,6 +213,10 @@ #define S_ISLNK(m) (m?FALSE:FALSE) #define S_ISSOCK(m) (m?FALSE:FALSE) +#ifndef O_ACCMODE +#define O_ACCMODE O_RDONLY|O_WRONLY|O_RDWR +#endif + int chown (const char *path, uid_t owner, gid_t group); int fchmod (int filedes, mode_t mode); int fchdir (int filedes); @@ -314,14 +324,18 @@ #define WTERMSIG(w) ((w) & 0x7f) #define WSTOPSIG WEXITSTATUS +/* Sometimes defined by mingw */ +#ifndef TIMESPEC_DEFINED +struct timespec { + time_t tv_sec; + long tv_nsec; +}; +#endif + int alarm (int secs); -pid_t fork (void); +int fork(void); /* mingw demands this return int */ int kill (pid_t pid, int sig); int pause (void); -struct timespec { - time_t tv_sec; - long tv_nsec; -}; int nanosleep (const struct timespec *req, struct timespec *rem); unsigned int sleep (unsigned int seconds); pid_t wait (int *status); @@ -335,26 +349,64 @@ #define SIG_SETMASK 0 #define SIG_UNBLOCK 2 +/* Sometimes mingw defines some of these. Some not. Some always. */ + +#ifndef SIGHUP #define SIGHUP 1 -#define SIGKILL 2 -#define SIGPIPE 3 -#define SIGQUIT 9 -#define SIGALRM 13 -#define SIGBUS 14 +#endif + +/* SIGINT = 2 */ + +#ifndef SIGQUIT +#define SIGQUIT 3 +#endif + +/* SIGILL = 4 */ +/* SIGTRAP = 5 (unused) */ +/* SIGIOT = 6 (unused) */ +/* SIGABRT = 6 (unused) */ +/* SIGEMT = 7 (unused) */ +/* SIGFPE = 8 */ + +#ifndef SIGKILL +#define SIGKILL 9 +#endif + +#ifndef SIGBUS +#define SIGBUS 10 +#endif + +/* SIGSEGV = 11 */ +/* SIGSYS = 12 (unused) */ + +#ifndef SIGPIPE +#define SIGPIPE 13 +#endif + +#ifndef SIGALRM +#define SIGALRM 14 +#endif + +/* SIGTERM = 15 */ +/* SIGBREAK = 21 */ +/* SIGABRT2 = 22 */ + +/* These signals are fake. They do not exist on windows. */ #define SIGSTOP 16 #define SIGTSTP 18 -#define SIGCHLD 20 -#define SIGTTIN 21 -#define SIGTTOU 22 -#define SIGCONT 25 -#define SIGUSR1 25 -#define SIGUSR2 26 -#define SIGVTALRM 26 /* virtual time alarm */ -#define SIGPROF 27 /* profiling time alarm */ +#define SIGCHLD 23 +#define SIGTTIN 24 +#define SIGTTOU 25 +#define SIGCONT 26 +#define SIGUSR1 27 +#define SIGUSR2 28 +#define SIGVTALRM 29 /* virtual time alarm */ +#define SIGPROF 30 /* profiling time alarm */ #define _NSIG 32 typedef __p_sig_fn_t _sig_func_ptr; +typedef int sigset_t; /* sometimes defined my mingw as int */ struct sigaction { int sa_flags; @@ -529,8 +581,10 @@ /* ------------------------------------------------- */ // Unimplemented on windows: +#ifndef MSG_WAITALL +#define MSG_WAITALL 0x8 +#endif #define MSG_DONTWAIT 0 -#define MSG_WAITALL 0 #define MSG_EOR 0 #define MSG_CTRUNC 0 Index: runtime/platform/windows.c =================================================================== --- runtime/platform/windows.c (revision 6242) +++ runtime/platform/windows.c (working copy) @@ -1,6 +1,7 @@ HANDLE fileDesHandle (int fd); -#define BUFSIZE 65536 +/* As crazy as it is, this breaks Windows 2003&Vista: #define BUFSIZE 65536 */ +#define BUFSIZE 10240 static HANDLE tempFileDes (void) { /* Based on http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/creating_and_using_a_temporary_file.asp @@ -13,11 +14,12 @@ char lpPathBuffer[BUFSIZE]; dwRetVal = GetTempPath(dwBufSize, lpPathBuffer); - if (dwRetVal > dwBufSize) + if (dwRetVal >= dwBufSize) die ("GetTempPath failed with error %ld\n", GetLastError()); uRetVal = GetTempFileName(lpPathBuffer, "TempFile", 0, szTempName); if (0 == uRetVal) - die ("GetTempFileName failed with error %ld\n", GetLastError()); + die ("GetTempFileName in %s failed with error %ld\n", + lpPathBuffer, GetLastError()); hTempFile = CreateFile((LPTSTR) szTempName, GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_NEW, FILE_ATTRIBUTE_NORMAL | FILE_FLAG_DELETE_ON_CLOSE, NULL); @@ -67,12 +69,18 @@ static void displayMaps (void) { MEMORY_BASIC_INFORMATION buf; - LPVOID lpAddress; const char *state = ""; const char *protect = ""; + uintptr_t address; - for (lpAddress = 0; lpAddress < (LPCVOID)0x80000000; ) { - VirtualQuery (lpAddress, &buf, sizeof (buf)); + buf.RegionSize = 0; + for (address = 0; + address + buf.RegionSize >= address; + address += buf.RegionSize) { + if (0 == VirtualQuery ((LPCVOID)address, &buf, sizeof (buf))) + break; + if (0 == buf.RegionSize) + break; switch (buf.Protect) { case PAGE_READONLY: @@ -121,26 +129,49 @@ default: assert (FALSE); } - fprintf(stderr, "0x%8x %10u %s %s\n", - (unsigned int)buf.BaseAddress, - (unsigned int)buf.RegionSize, + + fprintf(stderr, FMTPTR " %10"PRIuMAX" %s %s\n", + buf.BaseAddress, (uintmax_t)buf.RegionSize, state, protect); - lpAddress = (unsigned char*)lpAddress + buf.RegionSize; } } void GC_displayMem (void) { - MEMORYSTATUS ms; +#ifdef _WIN64 + MEMORYSTATUSEX ms; + ms.dwLength = sizeof (MEMORYSTATUSEX); + GlobalMemoryStatusEx (&ms); - ms.dwLength = sizeof (MEMORYSTATUS); - GlobalMemoryStatus (&ms); - fprintf(stderr, "Total Phys. Mem: %ld\nAvail Phys. Mem: %ld\nTotal Page File: %ld\nAvail Page File: %ld\nTotal Virtual: %ld\nAvail Virtual: %ld\n", - ms.dwTotalPhys, - ms.dwAvailPhys, - ms.dwTotalPageFile, - ms.dwAvailPageFile, - ms.dwTotalVirtual, - ms.dwAvailVirtual); + fprintf(stderr, "Total Phys. Mem: %"PRIuMAX"\n" + "Avail Phys. Mem: %"PRIuMAX"\n" + "Total Page File: %"PRIuMAX"\n" + "Avail Page File: %"PRIuMAX"\n" + "Total Virtual: %"PRIuMAX"\n" + "Avail Virtual: %"PRIuMAX"\n", + (uintmax_t)ms.ullTotalPhys, + (uintmax_t)ms.ullAvailPhys, + (uintmax_t)ms.ullTotalPageFile, + (uintmax_t)ms.ullAvailPageFile, + (uintmax_t)ms.ullTotalVirtual, + (uintmax_t)ms.ullAvailVirtual); +#else + MEMORYSTATUS ms; + ms.dwLength = sizeof (MEMORYSTATUS); + GlobalMemoryStatus (&ms); + + fprintf(stderr, "Total Phys. Mem: %"PRIuMAX"\n" + "Avail Phys. Mem: %"PRIuMAX"\n" + "Total Page File: %"PRIuMAX"\n" + "Avail Page File: %"PRIuMAX"\n" + "Total Virtual: %"PRIuMAX"\n" + "Avail Virtual: %"PRIuMAX"\n", + (uintmax_t)ms.dwTotalPhys, + (uintmax_t)ms.dwAvailPhys, + (uintmax_t)ms.dwTotalPageFile, + (uintmax_t)ms.dwAvailPageFile, + (uintmax_t)ms.dwTotalVirtual, + (uintmax_t)ms.dwAvailVirtual); +#endif displayMaps (); } @@ -176,16 +207,64 @@ die ("VirtualFree decommit failed"); } -static inline void *Windows_mmapAnon (__attribute__ ((unused)) void *start, - size_t length) { +static inline void *Windows_mremap (void *base, size_t old, size_t new) { void *res; + void *tail; - /* Use "0" instead of "start" as the first argument to VirtualAlloc - * because it is more stable on MinGW (at least). + /* Attempt to recover decommit'd memory */ + tail = (void*)((intptr_t)base + old); + res = VirtualAlloc(tail, new - old, MEM_COMMIT, PAGE_READWRITE); + if (NULL == res) + return (void*)-1; + + return base; +} + +static inline void *Windows_mmapAnon (void *start, size_t length) { + void *res; + size_t reserve; + + /* If length > 256MB on win32, we round up to the nearest 512MB. + * By reserving more than we need, we can later mremap to use it. + * This avoids fragmentation on 32 bit machines, near the 2GB limit. + * It doesn't hurt us in 64 bit mode either (lots of address space). */ - res = VirtualAlloc ((LPVOID)0/*start*/, length, MEM_COMMIT, PAGE_READWRITE); + if (length > 268435456) + reserve = (length + 536870912) & 0xE0000000; + else reserve = length; + + /* We prevoiusly used "0" instead of start, which lead to crashes. + * After reading win32 documentation, the reason for these crashes + * becomes clear: we were using only MEM_COMMIT! If there was memory + * decommitted in a previous heap shrink, a new heap might end up + * inside the reserved (but uncommitted) memory. When the old heap is + * freed, it will kill the new heap as well. This bug will not happen + * now because we reserve, then commit. Reserved memory cannot conflict. + */ + res = VirtualAlloc (start, reserve, MEM_RESERVE, PAGE_NOACCESS); + + /* Try shifting the block left (to play well with MLton's scan) */ + if (NULL == res) { + uintptr_t base = (uintptr_t)start; + size_t shift = reserve - length; + if (base > shift) + res = VirtualAlloc ((void*)(base-shift), reserve, + MEM_RESERVE, PAGE_NOACCESS); + } + + /* Fall back to zero reserved allocation */ if (NULL == res) - res = (void*)-1; + res = VirtualAlloc (start, length, MEM_RESERVE, PAGE_NOACCESS); + + /* Nothing more we can try at this offset */ + if (NULL == res) + return (void*)-1; + + /* Actually get the memory for use */ + res = VirtualAlloc (res, length, MEM_COMMIT, PAGE_READWRITE); + if (NULL == res) + die("VirtualAlloc MEM_COMMIT of MEM_RESERVEd memory failed!\n"); + return res; } @@ -200,7 +279,7 @@ char *cmd; char *arg; char *env; - int result; + C_PId_t result; STARTUPINFO si; PROCESS_INFORMATION proc; @@ -243,7 +322,7 @@ * The thread handle is not needed, so clean it. */ CloseHandle (proc.hThread); - result = (int)proc.hProcess; + result = (C_PId_t)proc.hProcess; } CloseHandle (si.hStdInput); CloseHandle (si.hStdOutput); Index: runtime/util/pointer.h =================================================================== --- runtime/util/pointer.h (revision 6242) +++ runtime/util/pointer.h (working copy) @@ -11,19 +11,17 @@ typedef unsigned char pointerAux __attribute__ ((aligned (4), may_alias)); typedef pointerAux* pointer; -#define POINTER_SIZE sizeof(pointer) -#if defined(__WORDSIZE) -#if __WORDSIZE == 32 +#if POINTER_BITS == 32 #define FMTPTR "0x%08"PRIxPTR -#elif __WORDSIZE == 64 -#define FMTPTR "0x%016"PRIxPTR +#elif POINTER_BITS == 64 +#ifdef _WIN64 +/* Gotta love those buggy headers */ +#define FMTPTR "0x%016"PRIx64 #else -#error __WORDSIZE unknown -#endif -#elif defined(__LP64__) #define FMTPTR "0x%016"PRIxPTR +#endif #else -#define FMTPTR "0x%08"PRIxPTR +#error POINTER_BITS not configured #endif typedef const unsigned char* code_pointer;