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
18 /* Porting notes:
19
20 dl_dyld.xs is based on dl_next.xs by Anno Siegel.
21
22 dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It
23 should not be used as a base for further ports though it may be used
24 as an example for how dl_dlopen.xs can be ported to other platforms.
25
26 The method used here is just to supply the sun style dlopen etc.
27 functions in terms of NeXT's/Apple's dyld. The xs code proper is
28 unchanged from Paul's original.
29
30 The port could use some streamlining. For one, error handling could
31 be simplified.
32
33 This should be useable as a replacement for dl_next.xs, but it has not
34 been tested on NeXT platforms.
35
36 Wilfredo Sanchez
37
38 */
39
40 #include "EXTERN.h"
41 #include "perl.h"
42 #include "XSUB.h"
43
44 #include "dlutils.c" /* for SaveError() etc */
45
46 #undef environ
47 #undef bool
48 #import <mach-o/dyld.h>
49
dlerror()50 static char *dlerror()
51 {
52 dTHX;
53 dMY_CXT;
54 return dl_last_error;
55 }
56
dlclose(void * handle)57 static int dlclose(void *handle) /* stub only */
58 {
59 return 0;
60 }
61
62 enum dyldErrorSource
63 {
64 OFImage,
65 };
66
TranslateError(const char * path,enum dyldErrorSource type,int number)67 static void TranslateError
68 (const char *path, enum dyldErrorSource type, int number)
69 {
70 dTHX;
71 dMY_CXT;
72 char *error;
73 unsigned int index;
74 static char *OFIErrorStrings[] =
75 {
76 "%s(%d): Object Image Load Failure\n",
77 "%s(%d): Object Image Load Success\n",
78 "%s(%d): Not a recognisable object file\n",
79 "%s(%d): No valid architecture\n",
80 "%s(%d): Object image has an invalid format\n",
81 "%s(%d): Invalid access (permissions?)\n",
82 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
83 };
84 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
85
86 switch (type)
87 {
88 case OFImage:
89 index = number;
90 if (index > NUM_OFI_ERRORS - 1)
91 index = NUM_OFI_ERRORS - 1;
92 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
93 break;
94
95 default:
96 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
97 path, number, type);
98 break;
99 }
100 sv_setpv(MY_CXT.x_dl_last_error, error);
101 }
102
dlopen(char * path,int mode)103 static char *dlopen(char *path, int mode /* mode is ignored */)
104 {
105 int dyld_result;
106 NSObjectFileImage ofile;
107 NSModule handle = NULL;
108
109 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
110 if (dyld_result != NSObjectFileImageSuccess)
111 TranslateError(path, OFImage, dyld_result);
112 else
113 {
114 // NSLinkModule will cause the run to abort on any link errors
115 // not very friendly but the error recovery functionality is limited.
116 handle = NSLinkModule(ofile, path, TRUE);
117 NSDestroyObjectFileImage(ofile);
118 }
119
120 return handle;
121 }
122
123 static void *
dlsym(void * handle,char * symbol)124 dlsym(void *handle, char *symbol)
125 {
126 void *addr;
127
128 if (NSIsSymbolNameDefined(symbol))
129 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
130 else
131 addr = NULL;
132
133 return addr;
134 }
135
136
137
138 /* ----- code from dl_dlopen.xs below here ----- */
139
140
141 static void
dl_private_init(pTHX)142 dl_private_init(pTHX)
143 {
144 (void)dl_generic_private_init(aTHX);
145 }
146
147 MODULE = DynaLoader PACKAGE = DynaLoader
148
149 BOOT:
150 (void)dl_private_init(aTHX);
151
152
153
154 void *
155 dl_load_file(filename, flags=0)
156 char * filename
157 int flags
158 PREINIT:
159 int mode = 1;
160 CODE:
161 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
162 if (flags & 0x01)
163 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
164 RETVAL = dlopen(filename, mode) ;
165 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
166 ST(0) = sv_newmortal() ;
167 if (RETVAL == NULL)
168 SaveError(aTHX_ "%s",dlerror()) ;
169 else
170 sv_setiv( ST(0), PTR2IV(RETVAL) );
171
172
173 void *
174 dl_find_symbol(libhandle, symbolname)
175 void * libhandle
176 char * symbolname
177 CODE:
178 symbolname = Perl_form_nocontext("_%s", symbolname);
179 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
180 "dl_find_symbol(handle=%lx, symbol=%s)\n",
181 (unsigned long) libhandle, symbolname));
182 RETVAL = dlsym(libhandle, symbolname);
183 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
184 " symbolref = %lx\n", (unsigned long) RETVAL));
185 ST(0) = sv_newmortal() ;
186 if (RETVAL == NULL)
187 SaveError(aTHX_ "%s",dlerror()) ;
188 else
189 sv_setiv( ST(0), PTR2IV(RETVAL) );
190
191
192 void
193 dl_undef_symbols()
194 PPCODE:
195
196
197
198 # These functions should not need changing on any platform:
199
200 void
201 dl_install_xsub(perl_name, symref, filename="$Package")
202 char * perl_name
203 void * symref
204 char * filename
205 CODE:
206 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
207 perl_name, symref));
208 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
209 (void(*)(pTHX_ CV *))symref,
210 filename)));
211
212
213 char *
214 dl_error()
215 CODE:
216 dMY_CXT;
217 RETVAL = dl_last_error ;
218 OUTPUT:
219 RETVAL
220
221 # end.
222