1 /* dl_dyld.xs
2 *
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
8 *
9 */
10
11 /*
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
15 * praise louder.'
16 *
17 * [p.970 of _The Lord of the Rings_, VI/v: "The Steward and the King"]
18 */
19
20 /* Porting notes:
21
22 dl_dyld.xs is based on dl_next.xs by Anno Siegel.
23
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.
27
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.
31
32 The port could use some streamlining. For one, error handling could
33 be simplified.
34
35 This should be useable as a replacement for dl_next.xs, but it has not
36 been tested on NeXT platforms.
37
38 Wilfredo Sanchez
39
40 */
41
42 #define PERL_EXT
43 #include "EXTERN.h"
44 #define PERL_IN_DL_DYLD_XS
45 #include "perl.h"
46 #include "XSUB.h"
47
48 #include "dlutils.c" /* for SaveError() etc */
49
50 #undef environ
51 #import <mach-o/dyld.h>
52
dlerror()53 static char *dlerror()
54 {
55 dTHX;
56 dMY_CXT;
57 return dl_last_error;
58 }
59
dlclose(void * handle)60 static int dlclose(void *handle) /* stub only */
61 {
62 return 0;
63 }
64
65 enum dyldErrorSource
66 {
67 OFImage,
68 };
69
TranslateError(const char * path,enum dyldErrorSource type,int number)70 static void TranslateError
71 (const char *path, enum dyldErrorSource type, int number)
72 {
73 dTHX;
74 dMY_CXT;
75 char *error;
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 a 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
89 switch (type)
90 {
91 case OFImage:
92 index = number;
93 if (index > NUM_OFI_ERRORS - 1)
94 index = NUM_OFI_ERRORS - 1;
95 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
96 break;
97
98 default:
99 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
100 path, number, type);
101 break;
102 }
103 sv_setpv(MY_CXT.x_dl_last_error, error);
104 }
105
dlopen(char * path)106 static char *dlopen(char *path)
107 {
108 int dyld_result;
109 NSObjectFileImage ofile;
110 NSModule handle = NULL;
111
112 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
113 if (dyld_result != NSObjectFileImageSuccess)
114 TranslateError(path, OFImage, dyld_result);
115 else
116 {
117 // NSLinkModule will cause the run to abort on any link errors
118 // not very friendly but the error recovery functionality is limited.
119 handle = NSLinkModule(ofile, path, TRUE);
120 NSDestroyObjectFileImage(ofile);
121 }
122
123 return handle;
124 }
125
126 static void *
dlsym(void * handle,char * symbol)127 dlsym(void *handle, char *symbol)
128 {
129 void *addr;
130
131 if (NSIsSymbolNameDefined(symbol))
132 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
133 else
134 addr = NULL;
135
136 return addr;
137 }
138
139
140
141 /* ----- code from dl_dlopen.xs below here ----- */
142
143
144 static void
dl_private_init(pTHX)145 dl_private_init(pTHX)
146 {
147 (void)dl_generic_private_init(aTHX);
148 }
149
150 MODULE = DynaLoader PACKAGE = DynaLoader
151
152 BOOT:
153 (void)dl_private_init(aTHX);
154
155
156
157 void *
158 dl_load_file(filename, flags=0)
159 char * filename
160 int flags
161 CODE:
162 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
163 if (flags & 0x01)
164 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
165 RETVAL = dlopen(filename);
166 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
167 ST(0) = newSV_type_mortal(SVt_IV);
168 if (RETVAL == NULL)
169 SaveError(aTHX_ "%s",dlerror()) ;
170 else
171 sv_setiv( ST(0), PTR2IV(RETVAL) );
172
173
174 void *
175 dl_find_symbol(libhandle, symbolname, ign_err=0)
176 void * libhandle
177 char * symbolname
178 int ign_err
179 CODE:
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) = newSV_type_mortal(SVt_IV);
188 if (RETVAL == NULL) {
189 if (!ign_err)
190 SaveError(aTHX_ "%s",dlerror()) ;
191 } else
192 sv_setiv( ST(0), PTR2IV(RETVAL) );
193
194
195 void
196 dl_undef_symbols()
197 PPCODE:
198
199
200
201 # These functions should not need changing on any platform:
202
203 void
204 dl_install_xsub(perl_name, symref, filename="$Package")
205 char * perl_name
206 void * symref
207 const char * filename
208 CODE:
209 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
210 perl_name, symref));
211 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
212 (void(*)(pTHX_ CV *))symref,
213 filename, NULL,
214 XS_DYNAMIC_FILENAME)));
215
216
217 SV *
218 dl_error()
219 CODE:
220 dMY_CXT;
221 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
222 OUTPUT:
223 RETVAL
224
225 #if defined(USE_ITHREADS)
226
227 void
228 CLONE(...)
229 CODE:
230 MY_CXT_CLONE;
231
232 PERL_UNUSED_VAR(items);
233
234 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
235 * using Perl variables that belong to another thread, we create our
236 * own for this thread.
237 */
238 MY_CXT.x_dl_last_error = newSVpvs("");
239
240 #endif
241
242 # end.
243