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