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
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
19 dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
20 should not be used as a base for further ports though it may be used
21 as an example for how dl_dlopen.xs can be ported to other platforms.
22
23 The method used here is just to supply the sun style dlopen etc.
24 functions in terms of NeXTs rld_*.  The xs code proper is unchanged
25 from Paul's original.
26
27 The port could use some streamlining.  For one, error handling could
28 be simplified.
29
30 Anno 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
45 static char * dl_last_error = (char *) 0;
46 static AV *dl_resolve_using = Nullav;
47
48 static char *dlerror()
49 {
50     return dl_last_error;
51 }
52
53 int dlclose(handle) /* stub only */
54 void *handle;
55 {
56     return 0;
57 }
58
59 enum dyldErrorSource
60 {
61     OFImage,
62 };
63
64 static void TranslateError
65     (const char *path, enum dyldErrorSource type, int number)
66 {
67     dTHX;
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
100 static 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
119 void *
120 dlsym(handle, symbol)
121 void *handle;
122 char *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
139 static void
140 dl_private_init(pTHX)
141 {
142     (void)dl_generic_private_init(aTHX);
143     dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4);
144 }
145
146 MODULE = DynaLoader     PACKAGE = DynaLoader
147
148 BOOT:
149     (void)dl_private_init(aTHX);
150
151
152
153 void *
154 dl_load_file(filename, flags=0)
155     char *      filename
156     int         flags
157     PREINIT:
158     int mode = 1;
159     CODE:
160     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
161     if (flags & 0x01)
162         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
163     RETVAL = dlopen(filename, mode) ;
164     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
165     ST(0) = sv_newmortal() ;
166     if (RETVAL == NULL)
167         SaveError(aTHX_ "%s",dlerror()) ;
168     else
169         sv_setiv( ST(0), PTR2IV(RETVAL) );
170
171
172 void *
173 dl_find_symbol(libhandle, symbolname)
174     void *              libhandle
175     char *              symbolname
176     CODE:
177     symbolname = form("_%s", symbolname);
178     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
179                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
180                              (unsigned long) libhandle, symbolname));
181     RETVAL = dlsym(libhandle, symbolname);
182     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
183                              "  symbolref = %lx\n", (unsigned long) RETVAL));
184     ST(0) = sv_newmortal() ;
185     if (RETVAL == NULL)
186         SaveError(aTHX_ "%s",dlerror()) ;
187     else
188         sv_setiv( ST(0), PTR2IV(RETVAL) );
189
190
191 void
192 dl_undef_symbols()
193     PPCODE:
194
195
196
197 # These functions should not need changing on any platform:
198
199 void
200 dl_install_xsub(perl_name, symref, filename="$Package")
201     char *      perl_name
202     void *      symref
203     char *      filename
204     CODE:
205     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
206             perl_name, symref));
207     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
208                                         (void(*)(pTHX_ CV *))symref,
209                                         filename)));
210
211
212 char *
213 dl_error()
214     CODE:
215     RETVAL = LastError ;
216     OUTPUT:
217     RETVAL
218
219 +# end.