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