This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Rhapsody/Darwin patches from Wilfredo Sanchez.
[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
44#define DL_LOADONCEONLY
45
46#include "dlutils.c" /* SaveError() etc */
47
48#undef environ
f556e5b9 49#undef bool
8f1f23e8
W
50#import <mach-o/dyld.h>
51
52static char * dl_last_error = (char *) 0;
53static AV *dl_resolve_using = Nullav;
54
55static char *dlerror()
56{
57 return dl_last_error;
58}
59
60int dlclose(handle) /* stub only */
61void *handle;
62{
63 return 0;
64}
65
66enum dyldErrorSource
67{
68 OFImage,
69};
70
71static void TranslateError
72 (const char *path, enum dyldErrorSource type, int number)
73{
5b877257 74 dTHX;
8f1f23e8
W
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 an 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;
7a3f2258 95 error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
8f1f23e8
W
96 break;
97
98 default:
7a3f2258 99 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
8f1f23e8
W
100 path, number, type);
101 break;
102 }
103 safefree(dl_last_error);
104 dl_last_error = savepv(error);
105}
106
107static char *dlopen(char *path, int mode /* mode is ignored */)
108{
109 int dyld_result;
110 NSObjectFileImage ofile;
111 NSModule handle = NULL;
112
113 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
114 if (dyld_result != NSObjectFileImageSuccess)
115 TranslateError(path, OFImage, dyld_result);
116 else
117 {
118 // NSLinkModule will cause the run to abort on any link error's
119 // not very friendly but the error recovery functionality is limited.
120 handle = NSLinkModule(ofile, path, TRUE);
121 }
122
123 return handle;
124}
125
126void *
127dlsym(handle, symbol)
128void *handle;
129char *symbol;
130{
131 void *addr;
132
133 if (NSIsSymbolNameDefined(symbol))
134 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
135 else
136 addr = NULL;
137
138 return addr;
139}
140
141
142
143/* ----- code from dl_dlopen.xs below here ----- */
144
145
146static void
cea2e8a9 147dl_private_init(pTHX)
8f1f23e8 148{
cea2e8a9 149 (void)dl_generic_private_init(aTHX);
a7a8d5a9 150 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
8f1f23e8
W
151}
152
153MODULE = DynaLoader PACKAGE = DynaLoader
154
155BOOT:
cea2e8a9 156 (void)dl_private_init(aTHX);
8f1f23e8
W
157
158
159
160void *
161dl_load_file(filename, flags=0)
162 char * filename
163 int flags
164 PREINIT:
165 int mode = 1;
166 CODE:
bf49b057 167 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
8f1f23e8 168 if (flags & 0x01)
cea2e8a9 169 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
8f1f23e8 170 RETVAL = dlopen(filename, mode) ;
bf49b057 171 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
8f1f23e8
W
172 ST(0) = sv_newmortal() ;
173 if (RETVAL == NULL)
cea2e8a9 174 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 175 else
3175b8cd 176 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
177
178
179void *
180dl_find_symbol(libhandle, symbolname)
181 void * libhandle
182 char * symbolname
183 CODE:
7a3f2258 184 symbolname = Perl_form_nocontext("_%s", symbolname);
bf49b057 185 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
186 "dl_find_symbol(handle=%lx, symbol=%s)\n",
187 (unsigned long) libhandle, symbolname));
188 RETVAL = dlsym(libhandle, symbolname);
bf49b057 189 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
190 " symbolref = %lx\n", (unsigned long) RETVAL));
191 ST(0) = sv_newmortal() ;
192 if (RETVAL == NULL)
cea2e8a9 193 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 194 else
3175b8cd 195 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
196
197
198void
199dl_undef_symbols()
200 PPCODE:
201
202
203
204# These functions should not need changing on any platform:
205
206void
207dl_install_xsub(perl_name, symref, filename="$Package")
208 char * perl_name
209 void * symref
210 char * filename
211 CODE:
bf49b057 212 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
8f1f23e8 213 perl_name, symref));
cea2e8a9
GS
214 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
215 (void(*)(pTHX_ CV *))symref,
216 filename)));
8f1f23e8
W
217
218
219char *
220dl_error()
221 CODE:
222 RETVAL = LastError ;
223 OUTPUT:
224 RETVAL
225
f556e5b9 226# end.