Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* |
2 | * Author: Jeff Okamoto (okamoto@corp.hp.com) | |
75f92628 | 3 | * Version: 2.1, 1995/1/25 |
a0d0e21e LW |
4 | */ |
5 | ||
b13ecc09 CP |
6 | /* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing |
7 | * symbols to stderr message on fatal error. | |
8 | * | |
9 | * o Added BIND_NONFATAL comment to default condition. | |
10 | * | |
11 | * Chuck Phillips (cdp@fc.hp.com) | |
12 | * Version: 2.2, 1997/5/4 */ | |
13 | ||
a0d0e21e LW |
14 | #ifdef __hp9000s300 |
15 | #define magic hpux_magic | |
16 | #define MAGIC HPUX_MAGIC | |
17 | #endif | |
18 | ||
19 | #include <dl.h> | |
20 | #ifdef __hp9000s300 | |
21 | #undef magic | |
22 | #undef MAGIC | |
23 | #endif | |
24 | ||
73e43954 | 25 | #define PERL_EXT |
a0d0e21e | 26 | #include "EXTERN.h" |
11f610b5 | 27 | #define PERL_IN_DL_HPUX_XS |
a0d0e21e LW |
28 | #include "perl.h" |
29 | #include "XSUB.h" | |
30 | ||
cdc73a10 JH |
31 | typedef struct { |
32 | AV * x_resolve_using; | |
33 | } my_cxtx_t; /* this *must* be named my_cxtx_t */ | |
a0d0e21e | 34 | |
cdc73a10 | 35 | #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ |
a0d0e21e LW |
36 | #include "dlutils.c" /* for SaveError() etc */ |
37 | ||
cdc73a10 | 38 | #define dl_resolve_using (dl_cxtx.x_resolve_using) |
a0d0e21e LW |
39 | |
40 | static void | |
cea2e8a9 | 41 | dl_private_init(pTHX) |
a0d0e21e | 42 | { |
cea2e8a9 | 43 | (void)dl_generic_private_init(aTHX); |
cdc73a10 JH |
44 | { |
45 | dMY_CXT; | |
46 | dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); | |
47 | } | |
a0d0e21e LW |
48 | } |
49 | ||
50 | MODULE = DynaLoader PACKAGE = DynaLoader | |
51 | ||
52 | BOOT: | |
cea2e8a9 | 53 | (void)dl_private_init(aTHX); |
a0d0e21e LW |
54 | |
55 | ||
63d7ac5f | 56 | void |
ff7f3c60 NIS |
57 | dl_load_file(filename, flags=0) |
58 | char * filename | |
59 | int flags | |
60 | PREINIT: | |
a0d0e21e | 61 | shl_t obj = NULL; |
8e07c86e | 62 | int i, max, bind_type; |
cdc73a10 | 63 | dMY_CXT; |
c6a08c25 | 64 | CODE: |
bf49b057 | 65 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); |
ff7f3c60 | 66 | if (flags & 0x01) |
cea2e8a9 | 67 | Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); |
b13ecc09 CP |
68 | if (dl_nonlazy) { |
69 | bind_type = BIND_IMMEDIATE|BIND_VERBOSE; | |
70 | } else { | |
71 | bind_type = BIND_DEFERRED; | |
72 | /* For certain libraries, like DCE, deferred binding often causes run | |
73 | * time problems. Adding BIND_NONFATAL to BIND_IMMEDIATE still allows | |
74 | * unresolved references in situations like this. */ | |
75 | /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ | |
76 | } | |
491527d0 GS |
77 | /* BIND_NOSTART removed from bind_type because it causes the shared library's */ |
78 | /* initialisers not to be run. This causes problems with all of the static objects */ | |
79 | /* in the library. */ | |
d43d69ec JO |
80 | #ifdef DEBUGGING |
81 | if (dl_debug) | |
82 | bind_type |= BIND_VERBOSE; | |
83 | #endif /* DEBUGGING */ | |
8e07c86e AD |
84 | |
85 | max = AvFILL(dl_resolve_using); | |
86 | for (i = 0; i <= max; i++) { | |
87 | char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); | |
bf49b057 | 88 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym)); |
491527d0 | 89 | obj = shl_load(sym, bind_type, 0L); |
8e07c86e AD |
90 | if (obj == NULL) { |
91 | goto end; | |
75f92628 AD |
92 | } |
93 | } | |
94 | ||
bf49b057 | 95 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename)); |
491527d0 | 96 | obj = shl_load(filename, bind_type, 0L); |
75f92628 | 97 | |
7fa99c80 | 98 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%p\n", (void*)obj)); |
75f92628 | 99 | end: |
a0d0e21e LW |
100 | ST(0) = sv_newmortal() ; |
101 | if (obj == NULL) | |
cea2e8a9 | 102 | SaveError(aTHX_ "%s",Strerror(errno)); |
a0d0e21e | 103 | else |
3175b8cd | 104 | sv_setiv( ST(0), PTR2IV(obj) ); |
a0d0e21e LW |
105 | |
106 | ||
4b1aa53e NW |
107 | int |
108 | dl_unload_file(libref) | |
109 | void * libref | |
110 | CODE: | |
111 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); | |
cea80896 | 112 | RETVAL = (shl_unload((shl_t)libref) == 0 ? 1 : 0); |
4b1aa53e NW |
113 | if (!RETVAL) |
114 | SaveError(aTHX_ "%s", Strerror(errno)); | |
115 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); | |
116 | OUTPUT: | |
117 | RETVAL | |
118 | ||
119 | ||
63d7ac5f | 120 | void |
fd46a708 | 121 | dl_find_symbol(libhandle, symbolname, ign_err=0) |
a0d0e21e LW |
122 | void * libhandle |
123 | char * symbolname | |
fd46a708 | 124 | int ign_err |
3e584864 | 125 | PREINIT: |
a0d0e21e LW |
126 | shl_t obj = (shl_t) libhandle; |
127 | void *symaddr = NULL; | |
128 | int status; | |
b95d43c1 | 129 | CODE: |
a0d0e21e | 130 | #ifdef __hp9000s300 |
7a3f2258 | 131 | symbolname = Perl_form_nocontext("_%s", symbolname); |
a0d0e21e | 132 | #endif |
bf49b057 | 133 | DLDEBUG(2, PerlIO_printf(Perl_debug_log, |
46fc3d4c | 134 | "dl_find_symbol(handle=%lx, symbol=%s)\n", |
135 | (unsigned long) libhandle, symbolname)); | |
136 | ||
8e07c86e AD |
137 | ST(0) = sv_newmortal() ; |
138 | errno = 0; | |
139 | ||
a0d0e21e | 140 | status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); |
7fa99c80 | 141 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %p\n", (void*)symaddr)); |
8e07c86e AD |
142 | |
143 | if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ | |
144 | status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); | |
7fa99c80 | 145 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %p\n", (void*)symaddr)); |
8e07c86e AD |
146 | } |
147 | ||
75f92628 | 148 | if (status == -1) { |
fd46a708 | 149 | if (!ign_err) SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ; |
75f92628 | 150 | } else { |
3175b8cd | 151 | sv_setiv( ST(0), PTR2IV(symaddr) ); |
75f92628 | 152 | } |
a0d0e21e LW |
153 | |
154 | ||
8e07c86e | 155 | void |
a0d0e21e | 156 | dl_undef_symbols() |
63d7ac5f | 157 | CODE: |
a0d0e21e LW |
158 | |
159 | ||
160 | ||
161 | # These functions should not need changing on any platform: | |
162 | ||
163 | void | |
164 | dl_install_xsub(perl_name, symref, filename="$Package") | |
165 | char * perl_name | |
166 | void * symref | |
d3f5e399 | 167 | const char * filename |
a0d0e21e | 168 | CODE: |
7fa99c80 JH |
169 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%p)\n", |
170 | perl_name, (void*)symref)); | |
77004dee NC |
171 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
172 | (void(*)(pTHX_ CV *))symref, | |
173 | filename, NULL, | |
174 | XS_DYNAMIC_FILENAME))); | |
a0d0e21e | 175 | |
bb6a367a | 176 | SV * |
a0d0e21e LW |
177 | dl_error() |
178 | CODE: | |
cdc73a10 | 179 | dMY_CXT; |
bb6a367a | 180 | RETVAL = newSVsv(MY_CXT.x_dl_last_error); |
a0d0e21e LW |
181 | OUTPUT: |
182 | RETVAL | |
183 | ||
8c472fc1 CB |
184 | #if defined(USE_ITHREADS) |
185 | ||
186 | void | |
187 | CLONE(...) | |
188 | CODE: | |
189 | MY_CXT_CLONE; | |
190 | ||
3bd46979 DM |
191 | PERL_UNUSED_VAR(items); |
192 | ||
8c472fc1 CB |
193 | /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid |
194 | * using Perl variables that belong to another thread, we create our | |
195 | * own for this thread. | |
196 | */ | |
c2b90b61 | 197 | MY_CXT.x_dl_last_error = newSVpvs(""); |
8c472fc1 CB |
198 | dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); |
199 | ||
200 | #endif | |
201 | ||
a0d0e21e | 202 | # end. |