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
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.
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
27 The port could use some streamlining. For one, error handling could
34 #if NS_TARGET_MAJOR >= 4
36 /* include these before perl headers */
37 #include <mach-o/rld.h>
38 #include <streams/streams.h>
45 #define DL_LOADONCEONLY
49 } my_cxtx_t; /* this *must* be named my_cxtx_t */
51 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
52 #include "dlutils.c" /* SaveError() etc */
54 #define dl_resolve_using (dl_cxtx.x_resolve_using)
56 static char *dlerror()
63 int dlclose(handle) /* stub only */
69 #if NS_TARGET_MAJOR >= 4
70 #import <mach-o/dyld.h>
77 static void TranslateError
78 (const char *path, enum dyldErrorSource type, int number)
84 static char *OFIErrorStrings[] =
86 "%s(%d): Object Image Load Failure\n",
87 "%s(%d): Object Image Load Success\n",
88 "%s(%d): Not a recognisable object file\n",
89 "%s(%d): No valid architecture\n",
90 "%s(%d): Object image has an invalid format\n",
91 "%s(%d): Invalid access (permissions?)\n",
92 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
94 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
100 if (index > NUM_OFI_ERRORS - 1)
101 index = NUM_OFI_ERRORS - 1;
102 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
106 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
110 Safefree(dl_last_error);
111 dl_last_error = savepv(error);
114 static char *dlopen(char *path, int mode /* mode is ignored */)
117 NSObjectFileImage ofile;
118 NSModule handle = NULL;
120 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
121 if (dyld_result != NSObjectFileImageSuccess)
122 TranslateError(path, OFImage, dyld_result);
125 // NSLinkModule will cause the run to abort on any link error's
126 // not very friendly but the error recovery functionality is limited.
127 handle = NSLinkModule(ofile, path, TRUE);
134 dlsym(handle, symbol)
140 if (NSIsSymbolNameDefined(symbol))
141 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
148 #else /* NS_TARGET_MAJOR <= 3 */
150 static NXStream *OpenError(void)
152 return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
155 static void TransferError(NXStream *s)
162 if ( dl_last_error ) {
163 Safefree(dl_last_error);
165 NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
166 Newx(dl_last_error, len, char);
167 strcpy(dl_last_error, buffer);
170 static void CloseError(NXStream *s)
173 NXCloseMemory( s, NX_FREEBUFFER);
177 static char *dlopen(char *path, int mode /* mode is ignored */)
188 /* Do not load what is already loaded into this process */
189 if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
193 psize = AvFILL(dl_resolve_using) + 3;
194 p = (char **) safemalloc(psize * sizeof(char*));
196 for(i=1; i<psize-1; i++) {
197 p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
200 rld_success = rld_load(nxerr, (struct mach_header **)0, p,
205 /* prevent multiple loads of same file into same process */
206 hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
208 TransferError(nxerr);
216 dlsym(handle, symbol)
220 NXStream *nxerr = OpenError();
221 unsigned long symref = 0;
223 if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref))
224 TransferError(nxerr);
226 return (void*) symref;
229 #endif /* NS_TARGET_MAJOR >= 4 */
232 /* ----- code from dl_dlopen.xs below here ----- */
236 dl_private_init(pTHX)
238 (void)dl_generic_private_init(aTHX);
241 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
245 MODULE = DynaLoader PACKAGE = DynaLoader
248 (void)dl_private_init(aTHX);
253 dl_load_file(filename, flags=0)
259 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
261 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
262 RETVAL = dlopen(filename, mode) ;
263 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
264 ST(0) = sv_newmortal() ;
266 SaveError(aTHX_ "%s",dlerror()) ;
268 sv_setiv( ST(0), PTR2IV(RETVAL) );
272 dl_find_symbol(libhandle, symbolname)
276 #if NS_TARGET_MAJOR >= 4
277 symbolname = Perl_form_nocontext("_%s", symbolname);
279 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
280 "dl_find_symbol(handle=%lx, symbol=%s)\n",
281 (unsigned long) libhandle, symbolname));
282 RETVAL = dlsym(libhandle, symbolname);
283 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
284 " symbolref = %lx\n", (unsigned long) RETVAL));
285 ST(0) = sv_newmortal() ;
287 SaveError(aTHX_ "%s",dlerror()) ;
289 sv_setiv( ST(0), PTR2IV(RETVAL) );
298 # These functions should not need changing on any platform:
301 dl_install_xsub(perl_name, symref, filename="$Package")
306 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
308 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
309 (void(*)(pTHX_ CV *))symref,
311 XS_DYNAMIC_FILENAME)));
318 RETVAL = dl_last_error ;