1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
/* 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
#ifdef __GNUC__
#define Win32_Winsock
#endif
#include <windows.h>
#include <string.h>
#include "EXTERN.h"
#include "perl.h"
#ifdef PERL_OBJECT
#define NO_XSLOCKS
#endif /* PERL_OBJECT */
#include "XSUB.h"
#include "dlutils.c" /* SaveError() etc */
static void
dl_private_init(CPERLarg)
{
(void)dl_generic_private_init(THIS);
}
#ifdef PERL_OBJECT
#define dl_static_linked(x) 0
#else
static int
dl_static_linked(char *filename)
{
char **p;
for (p = staticlinkmodules; *p;p++) {
if (strstr(filename, *p)) return 1;
};
return 0;
}
#endif
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
(void)dl_private_init(THIS);
void *
dl_load_file(filename,flags=0)
char * filename
int flags
PREINIT:
CODE:
DLDEBUG(1,PerlIO_printf(PerlIO_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,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
SaveError(THIS_ "%d",GetLastError()) ;
else
sv_setiv( ST(0), (IV)RETVAL);
void *
dl_find_symbol(libhandle, symbolname)
void * libhandle
char * symbolname
CODE:
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
SaveError(THIS_ "%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,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CPERLarg_ CV*))symref, filename)));
char *
dl_error()
CODE:
RETVAL = LastError ;
OUTPUT:
RETVAL
# end.
|
