[MLton-commit] r6406
Matthew Fluet
fluet at mlton.org
Thu Feb 14 12:10:56 PST 2008
Integrate Wesley Teprstra's mingw updates patch:
My previous email explained why the memory management routines for MinGW were broken;
see it for an explanation of how this caused the out-of-memory bugs and random crashes
when a fixed heap location is used.
Some MinGW builds have a symbol gettimeofday, this patch moves our implementation out
of the way and continues to use it rather than the symbol exported in an extended
mingw library. Ours works for our needs.
I re-implemented getrusage. As this now works, gc-summary also works and was enabled.
A couple points in this file assumed sizeof(long) >= sizeof(void*). These were
corrected.
I added more platforms to the uname code now that MinGW supports them.
Several headers in MinGW have been changed since the code was last touched. I adjusted
timespec and the signals to deal with the least common denominator.
I also modified the display maps method to work with 64 bit pointers.
Only minor changes from the original patch.
----------------------------------------------------------------------
U mlton/trunk/runtime/gc/init.c
U mlton/trunk/runtime/platform/mingw.c
U mlton/trunk/runtime/platform/mingw.h
U mlton/trunk/runtime/platform/windows.c
----------------------------------------------------------------------
Modified: mlton/trunk/runtime/gc/init.c
===================================================================
--- mlton/trunk/runtime/gc/init.c 2008-02-14 19:49:03 UTC (rev 6405)
+++ mlton/trunk/runtime/gc/init.c 2008-02-14 20:10:55 UTC (rev 6406)
@@ -114,11 +114,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)
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2008-02-14 19:49:03 UTC (rev 6405)
+++ mlton/trunk/runtime/platform/mingw.c 2008-02-14 20:10:55 UTC (rev 6406)
@@ -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);
}
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2008-02-14 19:49:03 UTC (rev 6405)
+++ mlton/trunk/runtime/platform/mingw.h 2008-02-14 20:10:55 UTC (rev 6406)
@@ -32,7 +32,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 +88,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 +206,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 +317,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 +342,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 +574,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
Modified: mlton/trunk/runtime/platform/windows.c
===================================================================
--- mlton/trunk/runtime/platform/windows.c 2008-02-14 19:49:03 UTC (rev 6405)
+++ mlton/trunk/runtime/platform/windows.c 2008-02-14 20:10:55 UTC (rev 6406)
@@ -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 = "<unset>";
const char *protect = "<unset>";
+ 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 > ((size_t)1 << 28))
+ reserve = align (length, ((size_t)1 << 29));
+ 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);
More information about the MLton-commit
mailing list