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 | ||
45 | #include "dlutils.c" /* for SaveError() etc */ | |
46 | ||
8e07c86e AD |
47 | static AV *dl_resolve_using = Nullav; |
48 | static AV *dl_require_symbols = Nullav; | |
49 | ||
a0d0e21e | 50 | static void |
cea2e8a9 | 51 | dl_private_init(pTHX) |
a0d0e21e LW |
52 | { |
53 | int dlderr; | |
cea2e8a9 GS |
54 | dl_generic_private_init(aTHX); |
55 | dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); | |
56 | dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); | |
a0d0e21e LW |
57 | #ifdef __linux__ |
58 | dlderr = dld_init("/proc/self/exe"); | |
59 | if (dlderr) { | |
60 | #endif | |
6b88bc9c | 61 | dlderr = dld_init(dld_find_executable(PL_origargv[0])); |
a0d0e21e LW |
62 | if (dlderr) { |
63 | char *msg = dld_strerror(dlderr); | |
cea2e8a9 | 64 | SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); |
760ac839 | 65 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError)); |
a0d0e21e LW |
66 | } |
67 | #ifdef __linux__ | |
68 | } | |
69 | #endif | |
70 | } | |
71 | ||
72 | ||
73 | MODULE = DynaLoader PACKAGE = DynaLoader | |
74 | ||
75 | BOOT: | |
76 | (void)dl_private_init(); | |
77 | ||
78 | ||
79 | char * | |
ff7f3c60 | 80 | dl_load_file(filename, flags=0) |
a0d0e21e | 81 | char * filename |
ff7f3c60 NIS |
82 | int flags |
83 | PREINIT: | |
a0d0e21e LW |
84 | int dlderr,x,max; |
85 | GV *gv; | |
ff7f3c60 | 86 | CODE: |
a0d0e21e | 87 | RETVAL = filename; |
ff7f3c60 NIS |
88 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); |
89 | if (flags & 0x01) | |
cea2e8a9 | 90 | Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); |
8e07c86e AD |
91 | max = AvFILL(dl_require_symbols); |
92 | for (x = 0; x <= max; x++) { | |
93 | char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); | |
760ac839 | 94 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym)); |
8e07c86e | 95 | if (dlderr = dld_create_reference(sym)) { |
cea2e8a9 | 96 | SaveError(aTHX_ "dld_create_reference(%s): %s", sym, |
8e07c86e AD |
97 | dld_strerror(dlderr)); |
98 | goto haverror; | |
a0d0e21e LW |
99 | } |
100 | } | |
8e07c86e | 101 | |
760ac839 | 102 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename)); |
a0d0e21e | 103 | if (dlderr = dld_link(filename)) { |
cea2e8a9 | 104 | SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); |
a0d0e21e LW |
105 | goto haverror; |
106 | } | |
8e07c86e AD |
107 | |
108 | max = AvFILL(dl_resolve_using); | |
109 | for (x = 0; x <= max; x++) { | |
110 | char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); | |
760ac839 | 111 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym)); |
8e07c86e | 112 | if (dlderr = dld_link(sym)) { |
cea2e8a9 | 113 | SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); |
8e07c86e | 114 | goto haverror; |
a0d0e21e LW |
115 | } |
116 | } | |
760ac839 | 117 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL)); |
a0d0e21e LW |
118 | haverror: |
119 | ST(0) = sv_newmortal() ; | |
120 | if (dlderr == 0) | |
121 | sv_setiv(ST(0), (IV)RETVAL); | |
122 | ||
123 | ||
124 | void * | |
125 | dl_find_symbol(libhandle, symbolname) | |
126 | void * libhandle | |
127 | char * symbolname | |
128 | CODE: | |
760ac839 | 129 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", |
a0d0e21e LW |
130 | libhandle, symbolname)); |
131 | RETVAL = (void *)dld_get_func(symbolname); | |
132 | /* if RETVAL==NULL we should try looking for a non-function symbol */ | |
760ac839 | 133 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); |
a0d0e21e LW |
134 | ST(0) = sv_newmortal() ; |
135 | if (RETVAL == NULL) | |
cea2e8a9 | 136 | SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; |
a0d0e21e LW |
137 | else |
138 | sv_setiv(ST(0), (IV)RETVAL); | |
139 | ||
140 | ||
141 | void | |
142 | dl_undef_symbols() | |
143 | PPCODE: | |
144 | if (dld_undefined_sym_count) { | |
145 | int x; | |
146 | char **undef_syms = dld_list_undefined_sym(); | |
924508f0 | 147 | EXTEND(SP, dld_undefined_sym_count); |
a0d0e21e LW |
148 | for (x=0; x < dld_undefined_sym_count; x++) |
149 | PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); | |
150 | free(undef_syms); | |
151 | } | |
152 | ||
153 | ||
154 | ||
155 | # These functions should not need changing on any platform: | |
156 | ||
157 | void | |
158 | dl_install_xsub(perl_name, symref, filename="$Package") | |
159 | char * perl_name | |
160 | void * symref | |
161 | char * filename | |
162 | CODE: | |
760ac839 | 163 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", |
a0d0e21e | 164 | perl_name, symref)); |
cea2e8a9 GS |
165 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
166 | (void(*)(pTHX_ CV *))symref, | |
167 | filename))); | |
a0d0e21e LW |
168 | |
169 | ||
170 | char * | |
171 | dl_error() | |
172 | CODE: | |
173 | RETVAL = LastError ; | |
174 | OUTPUT: | |
175 | RETVAL | |
176 | ||
177 | # end. |