This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typo in NeXT dynaloader
[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{
46fc3d4c 75 char *error;
d6bcbf1c
PP
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
d6bcbf1c
PP
89 switch (type)
90 {
91 case OFImage:
92 index = number;
93 if (index > NUM_OFI_ERRORS - 1)
94 index = NUM_OFI_ERRORS - 1;
46fc3d4c 95 error = form(OFIErrorStrings[index], path, number);
d6bcbf1c
PP
96 break;
97
98 default:
46fc3d4c
PP
99 error = form("%s(%d): Totally unknown error type %d\n",
100 path, number, type);
d6bcbf1c
PP
101 break;
102 }
46fc3d4c
PP
103 safefree(dl_last_error);
104 dl_last_error = savepv(error);
d6bcbf1c
PP
105}
106
107static char *dlopen(char *path, int mode /* mode is ignored */)
108{
109 int dyld_result;
110 NSObjectFileImage ofile;
111 NSModule handle = NULL;
112
113 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
114 if (dyld_result != NSObjectFileImageSuccess)
115 TranslateError(path, OFImage, dyld_result);
116 else
117 {
118 // NSLinkModule will cause the run to abort on any link error's
119 // not very friendly but the error recovery functionality is limited.
120 handle = NSLinkModule(ofile, path, TRUE);
121 }
122
123 return handle;
124}
125
126void *
127dlsym(handle, symbol)
128void *handle;
129char *symbol;
130{
131 void *addr;
132
133 if (NSIsSymbolNameDefined(symbol))
134 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
135 else
136 addr = NULL;
137
138 return addr;
139}
140
141#else /* NS_TARGET_MAJOR <= 3 */
142
143static NXStream *OpenError(void)
a0d0e21e
LW
144{
145 return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
146}
147
d6bcbf1c 148static void TransferError(NXStream *s)
a0d0e21e
LW
149{
150 char *buffer;
151 int len, maxlen;
152
153 if ( dl_last_error ) {
154 safefree(dl_last_error);
155 }
156 NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
157 dl_last_error = safemalloc(len);
158 strcpy(dl_last_error, buffer);
159}
160
d6bcbf1c 161static void CloseError(NXStream *s)
a0d0e21e
LW
162{
163 if ( s ) {
164 NXCloseMemory( s, NX_FREEBUFFER);
165 }
166}
167
d6bcbf1c 168static char *dlopen(char *path, int mode /* mode is ignored */)
a0d0e21e
LW
169{
170 int rld_success;
8e07c86e 171 NXStream *nxerr;
a0d0e21e
LW
172 I32 i, psize;
173 char *result;
174 char **p;
8e07c86e
AD
175
176 /* Do not load what is already loaded into this process */
177 if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
178 return path;
a0d0e21e 179
8e07c86e
AD
180 nxerr = OpenError();
181 psize = AvFILL(dl_resolve_using) + 3;
a0d0e21e
LW
182 p = (char **) safemalloc(psize * sizeof(char*));
183 p[0] = path;
184 for(i=1; i<psize-1; i++) {
8e07c86e 185 p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
a0d0e21e
LW
186 }
187 p[psize-1] = 0;
188 rld_success = rld_load(nxerr, (struct mach_header **)0, p,
189 (const char *) 0);
190 safefree((char*) p);
191 if (rld_success) {
192 result = path;
8e07c86e
AD
193 /* prevent multiple loads of same file into same process */
194 hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
a0d0e21e
LW
195 } else {
196 TransferError(nxerr);
197 result = (char*) 0;
198 }
199 CloseError(nxerr);
200 return result;
201}
202
a0d0e21e
LW
203void *
204dlsym(handle, symbol)
205void *handle;
206char *symbol;
207{
208 NXStream *nxerr = OpenError();
a0d0e21e
LW
209 unsigned long symref = 0;
210
89475926 211 if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
a0d0e21e 212 TransferError(nxerr);
a0d0e21e
LW
213 CloseError(nxerr);
214 return (void*) symref;
215}
216
d6bcbf1c
PP
217#endif /* NS_TARGET_MAJOR >= 4 */
218
a0d0e21e
LW
219
220/* ----- code from dl_dlopen.xs below here ----- */
221
222
223static void
224dl_private_init()
225{
226 (void)dl_generic_private_init();
8e07c86e 227 dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
a0d0e21e
LW
228}
229
230MODULE = DynaLoader PACKAGE = DynaLoader
231
232BOOT:
233 (void)dl_private_init();
234
235
236
237void *
ff7f3c60 238dl_load_file(filename, flags=0)
a0d0e21e 239 char * filename
ff7f3c60
NIS
240 int flags
241 PREINIT:
a0d0e21e 242 int mode = 1;
ff7f3c60
NIS
243 CODE:
244 DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
245 if (flags & 0x01)
246 warn("Can't make loaded symbols global on this platform while loading %s",filename);
a0d0e21e 247 RETVAL = dlopen(filename, mode) ;
760ac839 248 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
a0d0e21e
LW
249 ST(0) = sv_newmortal() ;
250 if (RETVAL == NULL)
251 SaveError("%s",dlerror()) ;
252 else
253 sv_setiv( ST(0), (IV)RETVAL);
254
255
256void *
257dl_find_symbol(libhandle, symbolname)
258 void * libhandle
259 char * symbolname
260 CODE:
d6bcbf1c 261#if NS_TARGET_MAJOR >= 4
46fc3d4c 262 symbolname = form("_%s", symbolname);
d6bcbf1c 263#endif
46fc3d4c
PP
264 DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
265 "dl_find_symbol(handle=%lx, symbol=%s)\n",
266 (unsigned long) libhandle, symbolname));
a0d0e21e 267 RETVAL = dlsym(libhandle, symbolname);
46fc3d4c
PP
268 DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
269 " symbolref = %lx\n", (unsigned long) RETVAL));
a0d0e21e
LW
270 ST(0) = sv_newmortal() ;
271 if (RETVAL == NULL)
272 SaveError("%s",dlerror()) ;
273 else
274 sv_setiv( ST(0), (IV)RETVAL);
275
276
277void
278dl_undef_symbols()
279 PPCODE:
280
281
282
283# These functions should not need changing on any platform:
284
285void
286dl_install_xsub(perl_name, symref, filename="$Package")
287 char * perl_name
288 void * symref
289 char * filename
290 CODE:
760ac839 291 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
a0d0e21e
LW
292 perl_name, symref));
293 ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
294
295
296char *
297dl_error()
298 CODE:
299 RETVAL = LastError ;
300 OUTPUT:
301 RETVAL
302
303# end.