diff options
Diffstat (limited to 'gnu/usr.bin/perl/win32/dl_win32.xs')
-rw-r--r-- | gnu/usr.bin/perl/win32/dl_win32.xs | 112 |
1 files changed, 112 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/win32/dl_win32.xs b/gnu/usr.bin/perl/win32/dl_win32.xs new file mode 100644 index 00000000000..7b227e299c9 --- /dev/null +++ b/gnu/usr.bin/perl/win32/dl_win32.xs @@ -0,0 +1,112 @@ +/* dl_win32.xs + * + * Platform: Win32 (Windows NT/Windows 95) + * Author: Wei-Yuen Tan (wyt@hip.com) + * Created: A warm day in June, 1995 + * + * Modified: + * August 23rd 1995 - rewritten after losing everything when I + * wiped off my NT partition (eek!) + */ + +/* Porting notes: + +I merely took Paul's dl_dlopen.xs, took out extraneous stuff and +replaced the appropriate SunOS calls with the corresponding Win32 +calls. + +*/ + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#include <string.h> + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "dlutils.c" /* SaveError() etc */ + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +static int +dl_static_linked(char *filename) +{ + char **p; + for (p = staticlinkmodules; *p;p++) { + if (strstr(filename, *p)) return 1; + }; + return 0; +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + +void * +dl_load_file(filename,flags=0) + char * filename + int flags + PREINIT: + CODE: + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + if (dl_static_linked(filename) == 0) + RETVAL = (void*) LoadLibraryEx(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; + else + RETVAL = (void*) GetModuleHandle(NULL); + DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%d",GetLastError()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%d",GetLastError()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV*))symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. |