This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_mpeix.xs
CommitLineData
1d84e8df
JH
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)
9d7f10f2 5 * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu)
feb33499 6 * Version: 2.4, 2002/03/24 Mark Bixby (mark@bixby.org)
1d84e8df
JH
7 */
8
9#include "EXTERN.h"
10#include "perl.h"
11#include "XSUB.h"
12
13#ifdef __GNUC__
14extern void HPGETPROCPLABEL( int parms,
15 char * procname,
feb33499 16 void * plabel,
1d84e8df
JH
17 int * status,
18 char * firstfile,
19 int casesensitive,
20 int symboltype,
21 int * datasize,
22 int position,
23 int searchpath,
24 int binding);
25#else
26#pragma intrinsic HPGETPROCPLABEL
27#endif
28#include "dlutils.c" /* for SaveError() etc */
29
30typedef struct {
31 char filename[PATH_MAX + 3];
32 } t_mpe_dld, *p_mpe_dld;
33
1d84e8df 34static void
cea2e8a9 35dl_private_init(pTHX)
1d84e8df 36{
cea2e8a9 37 (void)dl_generic_private_init(aTHX);
1d84e8df
JH
38}
39
40MODULE = DynaLoader PACKAGE = DynaLoader
41
42BOOT:
cea2e8a9 43 (void)dl_private_init(aTHX);
1d84e8df
JH
44
45void *
46dl_load_file(filename, flags=0)
47 char * filename
48 int flags
49 PREINIT:
50 char buf[PATH_MAX + 3];
51 p_mpe_dld obj = NULL;
d05c1ba0 52
1d84e8df 53 CODE:
bf49b057 54 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,
1d84e8df
JH
55flags));
56 if (flags & 0x01)
4cbfc073
JH
57 Perl_warn(aTHX_
58"Can't make loaded symbols global on this platform while loading %s",filename);
1d84e8df
JH
59 obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
60 memzero(obj, sizeof(t_mpe_dld));
9d7f10f2 61 if (filename[0] != '/')
1d84e8df
JH
62 {
63 getcwd(buf,sizeof(buf));
9d7f10f2 64 sprintf(obj->filename," %s/%s ",buf,filename);
1d84e8df
JH
65 }
66 else
9d7f10f2 67 sprintf(obj->filename," %s ",filename);
1d84e8df 68
bf49b057 69 DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));
1d84e8df
JH
70
71 ST(0) = sv_newmortal() ;
72 if (obj == NULL)
cea2e8a9 73 SaveError(aTHX_"%s",Strerror(errno));
1d84e8df 74 else
3175b8cd 75 sv_setiv( ST(0), PTR2IV(obj) );
1d84e8df
JH
76
77void *
78dl_find_symbol(libhandle, symbolname)
79 void * libhandle
80 char * symbolname
81 CODE:
82 int datalen;
83 p_mpe_dld obj = (p_mpe_dld) libhandle;
84 char symname[PATH_MAX + 3];
85 void * symaddr = NULL;
86 int status;
bf49b057 87 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
1d84e8df
JH
88 libhandle, symbolname));
89 ST(0) = sv_newmortal() ;
90 errno = 0;
91
9d7f10f2 92 sprintf(symname, " %s ", symbolname);
1d84e8df
JH
93 HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
94 0, &datalen, 1, 0, 0);
95
bf49b057 96 DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
1d84e8df
JH
97
98 if (status != 0) {
cea2e8a9 99 SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
1d84e8df 100 } else {
3175b8cd 101 sv_setiv( ST(0), PTR2IV(symaddr) );
1d84e8df
JH
102 }
103
104void
105dl_undef_symbols()
106 PPCODE:
107
108# These functions should not need changing on any platform:
109
110void
111dl_install_xsub(perl_name, symref, filename="$Package")
112 char * perl_name
113 void * symref
114 char * filename
115 CODE:
bf49b057 116 DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
1d84e8df 117 perl_name, symref));
77004dee
NC
118 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
119 (void(*)(pTHX_ CV *))symref,
120 filename, NULL,
121 XS_DYNAMIC_FILENAME)));
1d84e8df
JH
122
123char *
124dl_error()
125 CODE:
cdc73a10
JH
126 dMY_CXT;
127 RETVAL = dl_last_error ;
1d84e8df
JH
128 OUTPUT:
129 RETVAL
130
131# end.