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 |
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 |
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 |
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. |