ext/DynaLoader/dl_mpeix.xs

   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", 0x4);
  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(PerlIO_stderr(), "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(PerlIO_stderr()," 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(PerlIO_stderr(),"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(PerlIO_stderr(),"  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(PerlIO_stderr(),"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.