ext/DynaLoader/dl_rhapsody.xs

   1 /* dl_rhapsody.xs
   2  *
   3  * Platform:    Apple Rhapsody 5.0
   4  * Based on:    dl_next.xs by Paul Marquess
   5  * Based on:    dl_dlopen.xs by Anno Siegel
   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 #include "EXTERN.h"
  35 #include "perl.h"
  36 #include "XSUB.h"
  37
  38 #define DL_LOADONCEONLY
  39
  40 #include "dlutils.c"    /* SaveError() etc      */
  41
  42 #undef environ
  43 #import <mach-o/dyld.h>
  44
  45 static char * dl_last_error = (char *) 0;
  46 static AV *dl_resolve_using = Nullav;
  47
  48 static char *dlerror()
  49 {
  50     return dl_last_error;
  51 }
  52
  53 int dlclose(handle) /* stub only */
  54 void *handle;
  55 {
  56     return 0;
  57 }
  58
  59 enum dyldErrorSource
  60 {
  61     OFImage,
  62 };
  63
  64 static void TranslateError
  65     (const char *path, enum dyldErrorSource type, int number)
  66 {
  67     dTHX;
  68     char *error;
  69     unsigned int index;
  70     static char *OFIErrorStrings[] =
  71     {
  72         "%s(%d): Object Image Load Failure\n",
  73         "%s(%d): Object Image Load Success\n",
  74         "%s(%d): Not an recognisable object file\n",
  75         "%s(%d): No valid architecture\n",
  76         "%s(%d): Object image has an invalid format\n",
  77         "%s(%d): Invalid access (permissions?)\n",
  78         "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
  79     };
  80 #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
  81
  82     switch (type)
  83     {
  84     case OFImage:
  85         index = number;
  86         if (index > NUM_OFI_ERRORS - 1)
  87             index = NUM_OFI_ERRORS - 1;
  88         error = form(OFIErrorStrings[index], path, number);
  89         break;
  90
  91     default:
  92         error = form("%s(%d): Totally unknown error type %d\n",
  93                      path, number, type);
  94         break;
  95     }
  96     safefree(dl_last_error);
  97     dl_last_error = savepv(error);
  98 }
  99
 100 static char *dlopen(char *path, int mode /* mode is ignored */)
 101 {
 102     int dyld_result;
 103     NSObjectFileImage ofile;
 104     NSModule handle = NULL;
 105
 106     dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
 107     if (dyld_result != NSObjectFileImageSuccess)
 108         TranslateError(path, OFImage, dyld_result);
 109     else
 110     {
 111         // NSLinkModule will cause the run to abort on any link error's
 112         // not very friendly but the error recovery functionality is limited.
 113         handle = NSLinkModule(ofile, path, TRUE);
 114     }
 115
 116     return handle;
 117 }
 118
 119 void *
 120 dlsym(handle, symbol)
 121 void *handle;
 122 char *symbol;
 123 {
 124     void *addr;
 125
 126     if (NSIsSymbolNameDefined(symbol))
 127         addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
 128     else
 129         addr = NULL;
 130
 131     return addr;
 132 }
 133
 134
 135
 136 /* ----- code from dl_dlopen.xs below here ----- */
 137
 138
 139 static void
 140 dl_private_init(pTHX)
 141 {
 142     (void)dl_generic_private_init(aTHX);
 143     dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4);
 144 }
 145
 146 MODULE = DynaLoader     PACKAGE = DynaLoader
 147
 148 BOOT:
 149     (void)dl_private_init(aTHX);
 150
 151
 152
 153 void *
 154 dl_load_file(filename, flags=0)
 155     char *      filename
 156     int         flags
 157     PREINIT:
 158     int mode = 1;
 159     CODE:
 160     DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
 161     if (flags & 0x01)
 162         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
 163     RETVAL = dlopen(filename, mode) ;
 164     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
 165     ST(0) = sv_newmortal() ;
 166     if (RETVAL == NULL)
 167         SaveError(aTHX_ "%s",dlerror()) ;
 168     else
 169         sv_setiv( ST(0), (IV)RETVAL);
 170
 171
 172 void *
 173 dl_find_symbol(libhandle, symbolname)
 174     void *              libhandle
 175     char *              symbolname
 176     CODE:
 177     symbolname = form("_%s", symbolname);
 178     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 179                              "dl_find_symbol(handle=%lx, symbol=%s)\n",
 180                              (unsigned long) libhandle, symbolname));
 181     RETVAL = dlsym(libhandle, symbolname);
 182     DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
 183                              "  symbolref = %lx\n", (unsigned long) RETVAL));
 184     ST(0) = sv_newmortal() ;
 185     if (RETVAL == NULL)
 186         SaveError(aTHX_ "%s",dlerror()) ;
 187     else
 188         sv_setiv( ST(0), (IV)RETVAL);
 189
 190
 191 void
 192 dl_undef_symbols()
 193     PPCODE:
 194
 195
 196
 197 # These functions should not need changing on any platform:
 198
 199 void
 200 dl_install_xsub(perl_name, symref, filename="$Package")
 201     char *      perl_name
 202     void *      symref
 203     char *      filename
 204     CODE:
 205     DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
 206             perl_name, symref));
 207     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
 208                                         (void(*)(pTHX_ CV *))symref,
 209                                         filename)));
 210
 211
 212 char *
 213 dl_error()
 214     CODE:
 215     RETVAL = LastError ;
 216     OUTPUT:
 217     RETVAL
 218
 219 +# end.