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 * Version: 2.4, 2002/03/24 Mark Bixby (mark@bixby.org)
14 extern void HPGETPROCPLABEL( int parms,
26 #pragma intrinsic HPGETPROCPLABEL
28 #include "dlutils.c" /* for SaveError() etc */
31 char filename[PATH_MAX + 3];
32 } t_mpe_dld, *p_mpe_dld;
37 (void)dl_generic_private_init(aTHX);
40 MODULE = DynaLoader PACKAGE = DynaLoader
43 (void)dl_private_init(aTHX);
46 dl_load_file(filename, flags=0)
50 char buf[PATH_MAX + 3];
54 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
58 "Can't make loaded symbols global on this platform while loading %s",filename);
59 obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
60 memzero(obj, sizeof(t_mpe_dld));
61 if (filename[0] != '/')
63 getcwd(buf,sizeof(buf));
64 sprintf(obj->filename," %s/%s ",buf,filename);
67 sprintf(obj->filename," %s ",filename);
69 DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));
71 ST(0) = sv_newmortal() ;
73 SaveError(aTHX_"%s",Strerror(errno));
75 sv_setiv( ST(0), PTR2IV(obj) );
78 dl_find_symbol(libhandle, symbolname)
83 p_mpe_dld obj = (p_mpe_dld) libhandle;
84 char symname[PATH_MAX + 3];
85 void * symaddr = NULL;
87 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
88 libhandle, symbolname));
89 ST(0) = sv_newmortal() ;
92 sprintf(symname, " %s ", symbolname);
93 HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
94 0, &datalen, 1, 0, 0);
96 DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
99 SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
101 sv_setiv( ST(0), PTR2IV(symaddr) );
108 # These functions should not need changing on any platform:
111 dl_install_xsub(perl_name, symref, filename="$Package")
114 const char * filename
116 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
118 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
119 (void(*)(pTHX_ CV *))symref,
121 XS_DYNAMIC_FILENAME)));
127 RETVAL = dl_last_error ;
131 #if defined(USE_ITHREADS)
138 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
139 * using Perl variables that belong to another thread, we create our
140 * own for this thread.
142 MY_CXT.x_dl_last_error = newSVpvn("", 0);