Commit | Line | Data |
---|---|---|
2c2d71f5 | 1 | /* dl_cygwin.xs |
5aabfad6 | 2 | * |
3 | * Platform: Win32 (Windows NT/Windows 95) | |
4 | * Author: Wei-Yuen Tan (wyt@hip.com) | |
5 | * Created: A warm day in June, 1995 | |
6 | * | |
7 | * Modified: | |
8 | * August 23rd 1995 - rewritten after losing everything when I | |
9 | * wiped off my NT partition (eek!) | |
10 | */ | |
2c2d71f5 | 11 | /* Modified from the original dl_win32.xs to work with cygwin |
5aabfad6 | 12 | -John Cerney 3/26/97 |
13 | */ | |
14 | /* Porting notes: | |
15 | ||
16 | I merely took Paul's dl_dlopen.xs, took out extraneous stuff and | |
17 | replaced the appropriate SunOS calls with the corresponding Win32 | |
18 | calls. | |
19 | ||
20 | */ | |
21 | ||
22 | #define WIN32_LEAN_AND_MEAN | |
23 | // Defines from windows needed for this function only. Can't include full | |
2c2d71f5 | 24 | // Cygwin windows headers because of problems with CONTEXT redefinition |
5aabfad6 | 25 | // Removed logic to tell not dynamically load static modules. It is assumed that all |
26 | // modules are dynamically built. This should be similar to the behavoir on sunOS. | |
27 | // Leaving in the logic would have required changes to the standard perlmain.c code | |
28 | // | |
5aabfad6 | 29 | #include <stdio.h> |
5aabfad6 | 30 | |
31 | //#include <windows.h> | |
32 | #define LOAD_WITH_ALTERED_SEARCH_PATH (8) | |
33 | typedef void *HANDLE; | |
34 | typedef HANDLE HINSTANCE; | |
35 | #define STDCALL __attribute__ ((stdcall)) | |
36 | typedef int STDCALL (*FARPROC)(); | |
f89d6eaa | 37 | #define MAX_PATH 260 |
5aabfad6 | 38 | |
39 | HINSTANCE | |
40 | STDCALL | |
41 | LoadLibraryExA( | |
42 | char* lpLibFileName, | |
43 | HANDLE hFile, | |
44 | unsigned int dwFlags | |
45 | ); | |
46 | unsigned int | |
47 | STDCALL | |
48 | GetLastError( | |
49 | void | |
50 | ); | |
51 | FARPROC | |
52 | STDCALL | |
53 | GetProcAddress( | |
54 | HINSTANCE hModule, | |
55 | char* lpProcName | |
56 | ); | |
57 | ||
58 | #include <string.h> | |
59 | ||
60 | #include "EXTERN.h" | |
61 | #include "perl.h" | |
62 | #include "XSUB.h" | |
63 | ||
64 | #include "dlutils.c" /* SaveError() etc */ | |
65 | ||
66 | static void | |
cea2e8a9 | 67 | dl_private_init(pTHX) |
5aabfad6 | 68 | { |
cea2e8a9 | 69 | (void)dl_generic_private_init(aTHX); |
5aabfad6 | 70 | } |
71 | ||
72 | ||
73 | MODULE = DynaLoader PACKAGE = DynaLoader | |
74 | ||
75 | BOOT: | |
cea2e8a9 | 76 | (void)dl_private_init(aTHX); |
5aabfad6 | 77 | |
78 | void * | |
79 | dl_load_file(filename,flags=0) | |
80 | char * filename | |
81 | int flags | |
82 | PREINIT: | |
83 | CODE: | |
f89d6eaa EF |
84 | { |
85 | char win32_path[MAX_PATH]; | |
86 | cygwin_conv_to_full_win32_path(filename, win32_path); | |
87 | filename = win32_path; | |
88 | ||
c78749f2 | 89 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); |
5aabfad6 | 90 | |
91 | RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; | |
92 | ||
c78749f2 | 93 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); |
5aabfad6 | 94 | ST(0) = sv_newmortal() ; |
95 | if (RETVAL == NULL){ | |
cea2e8a9 | 96 | SaveError(aTHX_ "%d",GetLastError()) ; |
f89d6eaa EF |
97 | } else { |
98 | sv_setiv( ST(0), (IV)RETVAL); | |
5aabfad6 | 99 | } |
5aabfad6 | 100 | } |
101 | ||
102 | ||
103 | ||
104 | void * | |
105 | dl_find_symbol(libhandle, symbolname) | |
106 | void * libhandle | |
107 | char * symbolname | |
108 | CODE: | |
c78749f2 | 109 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", |
5aabfad6 | 110 | libhandle, symbolname)); |
111 | RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); | |
c78749f2 | 112 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); |
5aabfad6 | 113 | ST(0) = sv_newmortal() ; |
114 | if (RETVAL == NULL) | |
cea2e8a9 | 115 | SaveError(aTHX_ "%d",GetLastError()) ; |
5aabfad6 | 116 | else |
117 | sv_setiv( ST(0), (IV)RETVAL); | |
118 | ||
119 | ||
120 | void | |
121 | dl_undef_symbols() | |
122 | PPCODE: | |
123 | ||
124 | ||
125 | ||
126 | # These functions should not need changing on any platform: | |
127 | ||
128 | void | |
129 | dl_install_xsub(perl_name, symref, filename="$Package") | |
130 | char * perl_name | |
131 | void * symref | |
132 | char * filename | |
133 | CODE: | |
c78749f2 | 134 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", |
5aabfad6 | 135 | perl_name, symref)); |
cea2e8a9 GS |
136 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
137 | (void(*)(pTHX_ CV *))symref, | |
138 | filename))); | |
5aabfad6 | 139 | |
140 | ||
141 | char * | |
142 | dl_error() | |
143 | CODE: | |
144 | RETVAL = LastError ; | |
145 | OUTPUT: | |
146 | RETVAL | |
147 | ||
148 | # end. |