This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_dyld.xs
CommitLineData
f556e5b9 1/* dl_dyld.xs
8f1f23e8 2 *
f556e5b9
JH
3 * Platform: Darwin (Mac OS)
4 * Author: Wilfredo Sanchez <wsanchez@apple.com>
8f1f23e8
W
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
f556e5b9
JH
20dl_dyld.xs is based on dl_next.xs by Anno Siegel.
21
22dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess. It
8f1f23e8
W
23should not be used as a base for further ports though it may be used
24as an example for how dl_dlopen.xs can be ported to other platforms.
25
26The method used here is just to supply the sun style dlopen etc.
f556e5b9
JH
27functions in terms of NeXT's/Apple's dyld. The xs code proper is
28unchanged from Paul's original.
8f1f23e8
W
29
30The port could use some streamlining. For one, error handling could
31be simplified.
32
f556e5b9
JH
33This should be useable as a replacement for dl_next.xs, but it has not
34been tested on NeXT platforms.
35
36 Wilfredo Sanchez
8f1f23e8
W
37
38*/
39
40#include "EXTERN.h"
41#include "perl.h"
42#include "XSUB.h"
43
cdc73a10 44#include "dlutils.c" /* for SaveError() etc */
8f1f23e8
W
45
46#undef environ
f556e5b9 47#undef bool
8f1f23e8
W
48#import <mach-o/dyld.h>
49
8f1f23e8
W
50static char *dlerror()
51{
cdc73a10
JH
52 dTHX;
53 dMY_CXT;
8f1f23e8
W
54 return dl_last_error;
55}
56
2ec6e385 57static int dlclose(void *handle) /* stub only */
8f1f23e8
W
58{
59 return 0;
60}
61
62enum dyldErrorSource
63{
64 OFImage,
65};
66
67static void TranslateError
68 (const char *path, enum dyldErrorSource type, int number)
69{
5b877257 70 dTHX;
cdc73a10 71 dMY_CXT;
8f1f23e8
W
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",
d1be9408 78 "%s(%d): Not a recognisable object file\n",
8f1f23e8
W
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;
7a3f2258 92 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
8f1f23e8
W
93 break;
94
95 default:
7a3f2258 96 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
8f1f23e8
W
97 path, number, type);
98 break;
99 }
379d1ffd 100 sv_setpv(MY_CXT.x_dl_last_error, error);
8f1f23e8
W
101}
102
103static 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 {
03f6ae00 114 // NSLinkModule will cause the run to abort on any link errors
8f1f23e8
W
115 // not very friendly but the error recovery functionality is limited.
116 handle = NSLinkModule(ofile, path, TRUE);
bb2834fe 117 NSDestroyObjectFileImage(ofile);
8f1f23e8
W
118 }
119
120 return handle;
121}
122
a97fb7de 123static void *
2ec6e385 124dlsym(void *handle, char *symbol)
8f1f23e8
W
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
141static void
cea2e8a9 142dl_private_init(pTHX)
8f1f23e8 143{
cea2e8a9 144 (void)dl_generic_private_init(aTHX);
8f1f23e8
W
145}
146
147MODULE = DynaLoader PACKAGE = DynaLoader
148
149BOOT:
cea2e8a9 150 (void)dl_private_init(aTHX);
8f1f23e8
W
151
152
153
154void *
155dl_load_file(filename, flags=0)
156 char * filename
157 int flags
158 PREINIT:
159 int mode = 1;
160 CODE:
bf49b057 161 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
8f1f23e8 162 if (flags & 0x01)
cea2e8a9 163 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
8f1f23e8 164 RETVAL = dlopen(filename, mode) ;
bf49b057 165 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
8f1f23e8
W
166 ST(0) = sv_newmortal() ;
167 if (RETVAL == NULL)
cea2e8a9 168 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 169 else
3175b8cd 170 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
171
172
173void *
174dl_find_symbol(libhandle, symbolname)
175 void * libhandle
176 char * symbolname
177 CODE:
7a3f2258 178 symbolname = Perl_form_nocontext("_%s", symbolname);
bf49b057 179 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
180 "dl_find_symbol(handle=%lx, symbol=%s)\n",
181 (unsigned long) libhandle, symbolname));
182 RETVAL = dlsym(libhandle, symbolname);
bf49b057 183 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
184 " symbolref = %lx\n", (unsigned long) RETVAL));
185 ST(0) = sv_newmortal() ;
186 if (RETVAL == NULL)
cea2e8a9 187 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 188 else
3175b8cd 189 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
190
191
192void
193dl_undef_symbols()
194 PPCODE:
195
196
197
198# These functions should not need changing on any platform:
199
200void
201dl_install_xsub(perl_name, symref, filename="$Package")
202 char * perl_name
203 void * symref
204 char * filename
205 CODE:
bf49b057 206 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
8f1f23e8 207 perl_name, symref));
77004dee
NC
208 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
209 (void(*)(pTHX_ CV *))symref,
210 filename, NULL,
211 XS_DYNAMIC_FILENAME)));
8f1f23e8
W
212
213
214char *
215dl_error()
216 CODE:
cdc73a10
JH
217 dMY_CXT;
218 RETVAL = dl_last_error ;
8f1f23e8
W
219 OUTPUT:
220 RETVAL
221
f556e5b9 222# end.