3 * Platform: Darwin (Mac OS)
4 * Author: Wilfredo Sanchez <wsanchez@apple.com>
5 * Based on: dl_next.xs by Paul Marquess
6 * Based on: dl_dlopen.xs by Anno Siegel
7 * Created: Aug 15th, 1994
12 * And Gandalf said: 'Many folk like to know beforehand what is to
13 * be set on the table; but those who have laboured to prepare the
14 * feast like to keep their secret; for wonder makes the words of
17 * [p.970 of _The Lord of the Rings_, VI/v: "The Steward and the King"]
22 dl_dyld.xs is based on dl_next.xs by Anno Siegel.
24 dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It
25 should not be used as a base for further ports though it may be used
26 as an example for how dl_dlopen.xs can be ported to other platforms.
28 The method used here is just to supply the sun style dlopen etc.
29 functions in terms of NeXT's/Apple's dyld. The xs code proper is
30 unchanged from Paul's original.
32 The port could use some streamlining. For one, error handling could
35 This should be useable as a replacement for dl_next.xs, but it has not
36 been tested on NeXT platforms.
46 #include "dlutils.c" /* for SaveError() etc */
50 #import <mach-o/dyld.h>
52 static char *dlerror()
59 static int dlclose(void *handle) /* stub only */
69 static void TranslateError
70 (const char *path, enum dyldErrorSource type, int number)
76 static char *OFIErrorStrings[] =
78 "%s(%d): Object Image Load Failure\n",
79 "%s(%d): Object Image Load Success\n",
80 "%s(%d): Not a recognisable object file\n",
81 "%s(%d): No valid architecture\n",
82 "%s(%d): Object image has an invalid format\n",
83 "%s(%d): Invalid access (permissions?)\n",
84 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
86 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
92 if (index > NUM_OFI_ERRORS - 1)
93 index = NUM_OFI_ERRORS - 1;
94 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
98 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
102 sv_setpv(MY_CXT.x_dl_last_error, error);
105 static char *dlopen(char *path, int mode /* mode is ignored */)
108 NSObjectFileImage ofile;
109 NSModule handle = NULL;
111 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
112 if (dyld_result != NSObjectFileImageSuccess)
113 TranslateError(path, OFImage, dyld_result);
116 // NSLinkModule will cause the run to abort on any link errors
117 // not very friendly but the error recovery functionality is limited.
118 handle = NSLinkModule(ofile, path, TRUE);
119 NSDestroyObjectFileImage(ofile);
126 dlsym(void *handle, char *symbol)
130 if (NSIsSymbolNameDefined(symbol))
131 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
140 /* ----- code from dl_dlopen.xs below here ----- */
144 dl_private_init(pTHX)
146 (void)dl_generic_private_init(aTHX);
149 MODULE = DynaLoader PACKAGE = DynaLoader
152 (void)dl_private_init(aTHX);
157 dl_load_file(filename, flags=0)
163 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
165 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
166 RETVAL = dlopen(filename, mode) ;
167 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
168 ST(0) = sv_newmortal() ;
170 SaveError(aTHX_ "%s",dlerror()) ;
172 sv_setiv( ST(0), PTR2IV(RETVAL) );
176 dl_find_symbol(libhandle, symbolname)
180 symbolname = Perl_form_nocontext("_%s", symbolname);
181 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
182 "dl_find_symbol(handle=%lx, symbol=%s)\n",
183 (unsigned long) libhandle, symbolname));
184 RETVAL = dlsym(libhandle, symbolname);
185 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
186 " symbolref = %lx\n", (unsigned long) RETVAL));
187 ST(0) = sv_newmortal() ;
189 SaveError(aTHX_ "%s",dlerror()) ;
191 sv_setiv( ST(0), PTR2IV(RETVAL) );
200 # These functions should not need changing on any platform:
203 dl_install_xsub(perl_name, symref, filename="$Package")
206 const char * filename
208 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
210 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
211 (void(*)(pTHX_ CV *))symref,
213 XS_DYNAMIC_FILENAME)));
220 RETVAL = dl_last_error ;
224 #if defined(USE_ITHREADS)
231 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
232 * using Perl variables that belong to another thread, we create our
233 * own for this thread.
235 MY_CXT.x_dl_last_error = newSVpvn("", 0);