home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / DynaLoader / dl_mpeix.xs < prev    next >
Text File  |  1999-12-16  |  4KB  |  132 lines
  1. /*
  2.  * Author:  Mark Klein (mklein@dis.com)
  3.  * Version: 2.1, 1996/07/25
  4.  * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu)
  5.  * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu)
  6.  */
  7.  
  8. #include "EXTERN.h"
  9. #include "perl.h"
  10. #include "XSUB.h"
  11.  
  12. #ifdef __GNUC__
  13. extern void HPGETPROCPLABEL(    int    parms,
  14.                                 char * procname,
  15.                                 int  * plabel,
  16.                                 int  * status,
  17.                                 char * firstfile,
  18.                                 int    casesensitive,
  19.                                 int    symboltype,
  20.                                 int  * datasize,
  21.                                 int    position,
  22.                                 int    searchpath,
  23.                                 int    binding);
  24. #else
  25. #pragma intrinsic HPGETPROCPLABEL
  26. #endif
  27. #include "dlutils.c"    /* for SaveError() etc */
  28.  
  29. typedef struct {
  30.   char  filename[PATH_MAX + 3];
  31.   } t_mpe_dld, *p_mpe_dld;
  32.  
  33. static AV *dl_resolve_using = Nullav;
  34.  
  35. static void
  36. dl_private_init(pTHX)
  37. {
  38.     (void)dl_generic_private_init(aTHX);
  39.     dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
  40. }
  41.  
  42. MODULE = DynaLoader     PACKAGE = DynaLoader
  43.  
  44. BOOT:
  45.     (void)dl_private_init(aTHX);
  46.  
  47. void *
  48. dl_load_file(filename, flags=0)
  49.     char *      filename
  50.     int         flags
  51.     PREINIT:
  52.     char                buf[PATH_MAX + 3];
  53.     p_mpe_dld           obj = NULL;
  54.     int                 i;
  55.     CODE:
  56.     DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
  57. flags));
  58.     if (flags & 0x01)
  59.         Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s
  60. ",filename);
  61.     obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
  62.     memzero(obj, sizeof(t_mpe_dld));
  63.     if (filename[0] != '/')
  64.         {
  65.         getcwd(buf,sizeof(buf));
  66.         sprintf(obj->filename," %s/%s ",buf,filename);
  67.         }
  68.     else
  69.         sprintf(obj->filename," %s ",filename);
  70.  
  71.     DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));
  72.  
  73.     ST(0) = sv_newmortal() ;
  74.     if (obj == NULL)
  75.         SaveError(aTHX_"%s",Strerror(errno));
  76.     else
  77.         sv_setiv( ST(0), PTR2IV(obj) );
  78.  
  79. void *
  80. dl_find_symbol(libhandle, symbolname)
  81.     void *      libhandle
  82.     char *      symbolname
  83.     CODE:
  84.     int       datalen;
  85.     p_mpe_dld obj = (p_mpe_dld) libhandle;
  86.     char      symname[PATH_MAX + 3];
  87.     void *    symaddr = NULL;
  88.     int       status;
  89.     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
  90.                 libhandle, symbolname));
  91.     ST(0) = sv_newmortal() ;
  92.     errno = 0;
  93.  
  94.     sprintf(symname, " %s ", symbolname);
  95.     HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
  96.                     0, &datalen, 1, 0, 0);
  97.  
  98.     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
  99.  
  100.     if (status != 0) {
  101.         SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
  102.     } else {
  103.         sv_setiv( ST(0), PTR2IV(symaddr) );
  104.     }
  105.  
  106. void
  107. dl_undef_symbols()
  108.     PPCODE:
  109.  
  110. # These functions should not need changing on any platform:
  111.  
  112. void
  113. dl_install_xsub(perl_name, symref, filename="$Package")
  114.     char *      perl_name
  115.     void *      symref
  116.     char *      filename
  117.     CODE:
  118.     DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
  119.             perl_name, symref));
  120.     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
  121.                     (void(*)(pTHX_ CV *))symref,
  122.                     filename)));
  123.  
  124. char *
  125. dl_error()
  126.     CODE:
  127.     RETVAL = LastError ;
  128.     OUTPUT:
  129.     RETVAL
  130.  
  131. # end.
  132.