home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / ext / DynaLoader / dl_next.xs < prev    next >
Text File  |  1995-10-19  |  5KB  |  223 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. /* include these before perl headers */
  35. #include <mach-o/rld.h>
  36. #include <streams/streams.h>
  37.  
  38. #include "EXTERN.h"
  39. #include "perl.h"
  40. #include "XSUB.h"
  41.  
  42. #define DL_LOADONCEONLY
  43.  
  44. #include "dlutils.c"    /* SaveError() etc    */
  45.  
  46.  
  47. static char * dl_last_error = (char *) 0;
  48. static AV *dl_resolve_using = Nullav;
  49.  
  50. NXStream *
  51. OpenError()
  52. {
  53.     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
  54. }
  55.  
  56. void
  57. TransferError( s)
  58. NXStream *s;
  59. {
  60.     char *buffer;
  61.     int len, maxlen;
  62.  
  63.     if ( dl_last_error ) {
  64.         safefree(dl_last_error);
  65.     }
  66.     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
  67.     dl_last_error = safemalloc(len);
  68.     strcpy(dl_last_error, buffer);
  69. }
  70.  
  71. void
  72. CloseError( s)
  73. NXStream *s;
  74. {
  75.     if ( s ) {
  76.       NXCloseMemory( s, NX_FREEBUFFER);
  77.     }
  78. }
  79.  
  80. char *dlerror()
  81. {
  82.     return dl_last_error;
  83. }
  84.  
  85. char *
  86. dlopen(path, mode)
  87. char * path;
  88. int mode; /* mode is ignored */
  89. {
  90.     int rld_success;
  91.     NXStream *nxerr;
  92.     I32 i, psize;
  93.     char *result;
  94.     char **p;
  95.     
  96.     /* Do not load what is already loaded into this process */
  97.     if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
  98.     return path;
  99.  
  100.     nxerr = OpenError();
  101.     psize = AvFILL(dl_resolve_using) + 3;
  102.     p = (char **) safemalloc(psize * sizeof(char*));
  103.     p[0] = path;
  104.     for(i=1; i<psize-1; i++) {
  105.     p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
  106.     }
  107.     p[psize-1] = 0;
  108.     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
  109.                 (const char *) 0);
  110.     safefree((char*) p);
  111.     if (rld_success) {
  112.     result = path;
  113.     /* prevent multiple loads of same file into same process */
  114.     hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
  115.     } else {
  116.     TransferError(nxerr);
  117.     result = (char*) 0;
  118.     }
  119.     CloseError(nxerr);
  120.     return result;
  121. }
  122.  
  123. int
  124. dlclose(handle) /* stub only */
  125. void *handle;
  126. {
  127.     return 0;
  128. }
  129.  
  130. void *
  131. dlsym(handle, symbol)
  132. void *handle;
  133. char *symbol;
  134. {
  135.     NXStream    *nxerr = OpenError();
  136.     char    symbuf[1024];
  137.     unsigned long    symref = 0;
  138.  
  139.     sprintf(symbuf, "_%s", symbol);
  140.     if (!rld_lookup(nxerr, symbuf, &symref)) {
  141.     TransferError(nxerr);
  142.     }
  143.     CloseError(nxerr);
  144.     return (void*) symref;
  145. }
  146.  
  147.  
  148. /* ----- code from dl_dlopen.xs below here ----- */
  149.  
  150.  
  151. static void
  152. dl_private_init()
  153. {
  154.     (void)dl_generic_private_init();
  155.     dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
  156. }
  157.  
  158. MODULE = DynaLoader     PACKAGE = DynaLoader
  159.  
  160. BOOT:
  161.     (void)dl_private_init();
  162.  
  163.  
  164.  
  165. void *
  166. dl_load_file(filename)
  167.     char *    filename
  168.     CODE:
  169.     int mode = 1;
  170.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  171.     RETVAL = dlopen(filename, mode) ;
  172.     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  173.     ST(0) = sv_newmortal() ;
  174.     if (RETVAL == NULL)
  175.     SaveError("%s",dlerror()) ;
  176.     else
  177.     sv_setiv( ST(0), (IV)RETVAL);
  178.  
  179.  
  180. void *
  181. dl_find_symbol(libhandle, symbolname)
  182.     void *        libhandle
  183.     char *        symbolname
  184.     CODE:
  185.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  186.         libhandle, symbolname));
  187.     RETVAL = dlsym(libhandle, symbolname);
  188.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  189.     ST(0) = sv_newmortal() ;
  190.     if (RETVAL == NULL)
  191.     SaveError("%s",dlerror()) ;
  192.     else
  193.     sv_setiv( ST(0), (IV)RETVAL);
  194.  
  195.  
  196. void
  197. dl_undef_symbols()
  198.     PPCODE:
  199.  
  200.  
  201.  
  202. # These functions should not need changing on any platform:
  203.  
  204. void
  205. dl_install_xsub(perl_name, symref, filename="$Package")
  206.     char *    perl_name
  207.     void *    symref 
  208.     char *    filename
  209.     CODE:
  210.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  211.         perl_name, symref));
  212.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  213.  
  214.  
  215. char *
  216. dl_error()
  217.     CODE:
  218.     RETVAL = LastError ;
  219.     OUTPUT:
  220.     RETVAL
  221.  
  222. # end.
  223.