Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | /* |
2 | * Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org> | |
3 | * | |
4 | * based upon the file "dl.c", which is | |
5 | * Copyright (c) 1994, Larry Wall | |
6 | * | |
7 | * You may distribute under the terms of either the GNU General Public | |
8 | * License or the Artistic License, as specified in the README file. | |
9 | * | |
10 | * $Date: 1994/03/07 00:21:43 $ | |
11 | * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $ | |
12 | * $Revision: 1.4 $ | |
13 | * $State: Exp $ | |
14 | * | |
15 | * $Log: dld_dl.c,v $ | |
16 | * Removed implicit link against libc. 1994/09/14 William Setzer. | |
17 | * | |
18 | * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce. | |
19 | * | |
20 | * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer. | |
21 | * | |
22 | * Revision 1.4 1994/03/07 00:21:43 rsanders | |
23 | * added min symbol count for load_libs and switched order so system libs | |
24 | * are loaded after app-specified libs. | |
25 | * | |
26 | * Revision 1.3 1994/03/05 01:17:26 rsanders | |
27 | * added path searching. | |
28 | * | |
29 | * Revision 1.2 1994/03/05 00:52:39 rsanders | |
30 | * added package-specified libraries. | |
31 | * | |
32 | * Revision 1.1 1994/03/05 00:33:40 rsanders | |
33 | * Initial revision | |
34 | * | |
35 | * | |
36 | */ | |
37 | ||
38 | #include "EXTERN.h" | |
39 | #include "perl.h" | |
40 | #include "XSUB.h" | |
41 | ||
42 | #include <dld.h> /* GNU DLD header file */ | |
43 | #include <unistd.h> | |
44 | ||
cdc73a10 JH |
45 | typedef struct { |
46 | AV * x_resolve_using; | |
47 | AV * x_require_symbols; | |
48 | } my_cxtx_t; /* this *must* be named my_cxtx_t */ | |
49 | ||
50 | #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ | |
a0d0e21e LW |
51 | #include "dlutils.c" /* for SaveError() etc */ |
52 | ||
cdc73a10 JH |
53 | #define dl_resolve_using (dl_cxtx.x_resolve_using) |
54 | #define dl_require_symbols (dl_cxtx.x_require_symbols) | |
8e07c86e | 55 | |
a0d0e21e | 56 | static void |
cea2e8a9 | 57 | dl_private_init(pTHX) |
a0d0e21e | 58 | { |
cea2e8a9 | 59 | dl_generic_private_init(aTHX); |
cdc73a10 JH |
60 | { |
61 | int dlderr; | |
62 | dMY_CXT; | |
63 | ||
64 | dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); | |
65 | dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); | |
a0d0e21e | 66 | #ifdef __linux__ |
cdc73a10 JH |
67 | dlderr = dld_init("/proc/self/exe"); |
68 | if (dlderr) { | |
a0d0e21e | 69 | #endif |
cdc73a10 JH |
70 | dlderr = dld_init(dld_find_executable(PL_origargv[0])); |
71 | if (dlderr) { | |
72 | char *msg = dld_strerror(dlderr); | |
73 | SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); | |
74 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); | |
75 | } | |
a0d0e21e | 76 | #ifdef __linux__ |
cdc73a10 | 77 | } |
a0d0e21e | 78 | #endif |
cdc73a10 | 79 | } |
a0d0e21e LW |
80 | } |
81 | ||
82 | ||
83 | MODULE = DynaLoader PACKAGE = DynaLoader | |
84 | ||
85 | BOOT: | |
86 | (void)dl_private_init(); | |
87 | ||
88 | ||
89 | char * | |
ff7f3c60 | 90 | dl_load_file(filename, flags=0) |
a0d0e21e | 91 | char * filename |
ff7f3c60 NIS |
92 | int flags |
93 | PREINIT: | |
a0d0e21e LW |
94 | int dlderr,x,max; |
95 | GV *gv; | |
cdc73a10 | 96 | dMY_CXT; |
ec2c99ef | 97 | CODE: |
a0d0e21e | 98 | RETVAL = filename; |
bf49b057 | 99 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); |
ff7f3c60 | 100 | if (flags & 0x01) |
cea2e8a9 | 101 | Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); |
8e07c86e AD |
102 | max = AvFILL(dl_require_symbols); |
103 | for (x = 0; x <= max; x++) { | |
104 | char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); | |
bf49b057 | 105 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); |
8e07c86e | 106 | if (dlderr = dld_create_reference(sym)) { |
cea2e8a9 | 107 | SaveError(aTHX_ "dld_create_reference(%s): %s", sym, |
8e07c86e AD |
108 | dld_strerror(dlderr)); |
109 | goto haverror; | |
a0d0e21e LW |
110 | } |
111 | } | |
8e07c86e | 112 | |
bf49b057 | 113 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); |
a0d0e21e | 114 | if (dlderr = dld_link(filename)) { |
cea2e8a9 | 115 | SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); |
a0d0e21e LW |
116 | goto haverror; |
117 | } | |
8e07c86e AD |
118 | |
119 | max = AvFILL(dl_resolve_using); | |
120 | for (x = 0; x <= max; x++) { | |
121 | char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); | |
bf49b057 | 122 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); |
8e07c86e | 123 | if (dlderr = dld_link(sym)) { |
cea2e8a9 | 124 | SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); |
8e07c86e | 125 | goto haverror; |
a0d0e21e LW |
126 | } |
127 | } | |
bf49b057 | 128 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL)); |
a0d0e21e LW |
129 | haverror: |
130 | ST(0) = sv_newmortal() ; | |
131 | if (dlderr == 0) | |
f66f545a | 132 | sv_setiv(ST(0), PTR2IV(RETVAL)); |
a0d0e21e LW |
133 | |
134 | ||
135 | void * | |
136 | dl_find_symbol(libhandle, symbolname) | |
137 | void * libhandle | |
138 | char * symbolname | |
139 | CODE: | |
bf49b057 | 140 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", |
a0d0e21e LW |
141 | libhandle, symbolname)); |
142 | RETVAL = (void *)dld_get_func(symbolname); | |
143 | /* if RETVAL==NULL we should try looking for a non-function symbol */ | |
bf49b057 | 144 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); |
a0d0e21e LW |
145 | ST(0) = sv_newmortal() ; |
146 | if (RETVAL == NULL) | |
cea2e8a9 | 147 | SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; |
a0d0e21e | 148 | else |
f66f545a | 149 | sv_setiv(ST(0), PTR2IV(RETVAL)); |
a0d0e21e LW |
150 | |
151 | ||
152 | void | |
153 | dl_undef_symbols() | |
154 | PPCODE: | |
155 | if (dld_undefined_sym_count) { | |
156 | int x; | |
157 | char **undef_syms = dld_list_undefined_sym(); | |
924508f0 | 158 | EXTEND(SP, dld_undefined_sym_count); |
a0d0e21e LW |
159 | for (x=0; x < dld_undefined_sym_count; x++) |
160 | PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); | |
161 | free(undef_syms); | |
162 | } | |
163 | ||
164 | ||
165 | ||
166 | # These functions should not need changing on any platform: | |
167 | ||
168 | void | |
169 | dl_install_xsub(perl_name, symref, filename="$Package") | |
170 | char * perl_name | |
171 | void * symref | |
172 | char * filename | |
173 | CODE: | |
bf49b057 | 174 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", |
a0d0e21e | 175 | perl_name, symref)); |
77004dee NC |
176 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
177 | (void(*)(pTHX_ CV *))symref, | |
178 | filename, NULL, | |
179 | XS_DYNAMIC_FILENAME))); | |
a0d0e21e LW |
180 | |
181 | char * | |
182 | dl_error() | |
ec2c99ef | 183 | PREINIT: |
cdc73a10 | 184 | dMY_CXT; |
ec2c99ef | 185 | CODE: |
cdc73a10 | 186 | RETVAL = dl_last_error ; |
a0d0e21e LW |
187 | OUTPUT: |
188 | RETVAL | |
189 | ||
190 | # end. |