home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dl_next.xs < prev    next >
Text File  |  2000-01-02  |  7KB  |  308 lines
  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.     dTHX;
  76.     char *error;
  77.     unsigned int index;
  78.     static char *OFIErrorStrings[] =
  79.     {
  80.     "%s(%d): Object Image Load Failure\n",
  81.     "%s(%d): Object Image Load Success\n",
  82.     "%s(%d): Not an recognisable object file\n",
  83.     "%s(%d): No valid architecture\n",
  84.     "%s(%d): Object image has an invalid format\n",
  85.     "%s(%d): Invalid access (permissions?)\n",
  86.     "%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
  87.     };
  88. #define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
  89.  
  90.     switch (type)
  91.     {
  92.     case OFImage:
  93.     index = number;
  94.     if (index > NUM_OFI_ERRORS - 1)
  95.         index = NUM_OFI_ERRORS - 1;
  96.     error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
  97.     break;
  98.  
  99.     default:
  100.     error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
  101.              path, number, type);
  102.     break;
  103.     }
  104.     Safefree(dl_last_error);
  105.     dl_last_error = savepv(error);
  106. }
  107.  
  108. static char *dlopen(char *path, int mode /* mode is ignored */)
  109. {
  110.     int dyld_result;
  111.     NSObjectFileImage ofile;
  112.     NSModule handle = NULL;
  113.  
  114.     dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
  115.     if (dyld_result != NSObjectFileImageSuccess)
  116.     TranslateError(path, OFImage, dyld_result);
  117.     else
  118.     {
  119.         // NSLinkModule will cause the run to abort on any link error's
  120.     // not very friendly but the error recovery functionality is limited.
  121.     handle = NSLinkModule(ofile, path, TRUE);
  122.     }
  123.     
  124.     return handle;
  125. }
  126.  
  127. void *
  128. dlsym(handle, symbol)
  129. void *handle;
  130. char *symbol;
  131. {
  132.     void *addr;
  133.  
  134.     if (NSIsSymbolNameDefined(symbol))
  135.     addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
  136.     else
  137.         addr = NULL;
  138.  
  139.     return addr;
  140. }
  141.  
  142. #else /* NS_TARGET_MAJOR <= 3 */
  143.  
  144. static NXStream *OpenError(void)
  145. {
  146.     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
  147. }
  148.  
  149. static void TransferError(NXStream *s)
  150. {
  151.     char *buffer;
  152.     int len, maxlen;
  153.  
  154.     if ( dl_last_error ) {
  155.         Safefree(dl_last_error);
  156.     }
  157.     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
  158.     New(1097, dl_last_error, len, char);
  159.     strcpy(dl_last_error, buffer);
  160. }
  161.  
  162. static void CloseError(NXStream *s)
  163. {
  164.     if ( s ) {
  165.       NXCloseMemory( s, NX_FREEBUFFER);
  166.     }
  167. }
  168.  
  169. static char *dlopen(char *path, int mode /* mode is ignored */)
  170. {
  171.     int rld_success;
  172.     NXStream *nxerr;
  173.     I32 i, psize;
  174.     char *result;
  175.     char **p;
  176.     STRLEN n_a;
  177.     
  178.     /* Do not load what is already loaded into this process */
  179.     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
  180.     return path;
  181.  
  182.     nxerr = OpenError();
  183.     psize = AvFILL(dl_resolve_using) + 3;
  184.     p = (char **) safemalloc(psize * sizeof(char*));
  185.     p[0] = path;
  186.     for(i=1; i<psize-1; i++) {
  187.     p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
  188.     }
  189.     p[psize-1] = 0;
  190.     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
  191.                 (const char *) 0);
  192.     safefree((char*) p);
  193.     if (rld_success) {
  194.     result = path;
  195.     /* prevent multiple loads of same file into same process */
  196.     hv_store(dl_loaded_files, path, strlen(path), &PL_sv_yes, 0);
  197.     } else {
  198.     TransferError(nxerr);
  199.     result = (char*) 0;
  200.     }
  201.     CloseError(nxerr);
  202.     return result;
  203. }
  204.  
  205. void *
  206. dlsym(handle, symbol)
  207. void *handle;
  208. char *symbol;
  209. {
  210.     NXStream    *nxerr = OpenError();
  211.     unsigned long    symref = 0;
  212.  
  213.     if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref))
  214.     TransferError(nxerr);
  215.     CloseError(nxerr);
  216.     return (void*) symref;
  217. }
  218.  
  219. #endif /* NS_TARGET_MAJOR >= 4 */
  220.  
  221.  
  222. /* ----- code from dl_dlopen.xs below here ----- */
  223.  
  224.  
  225. static void
  226. dl_private_init(pTHX)
  227. {
  228.     (void)dl_generic_private_init(aTHX);
  229.     dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
  230. }
  231.  
  232. MODULE = DynaLoader     PACKAGE = DynaLoader
  233.  
  234. BOOT:
  235.     (void)dl_private_init(aTHX);
  236.  
  237.  
  238.  
  239. void *
  240. dl_load_file(filename, flags=0)
  241.     char *    filename
  242.     int        flags
  243.     PREINIT:
  244.     int mode = 1;
  245.     CODE:
  246.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
  247.     if (flags & 0x01)
  248.     Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
  249.     RETVAL = dlopen(filename, mode) ;
  250.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
  251.     ST(0) = sv_newmortal() ;
  252.     if (RETVAL == NULL)
  253.     SaveError(aTHX_ "%s",dlerror()) ;
  254.     else
  255.     sv_setiv( ST(0), PTR2IV(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.     symbolname = Perl_form_nocontext("_%s", symbolname);
  265. #endif
  266.     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  267.                  "dl_find_symbol(handle=%lx, symbol=%s)\n",
  268.                  (unsigned long) libhandle, symbolname));
  269.     RETVAL = dlsym(libhandle, symbolname);
  270.     DLDEBUG(2, PerlIO_printf(Perl_debug_log,
  271.                  "  symbolref = %lx\n", (unsigned long) RETVAL));
  272.     ST(0) = sv_newmortal() ;
  273.     if (RETVAL == NULL)
  274.     SaveError(aTHX_ "%s",dlerror()) ;
  275.     else
  276.     sv_setiv( ST(0), PTR2IV(RETVAL) );
  277.  
  278.  
  279. void
  280. dl_undef_symbols()
  281.     PPCODE:
  282.  
  283.  
  284.  
  285. # These functions should not need changing on any platform:
  286.  
  287. void
  288. dl_install_xsub(perl_name, symref, filename="$Package")
  289.     char *    perl_name
  290.     void *    symref 
  291.     char *    filename
  292.     CODE:
  293.     DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
  294.         perl_name, symref));
  295.     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
  296.                     (void(*)(pTHX_ CV *))symref,
  297.                     filename)));
  298.  
  299.  
  300. char *
  301. dl_error()
  302.     CODE:
  303.     RETVAL = LastError ;
  304.     OUTPUT:
  305.     RETVAL
  306.  
  307. # end.
  308.