This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make die/warn and other diagnostics go to wherever STDERR happens
[perl5.git] / ext / DynaLoader / dl_next.xs
CommitLineData
a0d0e21e
LW
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
19dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It
20should not be used as a base for further ports though it may be used
21as an example for how dl_dlopen.xs can be ported to other platforms.
22
23The method used here is just to supply the sun style dlopen etc.
24functions in terms of NeXTs rld_*. The xs code proper is unchanged
25from Paul's original.
26
27The port could use some streamlining. For one, error handling could
28be simplified.
29
30Anno Siegel
31
32*/
33
d6bcbf1c
PP
34#if NS_TARGET_MAJOR >= 4
35#else
8e07c86e
AD
36/* include these before perl headers */
37#include <mach-o/rld.h>
38#include <streams/streams.h>
d6bcbf1c 39#endif
8e07c86e 40
a0d0e21e
LW
41#include "EXTERN.h"
42#include "perl.h"
43#include "XSUB.h"
44
8e07c86e 45#define DL_LOADONCEONLY
a0d0e21e 46
8e07c86e 47#include "dlutils.c" /* SaveError() etc */
a0d0e21e 48
a0d0e21e
LW
49
50static char * dl_last_error = (char *) 0;
8e07c86e 51static AV *dl_resolve_using = Nullav;
a0d0e21e 52
d6bcbf1c
PP
53static char *dlerror()
54{
55 return dl_last_error;
56}
57
58int dlclose(handle) /* stub only */
59void *handle;
60{
61 return 0;
62}
63
64#if NS_TARGET_MAJOR >= 4
65#import <mach-o/dyld.h>
66
67enum dyldErrorSource
68{
69 OFImage,
70};
71
72static void TranslateError
73 (const char *path, enum dyldErrorSource type, int number)
74{
5b877257 75 dTHX;
46fc3d4c 76 char *error;
d6bcbf1c
PP
77 unsigned int index;
78 static char *OFIErrorStrings[] =
79 {
80 "%s(%d): Object Image Load Failure\n",
81 "%s(%d): Object Image Load Success\n",
82 "%s(%d): Not an recognisable object file\n",
83 "%s(%d): No valid architecture\n",
84 "%s(%d): Object image has an invalid format\n",
85 "%s(%d): Invalid access (permissions?)\n",
86 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
87 };
88#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
89
d6bcbf1c
PP
90 switch (type)
91 {
92 case OFImage:
93 index = number;
94 if (index > NUM_OFI_ERRORS - 1)
95 index = NUM_OFI_ERRORS - 1;
46fc3d4c 96 error = form(OFIErrorStrings[index], path, number);
d6bcbf1c
PP
97 break;
98
99 default:
46fc3d4c
PP
100 error = form("%s(%d): Totally unknown error type %d\n",
101 path, number, type);
d6bcbf1c
PP
102 break;
103 }
8c52afec 104 Safefree(dl_last_error);
46fc3d4c 105 dl_last_error = savepv(error);
d6bcbf1c
PP
106}
107
108static char *dlopen(char *path, int mode /* mode is ignored */)
109{
110 int dyld_result;
111 NSObjectFileImage ofile;
112 NSModule handle = NULL;
113
114 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
115 if (dyld_result != NSObjectFileImageSuccess)
116 TranslateError(path, OFImage, dyld_result);
117 else
118 {
119 // NSLinkModule will cause the run to abort on any link error's
120 // not very friendly but the error recovery functionality is limited.
121 handle = NSLinkModule(ofile, path, TRUE);
122 }
123
124 return handle;
125}
126
127void *
128dlsym(handle, symbol)
129void *handle;
130char *symbol;
131{
132 void *addr;
133
134 if (NSIsSymbolNameDefined(symbol))
135 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
136 else
137 addr = NULL;
138
139 return addr;
140}
141
142#else /* NS_TARGET_MAJOR <= 3 */
143
144static NXStream *OpenError(void)
a0d0e21e
LW
145{
146 return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
147}
148
d6bcbf1c 149static void TransferError(NXStream *s)
a0d0e21e
LW
150{
151 char *buffer;
152 int len, maxlen;
153
154 if ( dl_last_error ) {
8c52afec 155 Safefree(dl_last_error);
a0d0e21e
LW
156 }
157 NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
8c52afec 158 New(1097, dl_last_error, len, char);
a0d0e21e
LW
159 strcpy(dl_last_error, buffer);
160}
161
d6bcbf1c 162static void CloseError(NXStream *s)
a0d0e21e
LW
163{
164 if ( s ) {
165 NXCloseMemory( s, NX_FREEBUFFER);
166 }
167}
168
d6bcbf1c 169static char *dlopen(char *path, int mode /* mode is ignored */)
a0d0e21e
LW
170{
171 int rld_success;
8e07c86e 172 NXStream *nxerr;
a0d0e21e
LW
173 I32 i, psize;
174 char *result;
175 char **p;
2d8e6c8d 176 STRLEN n_a;
8e07c86e
AD
177
178 /* Do not load what is already loaded into this process */
179 if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
180 return path;
a0d0e21e 181
8e07c86e
AD
182 nxerr = OpenError();
183 psize = AvFILL(dl_resolve_using) + 3;
a0d0e21e
LW
184 p = (char **) safemalloc(psize * sizeof(char*));
185 p[0] = path;
186 for(i=1; i<psize-1; i++) {
2d8e6c8d 187 p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
a0d0e21e
LW
188 }
189 p[psize-1] = 0;
190 rld_success = rld_load(nxerr, (struct mach_header **)0, p,
191 (const char *) 0);
192 safefree((char*) p);
193 if (rld_success) {
194 result = path;
8e07c86e 195 /* prevent multiple loads of same file into same process */
3280af22 196 hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
a0d0e21e
LW
197 } else {
198 TransferError(nxerr);
199 result = (char*) 0;
200 }
201 CloseError(nxerr);
202 return result;
203}
204
a0d0e21e
LW
205void *
206dlsym(handle, symbol)
207void *handle;
208char *symbol;
209{
210 NXStream *nxerr = OpenError();
a0d0e21e
LW
211 unsigned long symref = 0;
212
89475926 213 if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
a0d0e21e 214 TransferError(nxerr);
a0d0e21e
LW
215 CloseError(nxerr);
216 return (void*) symref;
217}
218
d6bcbf1c
PP
219#endif /* NS_TARGET_MAJOR >= 4 */
220
a0d0e21e
LW
221
222/* ----- code from dl_dlopen.xs below here ----- */
223
224
225static void
cea2e8a9 226dl_private_init(pTHX)
a0d0e21e 227{
cea2e8a9
GS
228 (void)dl_generic_private_init(aTHX);
229 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4);
a0d0e21e
LW
230}
231
232MODULE = DynaLoader PACKAGE = DynaLoader
233
234BOOT:
cea2e8a9 235 (void)dl_private_init(aTHX);
a0d0e21e
LW
236
237
238
239void *
ff7f3c60 240dl_load_file(filename, flags=0)
a0d0e21e 241 char * filename
ff7f3c60
NIS
242 int flags
243 PREINIT:
a0d0e21e 244 int mode = 1;
ff7f3c60 245 CODE:
bf49b057 246 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
ff7f3c60 247 if (flags & 0x01)
cea2e8a9 248 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
a0d0e21e 249 RETVAL = dlopen(filename, mode) ;
bf49b057 250 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
a0d0e21e
LW
251 ST(0) = sv_newmortal() ;
252 if (RETVAL == NULL)
cea2e8a9 253 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 254 else
3175b8cd 255 sv_setiv( ST(0), PTR2IV(RETVAL) );
a0d0e21e
LW
256
257
258void *
259dl_find_symbol(libhandle, symbolname)
260 void * libhandle
261 char * symbolname
262 CODE:
d6bcbf1c 263#if NS_TARGET_MAJOR >= 4
46fc3d4c 264 symbolname = form("_%s", symbolname);
d6bcbf1c 265#endif
bf49b057 266 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
46fc3d4c
PP
267 "dl_find_symbol(handle=%lx, symbol=%s)\n",
268 (unsigned long) libhandle, symbolname));
a0d0e21e 269 RETVAL = dlsym(libhandle, symbolname);
bf49b057 270 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
46fc3d4c 271 " symbolref = %lx\n", (unsigned long) RETVAL));
a0d0e21e
LW
272 ST(0) = sv_newmortal() ;
273 if (RETVAL == NULL)
cea2e8a9 274 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 275 else
3175b8cd 276 sv_setiv( ST(0), PTR2IV(RETVAL) );
a0d0e21e
LW
277
278
279void
280dl_undef_symbols()
281 PPCODE:
282
283
284
285# These functions should not need changing on any platform:
286
287void
288dl_install_xsub(perl_name, symref, filename="$Package")
289 char * perl_name
290 void * symref
291 char * filename
292 CODE:
bf49b057 293 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
a0d0e21e 294 perl_name, symref));
cea2e8a9
GS
295 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
296 (void(*)(pTHX_ CV *))symref,
297 filename)));
a0d0e21e
LW
298
299
300char *
301dl_error()
302 CODE:
303 RETVAL = LastError ;
304 OUTPUT:
305 RETVAL
306
307# end.