5aabfad6 |
1 | /* dl_cygwin32.xs |
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 | */ |
11 | /* Modified from the original dl_win32.xs to work with cygwin32 |
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 |
24 | // Cygwin32 windows headers because of problems with CONTEXT redefinition |
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 | // |
29 | // // Includes call a dll function to initialize it's impure_ptr. |
30 | #include <stdio.h> |
31 | void (*impure_setupptr)(struct _reent *); // pointer to the impure_setup routine |
32 | |
33 | //#include <windows.h> |
34 | #define LOAD_WITH_ALTERED_SEARCH_PATH (8) |
35 | typedef void *HANDLE; |
36 | typedef HANDLE HINSTANCE; |
37 | #define STDCALL __attribute__ ((stdcall)) |
38 | typedef int STDCALL (*FARPROC)(); |
39 | |
40 | HINSTANCE |
41 | STDCALL |
42 | LoadLibraryExA( |
43 | char* lpLibFileName, |
44 | HANDLE hFile, |
45 | unsigned int dwFlags |
46 | ); |
47 | unsigned int |
48 | STDCALL |
49 | GetLastError( |
50 | void |
51 | ); |
52 | FARPROC |
53 | STDCALL |
54 | GetProcAddress( |
55 | HINSTANCE hModule, |
56 | char* lpProcName |
57 | ); |
58 | |
59 | #include <string.h> |
60 | |
61 | #include "EXTERN.h" |
62 | #include "perl.h" |
63 | #include "XSUB.h" |
64 | |
65 | #include "dlutils.c" /* SaveError() etc */ |
66 | |
67 | static void |
68 | dl_private_init() |
69 | { |
70 | (void)dl_generic_private_init(); |
71 | } |
72 | |
73 | |
74 | MODULE = DynaLoader PACKAGE = DynaLoader |
75 | |
76 | BOOT: |
77 | (void)dl_private_init(); |
78 | |
79 | void * |
80 | dl_load_file(filename,flags=0) |
81 | char * filename |
82 | int flags |
83 | PREINIT: |
84 | CODE: |
85 | DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); |
86 | |
87 | RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; |
88 | |
89 | DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); |
90 | ST(0) = sv_newmortal() ; |
91 | if (RETVAL == NULL){ |
92 | SaveError("%d",GetLastError()) ; |
93 | } |
94 | else{ |
95 | // setup the dll's impure_ptr: |
96 | impure_setupptr = GetProcAddress(RETVAL, "impure_setup"); |
97 | if( impure_setupptr == NULL){ |
98 | printf( |
99 | "Cygwin32 dynaloader error: could not load impure_setup symbol\n"); |
100 | RETVAL = NULL; |
101 | } |
102 | else{ |
103 | // setup the DLLs impure_ptr: |
104 | (*impure_setupptr)(_impure_ptr); |
105 | sv_setiv( ST(0), (IV)RETVAL); |
106 | } |
107 | } |
108 | |
109 | |
110 | |
111 | void * |
112 | dl_find_symbol(libhandle, symbolname) |
113 | void * libhandle |
114 | char * symbolname |
115 | CODE: |
116 | DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", |
117 | libhandle, symbolname)); |
118 | RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); |
119 | DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); |
120 | ST(0) = sv_newmortal() ; |
121 | if (RETVAL == NULL) |
122 | SaveError("%d",GetLastError()) ; |
123 | else |
124 | sv_setiv( ST(0), (IV)RETVAL); |
125 | |
126 | |
127 | void |
128 | dl_undef_symbols() |
129 | PPCODE: |
130 | |
131 | |
132 | |
133 | # These functions should not need changing on any platform: |
134 | |
135 | void |
136 | dl_install_xsub(perl_name, symref, filename="$Package") |
137 | char * perl_name |
138 | void * symref |
139 | char * filename |
140 | CODE: |
141 | DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", |
142 | perl_name, symref)); |
143 | ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); |
144 | |
145 | |
146 | char * |
147 | dl_error() |
148 | CODE: |
149 | RETVAL = LastError ; |
150 | OUTPUT: |
151 | RETVAL |
152 | |
153 | # end. |