Commit | Line | Data |
a0d0e21e |
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 |
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 |
51 | #include "dlutils.c" /* for SaveError() etc */ |
52 | |
cdc73a10 |
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 |
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 |
67 | dlderr = dld_init("/proc/self/exe"); |
68 | if (dlderr) { |
a0d0e21e |
69 | #endif |
cdc73a10 |
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 |
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 |
92 | int flags |
93 | PREINIT: |
a0d0e21e |
94 | int dlderr,x,max; |
95 | GV *gv; |
ff7f3c60 |
96 | CODE: |
cdc73a10 |
97 | dMY_CXT; |
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 |
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 |
108 | dld_strerror(dlderr)); |
109 | goto haverror; |
a0d0e21e |
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 |
116 | goto haverror; |
117 | } |
8e07c86e |
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 |
126 | } |
127 | } |
bf49b057 |
128 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL)); |
a0d0e21e |
129 | haverror: |
130 | ST(0) = sv_newmortal() ; |
131 | if (dlderr == 0) |
f66f545a |
132 | sv_setiv(ST(0), PTR2IV(RETVAL)); |
a0d0e21e |
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 |
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 |
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 |
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 |
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)); |
cea2e8a9 |
176 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
177 | (void(*)(pTHX_ CV *))symref, |
178 | filename))); |
a0d0e21e |
179 | |
180 | |
181 | char * |
182 | dl_error() |
183 | CODE: |
cdc73a10 |
184 | dMY_CXT; |
185 | RETVAL = dl_last_error ; |
a0d0e21e |
186 | OUTPUT: |
187 | RETVAL |
188 | |
189 | # end. |