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