[Guile-commits] 02/03: Add windows stubs for dlopen, dlclose, dlsym, dlerror

[Mike Gran]

mike121 pushed a commit to branch mingw-guile-3.0
in repository guile.

commit 7d6b6aaa7fb70b8a20ad3cf40cc483499d82e971
Author: Mike Gran <spk121@yahoo.com>
AuthorDate: Sat Mar 6 17:56:12 2021 -0800

    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 8e1cc90..6bab9bd 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 6302eec..f11c526 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 ba1dff2..01a2df0 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 */