[MLton] Re: MLNLFFI doesn't link on MinGW(?)

[Vesa Karvonen]

Quoting Bernard Berthomieu <Bernard.Berthomieu at laas.fr>:
> Vesa wrote:
> 
> > Next I'm going to try to implement the 4 dl* functions that the MLNLFFI
> > library requires using the Windows API.
> 
> A simple version can be found at the url below, that defines
> dlopen/dlsym/dlclose as macros (search dlfcn_win32.h in the page):
>     
> http://sourceforge.net/mailarchive/forum.php?forum_id=5123&max_rows=25&style=nested&viewmonth=200303
> 
> The code is easily adapted to define dlopen/dlsym/dlclose as
> functions, suitable for the DynLink structure of mlton.

Yes, I already wrote something earlier, but I can see no easy
way to support the dlopen(NULL, ...) functionality for accessing
the "main program".  Symbols like malloc and free aren't just
directly accessible from the module returned by
GetModuleHandle(NULL), for example.

The code I wrote is below.  It might make sense to add it to
MLton's runtime/platform/mingw.c.  Doing so would allow mlnlffi
to link on MinGW.  It should also allow one to access Windows
DLLs.  *But*, in order to access Windows DLLs, you need to be
aware of calling conventions, which is something that MLton's
mlnlffigen doesn't currently handle.  Also, adding the below code
to the runtime doesn't fix the problem that malloc and free can
not be found.

<--->
#include <Windows.h>
#include <stdio.h>
#include "libdl.h"

static DWORD dlerror_last = ERROR_SUCCESS;
/* This is for emulating the ugly stateful behavior of dlerror. */

void *dlopen(const char *filename, int flag_IGNORED) {
  if (!filename) {
    /* I can see no simple way to truly support the dlopen(NULL, ...)
     * functionality.  More precisely, I can see no simple way to access
     * arbitrary symbols (like C lib "malloc" and "free") from the "main
     * program".  I think it is better to just use static linking for the
     * "main program" on Win32/MinGW.  So, we just fail here.
     */
    dlerror_last = ERROR_NOT_SUPPORTED;
    return NULL;
  }

  { 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)
    return 0;

  { int result = !FreeLibrary(hmodule);

    if (result)
      dlerror_last = GetLastError();

    return result;
  }
}
<--->

-Vesa Karvonen