Rename "perl59" to "perl510"

[perl5.git] / win32 / dl_win32.xs

diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs
index a5183c3..6c094d2 100644 (file)
--- a/win32/dl_win32.xs
+++ b/win32/dl_win32.xs
@@ -24,35 +24,39 @@ calls.
 #include <windows.h>
 #include <string.h>
 
+#define PERL_NO_GET_CONTEXT
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "win32.h"
 
-#ifdef PERL_OBJECT
-#define NO_XSLOCKS
-#endif  /* PERL_OBJECT */
-
 #include "XSUB.h"
 
-static SV *error_sv;
+typedef struct {
+    SV *       x_error_sv;
+} my_cxtx_t;           /* this *must* be named my_cxtx_t */
+
+#define DL_CXT_EXTRA   /* ask for dl_cxtx to be defined in dlutils.c */
+#include "dlutils.c"   /* SaveError() etc      */
+
+#define dl_error_sv    (dl_cxtx.x_error_sv)
 
 static char *
-OS_Error_String(void)
+OS_Error_String(pTHX)
 {
- DWORD err = GetLastError();
- STRLEN len;
- if (!error_sv)
-  error_sv = newSVpv("",0);
- win32_str_os_error(error_sv,err);
- return SvPV(error_sv,len);
+    dMY_CXT;
+    DWORD err = GetLastError();
+    STRLEN len;
+    if (!dl_error_sv)
+       dl_error_sv = newSVpvn("",0);
+    PerlProc_GetOSError(dl_error_sv,err);
+    return SvPV(dl_error_sv,len);
 }
 
-#include "dlutils.c"   /* SaveError() etc      */
-
 static void
-dl_private_init(CPERLarg)
+dl_private_init(pTHX)
 {
-    (void)dl_generic_private_init(PERL_OBJECT_THIS);
+    (void)dl_generic_private_init(aTHX);
 }
 
 /* 
@@ -64,7 +68,7 @@ static int
 dl_static_linked(char *filename)
 {
     char **p;
-    char* ptr;
+    char *ptr, *hptr;
     static char subStr[] = "/auto/";
     char szBuffer[MAX_PATH];
 
@@ -86,7 +90,14 @@ dl_static_linked(char *filename)
        ptr = szBuffer;
 
     for (p = staticlinkmodules; *p;p++) {
-       if (strstr(ptr, *p)) return 1;
+       if (hptr = strstr(ptr, *p)) {
+           /* found substring, need more detailed check if module name match */
+           if (hptr==ptr) {
+               return strcmp(ptr, *p)==0;
+           }
+           if (hptr[strlen(*p)] == 0)
+               return hptr[-1]=='/';
+       }
     };
     return 0;
 }
@@ -94,7 +105,7 @@ dl_static_linked(char *filename)
 MODULE = DynaLoader    PACKAGE = DynaLoader
 
 BOOT:
-    (void)dl_private_init(PERL_OBJECT_THIS);
+    (void)dl_private_init(aTHX);
 
 void *
 dl_load_file(filename,flags=0)
@@ -102,31 +113,47 @@ dl_load_file(filename,flags=0)
     int                        flags
     PREINIT:
     CODE:
-    DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
-    if (dl_static_linked(filename) == 0)
-       RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
+  {
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
+    if (dl_static_linked(filename) == 0) {
+       RETVAL = PerlProc_DynaLoad(filename);
+    }
     else
-       RETVAL = (void*) GetModuleHandle(NULL);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
+       RETVAL = (void*) Win_GetModuleHandle(NULL);
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
-       SaveError(PERL_OBJECT_THIS_ "load_file:%s",OS_Error_String()) ;
+       SaveError(aTHX_ "load_file:%s",
+                 OS_Error_String(aTHX)) ;
     else
        sv_setiv( ST(0), (IV)RETVAL);
-
+  }
+
+int
+dl_unload_file(libref)
+    void *     libref
+  CODE:
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
+    RETVAL = FreeLibrary(libref);
+    if (!RETVAL)
+        SaveError(aTHX_ "unload_file:%s", OS_Error_String(aTHX)) ;
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
+  OUTPUT:
+    RETVAL
 
 void *
 dl_find_symbol(libhandle, symbolname)
     void *     libhandle
     char *     symbolname
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
                      libhandle, symbolname));
     RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"  symbolref = %x\n", RETVAL));
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
     ST(0) = sv_newmortal() ;
     if (RETVAL == NULL)
-       SaveError(PERL_OBJECT_THIS_ "find_symbol:%s",OS_Error_String()) ;
+       SaveError(aTHX_ "find_symbol:%s",
+                 OS_Error_String(aTHX)) ;
     else
        sv_setiv( ST(0), (IV)RETVAL);
 
@@ -145,15 +172,18 @@ dl_install_xsub(perl_name, symref, filename="$Package")
     void *             symref 
     char *             filename
     CODE:
-    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
+    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
                      perl_name, symref));
-    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV* _CPERLarg))symref, filename)));
+    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+                                       (void(*)(pTHX_ CV *))symref,
+                                       filename)));
 
 
 char *
 dl_error()
     CODE:
-    RETVAL = LastError ;
+    dMY_CXT;
+    RETVAL = dl_last_error;
     OUTPUT:
     RETVAL