This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make die/warn and other diagnostics go to wherever STDERR happens
[perl5.git] / ext / DynaLoader / dl_rhapsody.xs
CommitLineData
8f1f23e8
W
1/* dl_rhapsody.xs
2 *
3 * Platform: Apple Rhapsody 5.0
4 * Based on: dl_next.xs by Paul Marquess
5 * Based on: dl_dlopen.xs by Anno Siegel
6 * Created: Aug 15th, 1994
7 *
8 */
9
10/*
11 And Gandalf said: 'Many folk like to know beforehand what is to
12 be set on the table; but those who have laboured to prepare the
13 feast like to keep their secret; for wonder makes the words of
14 praise louder.'
15*/
16
17/* Porting notes:
18
19dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It
20should not be used as a base for further ports though it may be used
21as an example for how dl_dlopen.xs can be ported to other platforms.
22
23The method used here is just to supply the sun style dlopen etc.
24functions in terms of NeXTs rld_*. The xs code proper is unchanged
25from Paul's original.
26
27The port could use some streamlining. For one, error handling could
28be simplified.
29
30Anno Siegel
31
32*/
33
34#include "EXTERN.h"
35#include "perl.h"
36#include "XSUB.h"
37
38#define DL_LOADONCEONLY
39
40#include "dlutils.c" /* SaveError() etc */
41
42#undef environ
43#import <mach-o/dyld.h>
44
45static char * dl_last_error = (char *) 0;
46static AV *dl_resolve_using = Nullav;
47
48static char *dlerror()
49{
50 return dl_last_error;
51}
52
53int dlclose(handle) /* stub only */
54void *handle;
55{
56 return 0;
57}
58
59enum dyldErrorSource
60{
61 OFImage,
62};
63
64static void TranslateError
65 (const char *path, enum dyldErrorSource type, int number)
66{
5b877257 67 dTHX;
8f1f23e8
W
68 char *error;
69 unsigned int index;
70 static char *OFIErrorStrings[] =
71 {
72 "%s(%d): Object Image Load Failure\n",
73 "%s(%d): Object Image Load Success\n",
74 "%s(%d): Not an recognisable object file\n",
75 "%s(%d): No valid architecture\n",
76 "%s(%d): Object image has an invalid format\n",
77 "%s(%d): Invalid access (permissions?)\n",
78 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
79 };
80#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
81
82 switch (type)
83 {
84 case OFImage:
85 index = number;
86 if (index > NUM_OFI_ERRORS - 1)
87 index = NUM_OFI_ERRORS - 1;
88 error = form(OFIErrorStrings[index], path, number);
89 break;
90
91 default:
92 error = form("%s(%d): Totally unknown error type %d\n",
93 path, number, type);
94 break;
95 }
96 safefree(dl_last_error);
97 dl_last_error = savepv(error);
98}
99
100static char *dlopen(char *path, int mode /* mode is ignored */)
101{
102 int dyld_result;
103 NSObjectFileImage ofile;
104 NSModule handle = NULL;
105
106 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
107 if (dyld_result != NSObjectFileImageSuccess)
108 TranslateError(path, OFImage, dyld_result);
109 else
110 {
111 // NSLinkModule will cause the run to abort on any link error's
112 // not very friendly but the error recovery functionality is limited.
113 handle = NSLinkModule(ofile, path, TRUE);
114 }
115
116 return handle;
117}
118
119void *
120dlsym(handle, symbol)
121void *handle;
122char *symbol;
123{
124 void *addr;
125
126 if (NSIsSymbolNameDefined(symbol))
127 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
128 else
129 addr = NULL;
130
131 return addr;
132}
133
134
135
136/* ----- code from dl_dlopen.xs below here ----- */
137
138
139static void
cea2e8a9 140dl_private_init(pTHX)
8f1f23e8 141{
cea2e8a9
GS
142 (void)dl_generic_private_init(aTHX);
143 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4);
8f1f23e8
W
144}
145
146MODULE = DynaLoader PACKAGE = DynaLoader
147
148BOOT:
cea2e8a9 149 (void)dl_private_init(aTHX);
8f1f23e8
W
150
151
152
153void *
154dl_load_file(filename, flags=0)
155 char * filename
156 int flags
157 PREINIT:
158 int mode = 1;
159 CODE:
bf49b057 160 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
8f1f23e8 161 if (flags & 0x01)
cea2e8a9 162 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
8f1f23e8 163 RETVAL = dlopen(filename, mode) ;
bf49b057 164 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
8f1f23e8
W
165 ST(0) = sv_newmortal() ;
166 if (RETVAL == NULL)
cea2e8a9 167 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 168 else
3175b8cd 169 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
170
171
172void *
173dl_find_symbol(libhandle, symbolname)
174 void * libhandle
175 char * symbolname
176 CODE:
177 symbolname = form("_%s", symbolname);
bf49b057 178 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
179 "dl_find_symbol(handle=%lx, symbol=%s)\n",
180 (unsigned long) libhandle, symbolname));
181 RETVAL = dlsym(libhandle, symbolname);
bf49b057 182 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
8f1f23e8
W
183 " symbolref = %lx\n", (unsigned long) RETVAL));
184 ST(0) = sv_newmortal() ;
185 if (RETVAL == NULL)
cea2e8a9 186 SaveError(aTHX_ "%s",dlerror()) ;
8f1f23e8 187 else
3175b8cd 188 sv_setiv( ST(0), PTR2IV(RETVAL) );
8f1f23e8
W
189
190
191void
192dl_undef_symbols()
193 PPCODE:
194
195
196
197# These functions should not need changing on any platform:
198
199void
200dl_install_xsub(perl_name, symref, filename="$Package")
201 char * perl_name
202 void * symref
203 char * filename
204 CODE:
bf49b057 205 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
8f1f23e8 206 perl_name, symref));
cea2e8a9
GS
207 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
208 (void(*)(pTHX_ CV *))symref,
209 filename)));
8f1f23e8
W
210
211
212char *
213dl_error()
214 CODE:
215 RETVAL = LastError ;
216 OUTPUT:
217 RETVAL
218
219+# end.