From 7d08c72cf964e17c7eee6404ba96f25506fe68ba Mon Sep 17 00:00:00 2001
From: Mike Gran <spk121@yahoo.com>
Date: Sat, 6 Mar 2021 17:56:12 -0800
Subject: Add windows stubs for dlopen, dlclose, dlsym, dlerror

* libguile/dynl.c [__MING32__] (dlopen, dlsym, dlclose, dlerror): use windows stubs
* libguile/posix-w32.c (dlopen_w32, dlsym_w32, dlclose_w32, dlerror_w32):
    new procedures
    (dlerror_str): new module-level variable
    (DLERROR_LEN): new define
* libguile/posix-w32.h: declare dlopen_w32, dlsym_w32, dlclose_w32, dlerror_w32.
    Declare RTLD_NOW, RTLD_LAZY, RTLD_GLOBAL, RTLD_LOCAL
---
 libguile/dynl.c      |  8 ++++++++
 libguile/posix-w32.c | 50 +++++++++++++++++++++++++++++++++++++++++++++++++-
 libguile/posix-w32.h |  9 +++++++++
 3 files changed, 66 insertions(+), 1 deletion(-)

diff --git a/libguile/dynl.c b/libguile/dynl.c
index 8e1cc90d9..6bab9bd32 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -28,7 +28,15 @@
 # include <config.h>
 #endif
 
+#ifdef __MINGW32__
+#include "posix-w32.h"
+#define dlopen(_nam,_flg) (dlopen_w32((_nam),(_flg)))
+#define dlsym(_hndl,_nam) (dlsym_w32((_hndl),(_nam)))
+#define dlclose(_hndl)    (dlclose_w32((_hndl)))
+#define dlerror()         (dlerror_w32())
+#else
 #include <dlfcn.h>
+#endif
 
 #include "boolean.h"
 #include "deprecation.h"
diff --git a/libguile/posix-w32.c b/libguile/posix-w32.c
index 6302eecbe..f11c52673 100644
--- a/libguile/posix-w32.c
+++ b/libguile/posix-w32.c
@@ -21,7 +21,7 @@
 # include <config.h>
 #endif
 
-# define WIN32_LEAN_AND_MEAN
+#define WIN32_LEAN_AND_MEAN
 #include <windows.h>
 #include <c-strcase.h>
 #include <process.h>
@@ -1208,3 +1208,51 @@ sched_setaffinity (int pid, size_t mask_size, cpu_set_t *mask)
 
   return -1;
 }
+
+/* This only implements the absolute minimum features for
+   foreign-library.scm. */
+void *
+dlopen_w32 (const char *name, int flags)
+{
+  void *ret = NULL;
+  if (name == NULL || *name == '\0')
+    return (void *) GetModuleHandle (NULL);
+  ret = (void *) LoadLibrary (name);
+  GetModuleHandleEx (0, name, (HMODULE *) & ret);
+  return ret;
+}
+
+void *
+dlsym_w32 (void *handle, const char *name)
+{
+  return (void *) GetProcAddress ((HMODULE) handle, name);
+}
+
+int
+dlclose_w32 (void *handle)
+{
+  FreeLibrary ((HMODULE) handle);
+  return 0;
+}
+
+#define DLERROR_LEN 80
+static char dlerror_str[DLERROR_LEN + 1];
+
+char *
+dlerror_w32 ()
+{
+  char *msg_buf;
+  DWORD dw = GetLastError ();
+  FormatMessage (FORMAT_MESSAGE_ALLOCATE_BUFFER |
+		 FORMAT_MESSAGE_FROM_SYSTEM |
+		 FORMAT_MESSAGE_IGNORE_INSERTS,
+		 NULL,
+		 dw,
+		 MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
+		 (LPTSTR) & msg_buf, 0, NULL);
+  if (dw == 0)
+    snprintf (dlerror_str, DLERROR_LEN, "No error");
+  else
+    snprintf (dlerror_str, DLERROR_LEN, "error %ld: %s", (long) dw, msg_buf);
+  return dlerror_str;
+}
diff --git a/libguile/posix-w32.h b/libguile/posix-w32.h
index ba1dff2dc..01a2df03a 100644
--- a/libguile/posix-w32.h
+++ b/libguile/posix-w32.h
@@ -91,6 +91,10 @@ SCM_INTERNAL int getpriority (int which, int who);
 SCM_INTERNAL int setpriority (int which, int who, int nice_val);
 SCM_INTERNAL int sched_getaffinity (int pid, size_t mask_size, cpu_set_t *mask);
 SCM_INTERNAL int sched_setaffinity (int pid, size_t mask_size, cpu_set_t *mask);
+SCM_INTERNAL void *dlopen_w32 (const char *name, int flags);
+SCM_INTERNAL void *dlsym_w32 (void *handle, const char *name);
+SCM_INTERNAL int dlclose_w32 (void *handle);
+SCM_INTERNAL char *dlerror_w32 (void);
 
 #define HAVE_UNAME 1
 #define HAVE_WAITPID 1
@@ -101,4 +105,9 @@ SCM_INTERNAL int sched_setaffinity (int pid, size_t mask_size, cpu_set_t *mask);
 #define HAVE_SCHED_GETAFFINITY 1
 #define HAVE_SCHED_SETAFFINITY 1
 
+#define RTLD_NOW 1
+#define RTLD_LAZY 2
+#define RTLD_GLOBAL 4
+#define RTLD_LOCAL 8
+
 #endif /* SCM_POSIX_W32_H */
-- 
cgit v1.2.1