contrib/perl5/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     STRLEN n_a;
 176
 177     /* Do not load what is already loaded into this process */
 178     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
 179         return path;
 180
 181     nxerr = OpenError();
 182     psize = AvFILL(dl_resolve_using) + 3;
 183     p = (char **) safemalloc(psize * sizeof(char*));
 184     p[0] = path;
 185     for(i=1; i<psize-1; i++) {
 186         p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
 187     }
 188     p[psize-1] = 0;
 189     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
 190                             (const char *) 0);
 191     safefree((char*) p);
 192     if (rld_success) {
 193         result = path;
 194         /* prevent multiple loads of same file into same process */
 195         hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
 196     } else {
 197         TransferError(nxerr);
 198         result = (char*) 0;
 199     }
 200     CloseError(nxerr);
 201     return result;
 202 }
 203
 204 void *
 205 dlsym(handle, symbol)
 206 void *handle;
 207 char *symbol;
 208 {
 209     NXStream    *nxerr = OpenError();
 210     unsigned long       symref = 0;
 211
 212     if (!rld_lookup(nxerr, form("_%s", symbol), &symref))
 213         TransferError(nxerr);
 214     CloseError(nxerr);
 215     return (void*) symref;
 216 }
 217
 218 #endif /* NS_TARGET_MAJOR >= 4 */
 219
 220
 221 /* ----- code from dl_dlopen.xs below here ----- */
 222
 223
 224 static void
 225 dl_private_init()
 226 {
 227     (void)dl_generic_private_init();
 228     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
 229 }
 230
 231 MODULE = DynaLoader     PACKAGE = DynaLoader
 232
 233 BOOT:
 234     (void)dl_private_init();
 235
 236
 237
 238 void *
 239 dl_load_file(filename, flags=0)
 240     char *      filename
 241     int         flags
 242     PREINIT:
 243     int mode = 1;
 244     CODE:
 245     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 246     if (flags & 0x01)
 247         warn("Can't make loaded symbols global on this platform while loading %s",filename);
 248     RETVAL = dlopen(filename, mode) ;
 249     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 250     ST(0) = sv_newmortal() ;
 251     if (RETVAL == NULL)
 252         SaveError("%s",dlerror()) ;
 253     else
 254         sv_setiv( ST(0), (IV)RETVAL);
 255
 256
 257 void *
 258 dl_find_symbol(libhandle, symbolname)
 259     void *              libhandle
 260     char *              symbolname
 261     CODE:
 262 #if NS_TARGET_MAJOR >= 4
 263     symbolname = form("_%s", symbolname);
 264 #endif
 265     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 266                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 267                              (unsigned long) libhandle, symbolname));
 268     RETVAL = dlsym(libhandle, symbolname);
 269     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 270                              "  symbolref = %lx\n", (unsigned long) 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.