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