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 *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 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     switch (type)
  90     {
  91     case OFImage:
  92         index = number;
  93         if (index > NUM_OFI_ERRORS - 1)
  94             index = NUM_OFI_ERRORS - 1;
  95         error = form(OFIErrorStrings[index], path, number);
  96         break;
  97
  98     default:
  99         error = form("%s(%d): Totally unknown error type %d\n",
 100                      path, number, type);
 101         break;
 102     }
 103     Safefree(dl_last_error);
 104     dl_last_error = savepv(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 error's
 119         // not very friendly but the error recovery functionality is limited.
 120         handle = NSLinkModule(ofile, path, TRUE);
 121     }
 122
 123     return handle;
 124 }
 125
 126 void *
 127 dlsym(handle, symbol)
 128 void *handle;
 129 char *symbol;
 130 {
 131     void *addr;
 132
 133     if (NSIsSymbolNameDefined(symbol))
 134         addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
 135     else
 136         addr = NULL;
 137
 138     return addr;
 139 }
 140
 141 #else /* NS_TARGET_MAJOR <= 3 */
 142
 143 static NXStream *OpenError(void)
 144 {
 145     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
 146 }
 147
 148 static void TransferError(NXStream *s)
 149 {
 150     char *buffer;
 151     int len, maxlen;
 152
 153     if ( dl_last_error ) {
 154         Safefree(dl_last_error);
 155     }
 156     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
 157     New(1097, dl_last_error, len, char);
 158     strcpy(dl_last_error, buffer);
 159 }
 160
 161 static void CloseError(NXStream *s)
 162 {
 163     if ( s ) {
 164       NXCloseMemory( s, NX_FREEBUFFER);
 165     }
 166 }
 167
 168 static char *dlopen(char *path, int mode /* mode is ignored */)
 169 {
 170     int rld_success;
 171     NXStream *nxerr;
 172     I32 i, psize;
 173     char *result;
 174     char **p;
 175
 176     /* Do not load what is already loaded into this process */
 177     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
 178         return path;
 179
 180     nxerr = OpenError();
 181     psize = AvFILL(dl_resolve_using) + 3;
 182     p = (char **) safemalloc(psize * sizeof(char*));
 183     p[0] = path;
 184     for(i=1; i<psize-1; i++) {
 185         p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
 186     }
 187     p[psize-1] = 0;
 188     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
 189                             (const char *) 0);
 190     safefree((char*) p);
 191     if (rld_success) {
 192         result = path;
 193         /* prevent multiple loads of same file into same process */
 194         hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
 195     } else {
 196         TransferError(nxerr);
 197         result = (char*) 0;
 198     }
 199     CloseError(nxerr);
 200     return result;
 201 }
 202
 203 void *
 204 dlsym(handle, symbol)
 205 void *handle;
 206 char *symbol;
 207 {
 208     NXStream    *nxerr = OpenError();
 209     unsigned long       symref = 0;
 210
 211     if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
 212         TransferError(nxerr);
 213     CloseError(nxerr);
 214     return (void*) symref;
 215 }
 216
 217 #endif /* NS_TARGET_MAJOR >= 4 */
 218
 219
 220 /* ----- code from dl_dlopen.xs below here ----- */
 221
 222
 223 static void
 224 dl_private_init()
 225 {
 226     (void)dl_generic_private_init();
 227     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
 228 }
 229
 230 MODULE = DynaLoader     PACKAGE = DynaLoader
 231
 232 BOOT:
 233     (void)dl_private_init();
 234
 235
 236
 237 void *
 238 dl_load_file(filename, flags=0)
 239     char *      filename
 240     int         flags
 241     PREINIT:
 242     int mode = 1;
 243     CODE:
 244     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 245     if (flags & 0x01)
 246         warn("Can't make loaded symbols global on this platform while loading %s",filename);
 247     RETVAL = dlopen(filename, mode) ;
 248     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 249     ST(0) = sv_newmortal() ;
 250     if (RETVAL == NULL)
 251         SaveError("%s",dlerror()) ;
 252     else
 253         sv_setiv( ST(0), (IV)RETVAL);
 254
 255
 256 void *
 257 dl_find_symbol(libhandle, symbolname)
 258     void *              libhandle
 259     char *              symbolname
 260     CODE:
 261 #if NS_TARGET_MAJOR >= 4
 262     symbolname = form("_%s", symbolname);
 263 #endif
 264     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 265                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 266                              (unsigned long) libhandle, symbolname));
 267     RETVAL = dlsym(libhandle, symbolname);
 268     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 269                              "  symbolref = %lx\n", (unsigned long) RETVAL));
 270     ST(0) = sv_newmortal() ;
 271     if (RETVAL == NULL)
 272         SaveError("%s",dlerror()) ;
 273     else
 274         sv_setiv( ST(0), (IV)RETVAL);
 275
 276
 277 void
 278 dl_undef_symbols()
 279     PPCODE:
 280
 281
 282
 283 # These functions should not need changing on any platform:
 284
 285 void
 286 dl_install_xsub(perl_name, symref, filename="$Package")
 287     char *      perl_name
 288     void *      symref
 289     char *      filename
 290     CODE:
 291     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
 292             perl_name, symref));
 293     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
 294
 295
 296 char *
 297 dl_error()
 298     CODE:
 299     RETVAL = LastError ;
 300     OUTPUT:
 301     RETVAL
 302
 303 # end.