Commit | Line | Data |
---|---|---|
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) | |
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. |