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