perl 5.003_02: [no incremental changelog available]
[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dl_next.xs
1 /* dl_next.xs
2  * 
3  * Platform:    NeXT NS 3.2
4  * Author:      Anno Siegel (siegel@zrz.TU-Berlin.DE)
5  * Based on:    dl_dlopen.xs by Paul Marquess
6  * Created:     Aug 15th, 1994
7  *
8  */
9
10 /*
11     And Gandalf said: 'Many folk like to know beforehand what is to
12     be set on the table; but those who have laboured to prepare the
13     feast like to keep their secret; for wonder makes the words of
14     praise louder.'
15 */
16
17 /* Porting notes:
18
19 dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
20 should not be used as a base for further ports though it may be used
21 as an example for how dl_dlopen.xs can be ported to other platforms.
22
23 The method used here is just to supply the sun style dlopen etc.
24 functions in terms of NeXTs rld_*.  The xs code proper is unchanged
25 from Paul's original.
26
27 The port could use some streamlining.  For one, error handling could
28 be simplified.
29
30 Anno Siegel
31
32 */
33
34 #if NS_TARGET_MAJOR >= 4
35 #else
36 /* include these before perl headers */
37 #include <mach-o/rld.h>
38 #include <streams/streams.h>
39 #endif
40
41 #include "EXTERN.h"
42 #include "perl.h"
43 #include "XSUB.h"
44
45 #define DL_LOADONCEONLY
46
47 #include "dlutils.c"    /* SaveError() etc      */
48
49
50 static char * dl_last_error = (char *) 0;
51 static AV *dl_resolve_using = Nullav;
52
53 static char *dlerror()
54 {
55     return dl_last_error;
56 }
57
58 int dlclose(handle) /* stub only */
59 void *handle;
60 {
61     return 0;
62 }
63
64 #if NS_TARGET_MAJOR >= 4
65 #import <mach-o/dyld.h>
66
67 enum dyldErrorSource
68 {
69     OFImage,
70 };
71
72 static void TranslateError
73     (const char *path, enum dyldErrorSource type, int number)
74 {
75     char errorBuffer[128];
76     unsigned int index;
77     static char *OFIErrorStrings[] =
78     {
79         "%s(%d): Object Image Load Failure\n",
80         "%s(%d): Object Image Load Success\n",
81         "%s(%d): Not an recognisable object file\n",
82         "%s(%d): No valid architecture\n",
83         "%s(%d): Object image has an invalid format\n",
84         "%s(%d): Invalid access (permissions?)\n",
85         "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
86     };
87 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
88
89     if ( dl_last_error ) {
90         safefree(dl_last_error);
91     }
92     switch (type)
93     {
94     case OFImage:
95         index = number;
96         if (index > NUM_OFI_ERRORS - 1)
97             index = NUM_OFI_ERRORS - 1;
98         sprintf(errorBuffer, OFIErrorStrings[index], path, number);
99         break;
100
101     default:
102         sprintf(errorBuffer, "%s(%d): Totally unknown error type %d\n",
103             path, number, type);
104         break;
105     }
106     dl_last_error = safemalloc(strlen(errorBuffer)+1);
107     strcpy(dl_last_error, errorBuffer);
108 }
109
110 static char *dlopen(char *path, int mode /* mode is ignored */)
111 {
112     int dyld_result;
113     NSObjectFileImage ofile;
114     NSModule handle = NULL;
115
116     dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
117     if (dyld_result != NSObjectFileImageSuccess)
118         TranslateError(path, OFImage, dyld_result);
119     else
120     {
121         // NSLinkModule will cause the run to abort on any link error's
122         // not very friendly but the error recovery functionality is limited.
123         handle = NSLinkModule(ofile, path, TRUE);
124     }
125     
126     return handle;
127 }
128
129 void *
130 dlsym(handle, symbol)
131 void *handle;
132 char *symbol;
133 {
134     void *addr;
135
136     if (NSIsSymbolNameDefined(symbol))
137         addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
138     else
139         addr = NULL;
140
141     return addr;
142 }
143
144 #else /* NS_TARGET_MAJOR <= 3 */
145
146 static NXStream *OpenError(void)
147 {
148     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
149 }
150
151 static void TransferError(NXStream *s)
152 {
153     char *buffer;
154     int len, maxlen;
155
156     if ( dl_last_error ) {
157         safefree(dl_last_error);
158     }
159     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
160     dl_last_error = safemalloc(len);
161     strcpy(dl_last_error, buffer);
162 }
163
164 static void CloseError(NXStream *s)
165 {
166     if ( s ) {
167       NXCloseMemory( s, NX_FREEBUFFER);
168     }
169 }
170
171 static char *dlopen(char *path, int mode /* mode is ignored */)
172 {
173     int rld_success;
174     NXStream *nxerr;
175     I32 i, psize;
176     char *result;
177     char **p;
178         
179     /* Do not load what is already loaded into this process */
180     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
181         return path;
182
183     nxerr = OpenError();
184     psize = AvFILL(dl_resolve_using) + 3;
185     p = (char **) safemalloc(psize * sizeof(char*));
186     p[0] = path;
187     for(i=1; i<psize-1; i++) {
188         p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
189     }
190     p[psize-1] = 0;
191     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
192                             (const char *) 0);
193     safefree((char*) p);
194     if (rld_success) {
195         result = path;
196         /* prevent multiple loads of same file into same process */
197         hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
198     } else {
199         TransferError(nxerr);
200         result = (char*) 0;
201     }
202     CloseError(nxerr);
203     return result;
204 }
205
206 void *
207 dlsym(handle, symbol)
208 void *handle;
209 char *symbol;
210 {
211     NXStream    *nxerr = OpenError();
212     char        symbuf[1024];
213     unsigned long       symref = 0;
214
215     sprintf(symbuf, "_%s", symbol);
216     if (!rld_lookup(nxerr, symbuf, &symref)) {
217         TransferError(nxerr);
218     }
219     CloseError(nxerr);
220     return (void*) symref;
221 }
222
223 #endif /* NS_TARGET_MAJOR >= 4 */
224
225
226 /* ----- code from dl_dlopen.xs below here ----- */
227
228
229 static void
230 dl_private_init()
231 {
232     (void)dl_generic_private_init();
233     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
234 }
235  
236 MODULE = DynaLoader     PACKAGE = DynaLoader
237
238 BOOT:
239     (void)dl_private_init();
240
241
242
243 void *
244 dl_load_file(filename)
245     char *      filename
246     CODE:
247     int mode = 1;
248     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n", filename));
249     RETVAL = dlopen(filename, mode) ;
250     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
251     ST(0) = sv_newmortal() ;
252     if (RETVAL == NULL)
253         SaveError("%s",dlerror()) ;
254     else
255         sv_setiv( ST(0), (IV)RETVAL);
256
257
258 void *
259 dl_find_symbol(libhandle, symbolname)
260     void *              libhandle
261     char *              symbolname
262     CODE:
263 #if NS_TARGET_MAJOR >= 4
264     char symbolname_buf[1024];
265     symbolname = dl_add_underscore(symbolname, symbolname_buf);
266 #endif
267     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
268             libhandle, symbolname));
269     RETVAL = dlsym(libhandle, symbolname);
270     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
271     ST(0) = sv_newmortal() ;
272     if (RETVAL == NULL)
273         SaveError("%s",dlerror()) ;
274     else
275         sv_setiv( ST(0), (IV)RETVAL);
276
277
278 void
279 dl_undef_symbols()
280     PPCODE:
281
282
283
284 # These functions should not need changing on any platform:
285
286 void
287 dl_install_xsub(perl_name, symref, filename="$Package")
288     char *      perl_name
289     void *      symref 
290     char *      filename
291     CODE:
292     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
293             perl_name, symref));
294     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
295
296
297 char *
298 dl_error()
299     CODE:
300     RETVAL = LastError ;
301     OUTPUT:
302     RETVAL
303
304 # end.