3 * Platform: Win32 (Windows NT/Windows 95)
4 * Author: Wei-Yuen Tan (wyt@hip.com)
5 * Created: A warm day in June, 1995
8 * August 23rd 1995 - rewritten after losing everything when I
9 * wiped off my NT partition (eek!)
14 I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
15 replaced the appropriate SunOS calls with the corresponding Win32
20 #define WIN32_LEAN_AND_MEAN
27 #define PERL_NO_GET_CONTEXT
29 #define PERL_IN_DL_WIN32_XS
39 } my_cxtx_t; /* this *must* be named my_cxtx_t */
41 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
42 #include "dlutils.c" /* SaveError() etc */
44 #define dl_error_sv (dl_cxtx.x_error_sv)
50 DWORD err = GetLastError();
52 SV ** l_dl_error_svp = &dl_error_sv;
55 *l_dl_error_svp = newSVpvs("");
56 l_dl_error_sv = *l_dl_error_svp;
57 PerlProc_GetOSError(l_dl_error_sv,err);
58 return SvPV(l_dl_error_sv,len);
64 (void)dl_generic_private_init(aTHX);
68 This function assumes the list staticlinkmodules
69 will be formed from package names with '::' replaced
70 with '/'. Thus Win32::OLE is in the list as Win32/OLE
73 dl_static_linked(char *filename)
75 const char * const *p;
77 static const char subStr[] = "/auto/";
78 char szBuffer[MAX_PATH];
80 /* avoid buffer overflow when called with invalid filenames */
81 if (strlen(filename) >= sizeof(szBuffer))
84 /* change all the '\\' to '/' */
85 my_strlcpy(szBuffer, filename, sizeof(szBuffer));
86 for(ptr = szBuffer; ptr = strchr(ptr, '\\'); ++ptr)
89 /* delete the file name */
90 ptr = strrchr(szBuffer, '/');
94 /* remove leading lib path */
95 ptr = strstr(szBuffer, subStr);
97 ptr += sizeof(subStr)-1;
101 for (p = staticlinkmodules; *p;p++) {
102 if (hptr = strstr(ptr, *p)) {
103 /* found substring, need more detailed check if module name match */
105 return strEQ(ptr, *p);
107 if (hptr[strlen(*p)] == 0)
108 return hptr[-1]=='/';
114 MODULE = DynaLoader PACKAGE = DynaLoader
117 (void)dl_private_init(aTHX);
120 dl_load_file(filename,flags=0)
129 PERL_UNUSED_VAR(flags);
130 DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
131 if (dl_static_linked(filename) == 0) {
132 retv = PerlProc_DynaLoad(filename);
135 retv = (void*) Win_GetModuleHandle(NULL);
136 DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", retv));
139 SaveError(aTHX_ "load_file:%s",
140 OS_Error_String(aTHX)) ;
141 retsv = &PL_sv_undef;
144 retsv = sv_2mortal(newSViv((IV)retv));
149 dl_unload_file(libref)
152 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
153 RETVAL = FreeLibrary((HMODULE)libref);
155 SaveError(aTHX_ "unload_file:%s", OS_Error_String(aTHX)) ;
156 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
161 dl_find_symbol(libhandle, symbolname, ign_err=0)
168 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
169 libhandle, symbolname));
170 retv = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
171 DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", retv));
172 ST(0) = sv_newmortal();
174 if (!ign_err) SaveError(aTHX_ "find_symbol:%s", OS_Error_String(aTHX));
176 sv_setiv( ST(0), (IV)retv);
185 # These functions should not need changing on any platform:
188 dl_install_xsub(perl_name, symref, filename="$Package")
193 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
195 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
196 (void(*)(pTHX_ CV *))symref,
204 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
208 #if defined(USE_ITHREADS)
215 PERL_UNUSED_VAR(items);
217 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
218 * using Perl variables that belong to another thread, we create our
219 * own for this thread.
221 MY_CXT.x_dl_last_error = newSVpvs("");