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 #define PERL_EXT 43 #include "EXTERN.h" 44 #define PERL_IN_DL_DYLD_XS 45 #include "perl.h" 46 #include "XSUB.h" 47 48 #include "dlutils.c" /* for SaveError() etc */ 49 50 #undef environ 51 #undef bool 52 #import <mach-o/dyld.h> 53 54 static char *dlerror() 55 { 56 dTHX; 57 dMY_CXT; 58 return dl_last_error; 59 } 60 61 static int dlclose(void *handle) /* stub only */ 62 { 63 return 0; 64 } 65 66 enum dyldErrorSource 67 { 68 OFImage, 69 }; 70 71 static void TranslateError 72 (const char *path, enum dyldErrorSource type, int number) 73 { 74 dTHX; 75 dMY_CXT; 76 char *error; 77 unsigned int index; 78 static char *OFIErrorStrings[] = 79 { 80 "%s(%d): Object Image Load Failure\n", 81 "%s(%d): Object Image Load Success\n", 82 "%s(%d): Not a recognisable object file\n", 83 "%s(%d): No valid architecture\n", 84 "%s(%d): Object image has an invalid format\n", 85 "%s(%d): Invalid access (permissions?)\n", 86 "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n", 87 }; 88 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0])) 89 90 switch (type) 91 { 92 case OFImage: 93 index = number; 94 if (index > NUM_OFI_ERRORS - 1) 95 index = NUM_OFI_ERRORS - 1; 96 error = Perl_form_nocontext(OFIErrorStrings[index], path, number); 97 break; 98 99 default: 100 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", 101 path, number, type); 102 break; 103 } 104 sv_setpv(MY_CXT.x_dl_last_error, error); 105 } 106 107 static 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 errors 119 // not very friendly but the error recovery functionality is limited. 120 handle = NSLinkModule(ofile, path, TRUE); 121 NSDestroyObjectFileImage(ofile); 122 } 123 124 return handle; 125 } 126 127 static void * 128 dlsym(void *handle, char *symbol) 129 { 130 void *addr; 131 132 if (NSIsSymbolNameDefined(symbol)) 133 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol)); 134 else 135 addr = NULL; 136 137 return addr; 138 } 139 140 141 142 /* ----- code from dl_dlopen.xs below here ----- */ 143 144 145 static void 146 dl_private_init(pTHX) 147 { 148 (void)dl_generic_private_init(aTHX); 149 } 150 151 MODULE = DynaLoader PACKAGE = DynaLoader 152 153 BOOT: 154 (void)dl_private_init(aTHX); 155 156 157 158 void * 159 dl_load_file(filename, flags=0) 160 char * filename 161 int flags 162 PREINIT: 163 int mode = 1; 164 CODE: 165 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 166 if (flags & 0x01) 167 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 168 RETVAL = dlopen(filename, mode) ; 169 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); 170 ST(0) = sv_newmortal() ; 171 if (RETVAL == NULL) 172 SaveError(aTHX_ "%s",dlerror()) ; 173 else 174 sv_setiv( ST(0), PTR2IV(RETVAL) ); 175 176 177 void * 178 dl_find_symbol(libhandle, symbolname, ign_err=0) 179 void * libhandle 180 char * symbolname 181 int ign_err 182 CODE: 183 symbolname = Perl_form_nocontext("_%s", symbolname); 184 DLDEBUG(2, PerlIO_printf(Perl_debug_log, 185 "dl_find_symbol(handle=%lx, symbol=%s)\n", 186 (unsigned long) libhandle, symbolname)); 187 RETVAL = dlsym(libhandle, symbolname); 188 DLDEBUG(2, PerlIO_printf(Perl_debug_log, 189 " symbolref = %lx\n", (unsigned long) RETVAL)); 190 ST(0) = sv_newmortal() ; 191 if (RETVAL == NULL) { 192 if (!ign_err) 193 SaveError(aTHX_ "%s",dlerror()) ; 194 } else 195 sv_setiv( ST(0), PTR2IV(RETVAL) ); 196 197 198 void 199 dl_undef_symbols() 200 PPCODE: 201 202 203 204 # These functions should not need changing on any platform: 205 206 void 207 dl_install_xsub(perl_name, symref, filename="$Package") 208 char * perl_name 209 void * symref 210 const char * filename 211 CODE: 212 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", 213 perl_name, symref)); 214 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, 215 (void(*)(pTHX_ CV *))symref, 216 filename, NULL, 217 XS_DYNAMIC_FILENAME))); 218 219 220 SV * 221 dl_error() 222 CODE: 223 dMY_CXT; 224 RETVAL = newSVsv(MY_CXT.x_dl_last_error); 225 OUTPUT: 226 RETVAL 227 228 #if defined(USE_ITHREADS) 229 230 void 231 CLONE(...) 232 CODE: 233 MY_CXT_CLONE; 234 235 PERL_UNUSED_VAR(items); 236 237 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid 238 * using Perl variables that belong to another thread, we create our 239 * own for this thread. 240 */ 241 MY_CXT.x_dl_last_error = newSVpvs(""); 242 243 #endif 244 245 # end. 246