[MLton] Patch to build MLton on MinGW

[Vesa Karvonen]

Below is the patch I'm currently using to build MLton on MinGW.

The patch implements the dl* functions so that mlnlffi lib links.

The patch replaces the use of dl* functions to import malloc and
free with MLton FFI code to import the functions.

The semantics of dlopen(NULL, /*...*/) seem difficult to emulate.
The below patch just returns GetModuleHandle(NULL), so that the
code in the mlnlffi lib accessing the main module will run without
errors.  I don't know whether the handle returned is actually
useful for much anything.

AFAICS, the below dl* implementation should provide minimal support
for loading Windows DLLs if/when mlnlffigen is extended to support
them and calling convention specifiers.

-Vesa Karvonen

Index: runtime/platform/mingw.c
===================================================================
--- runtime/platform/mingw.c	(revision 4860)
+++ runtime/platform/mingw.c	(working copy)
@@ -748,3 +748,84 @@
                 WSAStartup (version, &wsaData);
         }
 }
+
+/* ------------------------------------------------- */
+/*                      libdl                        */
+/* ------------------------------------------------- */
+
+static DWORD dlerror_last = ERROR_SUCCESS;
+/* This is for emulating the ugly stateful behavior of dlerror. */
+
+static HMODULE dl_main_module = NULL;
+
+void *dlopen(const char *filename, int flag_IGNORED) {
+  if (!filename) {
+    if (!dl_main_module)
+      dl_main_module = GetModuleHandle(NULL);
+
+    if (!dl_main_module)
+      dlerror_last = GetLastError();
+
+    return dl_main_module;
+  }
+
+  { HMODULE result = LoadLibrary(filename);
+
+    if (!result)
+      dlerror_last = GetLastError();
+
+    return result;
+  }
+}
+
+const char *dlerror(void) {
+  if (ERROR_SUCCESS == dlerror_last) {
+    return NULL;
+  } else {
+    static char buffer[256];
+
+    if (!FormatMessage(FORMAT_MESSAGE_IGNORE_INSERTS |
+                       FORMAT_MESSAGE_FROM_SYSTEM,
+                       NULL, dlerror_last, 0,
+                       buffer, sizeof(buffer),
+                       NULL))
+      snprintf(buffer, sizeof(buffer),
+               "Failed to format error message");
+
+    dlerror_last = ERROR_SUCCESS;
+
+    return buffer;
+  }
+}
+
+void *dlsym(void *void_hmodule, const char *symbol) {
+  HMODULE hmodule = void_hmodule;
+
+  if (!hmodule) {
+    dlerror_last = ERROR_INVALID_HANDLE;
+    return NULL;
+  }
+
+  { void* result = GetProcAddress(hmodule, symbol);
+
+    if (!result)
+      dlerror_last = GetLastError();
+
+    return result;
+  }
+}
+
+int dlclose(void *void_hmodule) {
+  HMODULE hmodule = void_hmodule;
+
+  if (!hmodule || hmodule == dl_main_module)
+    return 0;
+
+  { int result = !FreeLibrary(hmodule);
+
+    if (result)
+      dlerror_last = GetLastError();
+
+    return result;
+  }
+}
Index: lib/mlnlffi/memory/memalloc-a4-unix.sml
===================================================================
--- lib/mlnlffi/memory/memalloc-a4-unix.sml	(revision 4860)
+++ lib/mlnlffi/memory/memalloc-a4-unix.sml	(working copy)
@@ -20,7 +20,7 @@
 
     type addr = Ptr.t
     type addr' = addr
-
+(*
     structure DL = DynLinkage
 
     fun main's s = DL.lib_symbol (DL.main_lib, s)
@@ -37,8 +37,8 @@
         let val p_u = _import * : MLton.Pointer.t -> addr -> unit;
         in p_u (DL.addr free_h) a
         end
+*)
 
-(*
     fun sys_malloc (n : Word32.word) = 
         let val w_p = _import "malloc" : Word32.word -> addr;
             val a = w_p n
@@ -49,8 +49,8 @@
         let val p_u = _import "free" : addr -> unit;
         in p_u a
         end
-*)
 
+
     fun alloc bytes = sys_malloc bytes
     fun free a = sys_free a
 end