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)
 245     char *      filename
 246     CODE:
 247     int mode = 1;
 248     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n", filename));
 249     RETVAL = dlopen(filename, mode) ;
 250     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 251     ST(0) = sv_newmortal() ;
 252     if (RETVAL == NULL)
 253         SaveError("%s",dlerror()) ;
 254     else
 255         sv_setiv( ST(0), (IV)RETVAL);
 256
 257
 258 void *
 259 dl_find_symbol(libhandle, symbolname)
 260     void *              libhandle
 261     char *              symbolname
 262     CODE:
 263 #if NS_TARGET_MAJOR >= 4
 264     char symbolname_buf[1024];
 265     symbolname = dl_add_underscore(symbolname, symbolname_buf);
 266 #endif
 267     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
 268             libhandle, symbolname));
 269     RETVAL = dlsym(libhandle, symbolname);
 270     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
 271     ST(0) = sv_newmortal() ;
 272     if (RETVAL == NULL)
 273         SaveError("%s",dlerror()) ;
 274     else
 275         sv_setiv( ST(0), (IV)RETVAL);
 276
 277
 278 void
 279 dl_undef_symbols()
 280     PPCODE:
 281
 282
 283
 284 # These functions should not need changing on any platform:
 285
 286 void
 287 dl_install_xsub(perl_name, symref, filename="$Package")
 288     char *      perl_name
 289     void *      symref
 290     char *      filename
 291     CODE:
 292     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
 293             perl_name, symref));
 294     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 295
 296
 297 char *
 298 dl_error()
 299     CODE:
 300     RETVAL = LastError ;
 301     OUTPUT:
 302     RETVAL
 303
 304 # end.