ext/DynaLoader/dl_next.xs

   1 /* dl_next.xs
   2  *
   3  * Platform:    NeXT NS 3.2
   4  * Author:      Anno Siegel (siegel@zrz.TU-Berlin.DE)
   5  * Based on:    dl_dlopen.xs by Paul Marquess
   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 #if NS_TARGET_MAJOR >= 4
  35 #else
  36 /* include these before perl headers */
  37 #include <mach-o/rld.h>
  38 #include <streams/streams.h>
  39 #endif
  40
  41 #include "EXTERN.h"
  42 #include "perl.h"
  43 #include "XSUB.h"
  44
  45 #define DL_LOADONCEONLY
  46
  47 #include "dlutils.c"    /* SaveError() etc      */
  48
  49
  50 static char * dl_last_error = (char *) 0;
  51 static AV *dl_resolve_using = Nullav;
  52
  53 static char *dlerror()
  54 {
  55     return dl_last_error;
  56 }
  57
  58 int dlclose(handle) /* stub only */
  59 void *handle;
  60 {
  61     return 0;
  62 }
  63
  64 #if NS_TARGET_MAJOR >= 4
  65 #import <mach-o/dyld.h>
  66
  67 enum dyldErrorSource
  68 {
  69     OFImage,
  70 };
  71
  72 static void TranslateError
  73     (const char *path, enum dyldErrorSource type, int number)
  74 {
  75     char errorBuffer[128];
  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 an 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     if ( dl_last_error ) {
  90         safefree(dl_last_error);
  91     }
  92     switch (type)
  93     {
  94     case OFImage:
  95         index = number;
  96         if (index > NUM_OFI_ERRORS - 1)
  97             index = NUM_OFI_ERRORS - 1;
  98         sprintf(errorBuffer, OFIErrorStrings[index], path, number);
  99         break;
 100
 101     default:
 102         sprintf(errorBuffer, "%s(%d): Totally unknown error type %d\n",
 103             path, number, type);
 104         break;
 105     }
 106     dl_last_error = safemalloc(strlen(errorBuffer)+1);
 107     strcpy(dl_last_error, errorBuffer);
 108 }
 109
 110 static char *dlopen(char *path, int mode /* mode is ignored */)
 111 {
 112     int dyld_result;
 113     NSObjectFileImage ofile;
 114     NSModule handle = NULL;
 115
 116     dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
 117     if (dyld_result != NSObjectFileImageSuccess)
 118         TranslateError(path, OFImage, dyld_result);
 119     else
 120     {
 121         // NSLinkModule will cause the run to abort on any link error's
 122         // not very friendly but the error recovery functionality is limited.
 123         handle = NSLinkModule(ofile, path, TRUE);
 124     }
 125
 126     return handle;
 127 }
 128
 129 void *
 130 dlsym(handle, symbol)
 131 void *handle;
 132 char *symbol;
 133 {
 134     void *addr;
 135
 136     if (NSIsSymbolNameDefined(symbol))
 137         addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
 138     else
 139         addr = NULL;
 140
 141     return addr;
 142 }
 143
 144 #else /* NS_TARGET_MAJOR <= 3 */
 145
 146 static NXStream *OpenError(void)
 147 {
 148     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
 149 }
 150
 151 static void TransferError(NXStream *s)
 152 {
 153     char *buffer;
 154     int len, maxlen;
 155
 156     if ( dl_last_error ) {
 157         safefree(dl_last_error);
 158     }
 159     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
 160     dl_last_error = safemalloc(len);
 161     strcpy(dl_last_error, buffer);
 162 }
 163
 164 static void CloseError(NXStream *s)
 165 {
 166     if ( s ) {
 167       NXCloseMemory( s, NX_FREEBUFFER);
 168     }
 169 }
 170
 171 static char *dlopen(char *path, int mode /* mode is ignored */)
 172 {
 173     int rld_success;
 174     NXStream *nxerr;
 175     I32 i, psize;
 176     char *result;
 177     char **p;
 178
 179     /* Do not load what is already loaded into this process */
 180     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
 181         return path;
 182
 183     nxerr = OpenError();
 184     psize = AvFILL(dl_resolve_using) + 3;
 185     p = (char **) safemalloc(psize * sizeof(char*));
 186     p[0] = path;
 187     for(i=1; i<psize-1; i++) {
 188         p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
 189     }
 190     p[psize-1] = 0;
 191     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
 192                             (const char *) 0);
 193     safefree((char*) p);
 194     if (rld_success) {
 195         result = path;
 196         /* prevent multiple loads of same file into same process */
 197         hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
 198     } else {
 199         TransferError(nxerr);
 200         result = (char*) 0;
 201     }
 202     CloseError(nxerr);
 203     return result;
 204 }
 205
 206 void *
 207 dlsym(handle, symbol)
 208 void *handle;
 209 char *symbol;
 210 {
 211     NXStream    *nxerr = OpenError();
 212     char        symbuf[1024];
 213     unsigned long       symref = 0;
 214
 215     sprintf(symbuf, "_%s", symbol);
 216     if (!rld_lookup(nxerr, symbuf, &symref)) {
 217         TransferError(nxerr);
 218     }
 219     CloseError(nxerr);
 220     return (void*) symref;
 221 }
 222
 223 #endif /* NS_TARGET_MAJOR >= 4 */
 224
 225
 226 /* ----- code from dl_dlopen.xs below here ----- */
 227
 228
 229 static void
 230 dl_private_init()
 231 {
 232     (void)dl_generic_private_init();
 233     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
 234 }
 235
 236 MODULE = DynaLoader     PACKAGE = DynaLoader
 237
 238 BOOT:
 239     (void)dl_private_init();
 240
 241
 242
 243 void *
 244 dl_load_file(filename, flags=0)
 245     char *      filename
 246     int         flags
 247     PREINIT:
 248     int mode = 1;
 249     CODE:
 250     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 251     if (flags & 0x01)
 252         warn("Can't make loaded symbols global on this platform while loading %s",filename);
 253     RETVAL = dlopen(filename, mode) ;
 254     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 255     ST(0) = sv_newmortal() ;
 256     if (RETVAL == NULL)
 257         SaveError("%s",dlerror()) ;
 258     else
 259         sv_setiv( ST(0), (IV)RETVAL);
 260
 261
 262 void *
 263 dl_find_symbol(libhandle, symbolname)
 264     void *              libhandle
 265     char *              symbolname
 266     CODE:
 267 #if NS_TARGET_MAJOR >= 4
 268     char symbolname_buf[1024];
 269     symbolname = dl_add_underscore(symbolname, symbolname_buf);
 270 #endif
 271     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
 272             libhandle, symbolname));
 273     RETVAL = dlsym(libhandle, symbolname);
 274     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
 275     ST(0) = sv_newmortal() ;
 276     if (RETVAL == NULL)
 277         SaveError("%s",dlerror()) ;
 278     else
 279         sv_setiv( ST(0), (IV)RETVAL);
 280
 281
 282 void
 283 dl_undef_symbols()
 284     PPCODE:
 285
 286
 287
 288 # These functions should not need changing on any platform:
 289
 290 void
 291 dl_install_xsub(perl_name, symref, filename="$Package")
 292     char *      perl_name
 293     void *      symref
 294     char *      filename
 295     CODE:
 296     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
 297             perl_name, symref));
 298     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 299
 300
 301 char *
 302 dl_error()
 303     CODE:
 304     RETVAL = LastError ;
 305     OUTPUT:
 306     RETVAL
 307
 308 # end.