This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[inseparable changes from match from perl-5.003_97 to perl-5.003_97a]
[perl5.git] / ext / DynaLoader / dl_cygwin32.xs
CommitLineData
5aabfad6
PP
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
16I merely took Paul's dl_dlopen.xs, took out extraneous stuff and
17replaced the appropriate SunOS calls with the corresponding Win32
18calls.
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>
31void (*impure_setupptr)(struct _reent *); // pointer to the impure_setup routine
32
33//#include <windows.h>
34#define LOAD_WITH_ALTERED_SEARCH_PATH (8)
35typedef void *HANDLE;
36typedef HANDLE HINSTANCE;
37#define STDCALL __attribute__ ((stdcall))
38typedef int STDCALL (*FARPROC)();
39
40HINSTANCE
41STDCALL
42LoadLibraryExA(
43 char* lpLibFileName,
44 HANDLE hFile,
45 unsigned int dwFlags
46 );
47unsigned int
48STDCALL
49GetLastError(
50 void
51 );
52FARPROC
53STDCALL
54GetProcAddress(
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
67static void
68dl_private_init()
69{
70 (void)dl_generic_private_init();
71}
72
73
74MODULE = DynaLoader PACKAGE = DynaLoader
75
76BOOT:
77 (void)dl_private_init();
78
79void *
80dl_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
111void *
112dl_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
127void
128dl_undef_symbols()
129 PPCODE:
130
131
132
133# These functions should not need changing on any platform:
134
135void
136dl_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
146char *
147dl_error()
148 CODE:
149 RETVAL = LastError ;
150 OUTPUT:
151 RETVAL
152
153# end.