[inseparable changes from match from perl-5.003_97 to perl-5.003_97a]
[perl.git] / ext / DynaLoader / dl_cygwin32.xs
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.