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
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
16 * [p.970 of _The Lord of the Rings_, VI/v: "The Steward and the King"]
21 dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It
22 should not be used as a base for further ports though it may be used
23 as an example for how dl_dlopen.xs can be ported to other platforms.
25 The method used here is just to supply the sun style dlopen etc.
26 functions in terms of NeXTs rld_*. The xs code proper is unchanged
29 The port could use some streamlining. For one, error handling could
36 #if NS_TARGET_MAJOR >= 4
38 /* include these before perl headers */
39 #include <mach-o/rld.h>
40 #include <streams/streams.h>
47 #define DL_LOADONCEONLY
51 } my_cxtx_t; /* this *must* be named my_cxtx_t */
53 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
54 #include "dlutils.c" /* SaveError() etc */
56 #define dl_resolve_using (dl_cxtx.x_resolve_using)
58 static char *dlerror()
65 int dlclose(handle) /* stub only */
71 #if NS_TARGET_MAJOR >= 4
72 #import <mach-o/dyld.h>
79 static void TranslateError
80 (const char *path, enum dyldErrorSource type, int number)
86 static char *OFIErrorStrings[] =
88 "%s(%d): Object Image Load Failure\n",
89 "%s(%d): Object Image Load Success\n",
90 "%s(%d): Not a recognisable object file\n",
91 "%s(%d): No valid architecture\n",
92 "%s(%d): Object image has an invalid format\n",
93 "%s(%d): Invalid access (permissions?)\n",
94 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
96 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
102 if (index > NUM_OFI_ERRORS - 1)
103 index = NUM_OFI_ERRORS - 1;
104 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
108 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
112 Safefree(dl_last_error);
113 dl_last_error = savepv(error);
116 static char *dlopen(char *path, int mode /* mode is ignored */)
119 NSObjectFileImage ofile;
120 NSModule handle = NULL;
122 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
123 if (dyld_result != NSObjectFileImageSuccess)
124 TranslateError(path, OFImage, dyld_result);
127 // NSLinkModule will cause the run to abort on any link error's
128 // not very friendly but the error recovery functionality is limited.
129 handle = NSLinkModule(ofile, path, TRUE);
136 dlsym(handle, symbol)
142 if (NSIsSymbolNameDefined(symbol))
143 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
150 #else /* NS_TARGET_MAJOR <= 3 */
152 static NXStream *OpenError(void)
154 return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
157 static void TransferError(NXStream *s)
164 if ( dl_last_error ) {
165 Safefree(dl_last_error);
167 NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
168 Newx(dl_last_error, len, char);
169 strcpy(dl_last_error, buffer);
172 static void CloseError(NXStream *s)
175 NXCloseMemory( s, NX_FREEBUFFER);
179 static char *dlopen(char *path, int mode /* mode is ignored */)
190 /* Do not load what is already loaded into this process */
191 if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
195 psize = AvFILL(dl_resolve_using) + 3;
196 p = (char **) safemalloc(psize * sizeof(char*));
198 for(i=1; i<psize-1; i++) {
199 p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
202 rld_success = rld_load(nxerr, (struct mach_header **)0, p,
207 /* prevent multiple loads of same file into same process */
208 hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
210 TransferError(nxerr);
218 dlsym(handle, symbol)
222 NXStream *nxerr = OpenError();
223 unsigned long symref = 0;
225 if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref))
226 TransferError(nxerr);
228 return (void*) symref;
231 #endif /* NS_TARGET_MAJOR >= 4 */
234 /* ----- code from dl_dlopen.xs below here ----- */
238 dl_private_init(pTHX)
240 (void)dl_generic_private_init(aTHX);
243 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
247 MODULE = DynaLoader PACKAGE = DynaLoader
250 (void)dl_private_init(aTHX);
255 dl_load_file(filename, flags=0)
261 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
263 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
264 RETVAL = dlopen(filename, mode) ;
265 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
266 ST(0) = sv_newmortal() ;
268 SaveError(aTHX_ "%s",dlerror()) ;
270 sv_setiv( ST(0), PTR2IV(RETVAL) );
274 dl_find_symbol(libhandle, symbolname)
278 #if NS_TARGET_MAJOR >= 4
279 symbolname = Perl_form_nocontext("_%s", symbolname);
281 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
282 "dl_find_symbol(handle=%lx, symbol=%s)\n",
283 (unsigned long) libhandle, symbolname));
284 RETVAL = dlsym(libhandle, symbolname);
285 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
286 " symbolref = %lx\n", (unsigned long) RETVAL));
287 ST(0) = sv_newmortal() ;
289 SaveError(aTHX_ "%s",dlerror()) ;
291 sv_setiv( ST(0), PTR2IV(RETVAL) );
300 # These functions should not need changing on any platform:
303 dl_install_xsub(perl_name, symref, filename="$Package")
306 const char * filename
308 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
310 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
311 (void(*)(pTHX_ CV *))symref,
313 XS_DYNAMIC_FILENAME)));
320 RETVAL = dl_last_error ;
324 #if defined(USE_ITHREADS)
331 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
332 * using Perl variables that belong to another thread, we create our
333 * own for this thread.
335 MY_CXT.x_dl_last_error = newSVpvn("", 0);
336 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);