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 #import <mach-o/dyld.h> 52 53 static char *dlerror() 54 { 55 dTHX; 56 dMY_CXT; 57 return dl_last_error; 58 } 59 60 static int dlclose(void *handle) /* stub only */ 61 { 62 return 0; 63 } 64 65 enum dyldErrorSource 66 { 67 OFImage, 68 }; 69 70 static void TranslateError 71 (const char *path, enum dyldErrorSource type, int number) 72 { 73 dTHX; 74 dMY_CXT; 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 a 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; 95 error = Perl_form_nocontext(OFIErrorStrings[index], path, number); 96 break; 97 98 default: 99 error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", 100 path, number, type); 101 break; 102 } 103 sv_setpv(MY_CXT.x_dl_last_error, error); 104 } 105 106 static char *dlopen(char *path) 107 { 108 int dyld_result; 109 NSObjectFileImage ofile; 110 NSModule handle = NULL; 111 112 dyld_result = NSCreateObjectFileImageFromFile(path, &ofile); 113 if (dyld_result != NSObjectFileImageSuccess) 114 TranslateError(path, OFImage, dyld_result); 115 else 116 { 117 // NSLinkModule will cause the run to abort on any link errors 118 // not very friendly but the error recovery functionality is limited. 119 handle = NSLinkModule(ofile, path, TRUE); 120 NSDestroyObjectFileImage(ofile); 121 } 122 123 return handle; 124 } 125 126 static void * 127 dlsym(void *handle, char *symbol) 128 { 129 void *addr; 130 131 if (NSIsSymbolNameDefined(symbol)) 132 addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol)); 133 else 134 addr = NULL; 135 136 return addr; 137 } 138 139 140 141 /* ----- code from dl_dlopen.xs below here ----- */ 142 143 144 static void 145 dl_private_init(pTHX) 146 { 147 (void)dl_generic_private_init(aTHX); 148 } 149 150 MODULE = DynaLoader PACKAGE = DynaLoader 151 152 BOOT: 153 (void)dl_private_init(aTHX); 154 155 156 157 void * 158 dl_load_file(filename, flags=0) 159 char * filename 160 int flags 161 CODE: 162 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 163 if (flags & 0x01) 164 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 165 RETVAL = dlopen(filename); 166 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); 167 ST(0) = newSV_type_mortal(SVt_IV); 168 if (RETVAL == NULL) 169 SaveError(aTHX_ "%s",dlerror()) ; 170 else 171 sv_setiv( ST(0), PTR2IV(RETVAL) ); 172 173 174 void * 175 dl_find_symbol(libhandle, symbolname, ign_err=0) 176 void * libhandle 177 char * symbolname 178 int ign_err 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) = newSV_type_mortal(SVt_IV); 188 if (RETVAL == NULL) { 189 if (!ign_err) 190 SaveError(aTHX_ "%s",dlerror()) ; 191 } else 192 sv_setiv( ST(0), PTR2IV(RETVAL) ); 193 194 195 void 196 dl_undef_symbols() 197 PPCODE: 198 199 200 201 # These functions should not need changing on any platform: 202 203 void 204 dl_install_xsub(perl_name, symref, filename="$Package") 205 char * perl_name 206 void * symref 207 const char * filename 208 CODE: 209 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", 210 perl_name, symref)); 211 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, 212 (void(*)(pTHX_ CV *))symref, 213 filename, NULL, 214 XS_DYNAMIC_FILENAME))); 215 216 217 SV * 218 dl_error() 219 CODE: 220 dMY_CXT; 221 RETVAL = newSVsv(MY_CXT.x_dl_last_error); 222 OUTPUT: 223 RETVAL 224 225 #if defined(USE_ITHREADS) 226 227 void 228 CLONE(...) 229 CODE: 230 MY_CXT_CLONE; 231 232 PERL_UNUSED_VAR(items); 233 234 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid 235 * using Perl variables that belong to another thread, we create our 236 * own for this thread. 237 */ 238 MY_CXT.x_dl_last_error = newSVpvs(""); 239 240 #endif 241 242 # end. 243