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 * Adapted for use with FreeMINT after dld support was removed from perl.
16 *
17 * $Log: dld_dl.c,v $
18 * Removed implicit link against libc. 1994/09/14 William Setzer.
19 *
20 * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce.
21 *
22 * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer.
23 *
24 * Revision 1.4 1994/03/07 00:21:43 rsanders
25 * added min symbol count for load_libs and switched order so system libs
26 * are loaded after app-specified libs.
27 *
28 * Revision 1.3 1994/03/05 01:17:26 rsanders
29 * added path searching.
30 *
31 * Revision 1.2 1994/03/05 00:52:39 rsanders
32 * added package-specified libraries.
33 *
34 * Revision 1.1 1994/03/05 00:33:40 rsanders
35 * Initial revision
36 *
37 *
38 */
39
40 #define PERL_EXT
41 #include "EXTERN.h"
42 #define PERL_IN_DL_FREEMINT_XS
43 #include "perl.h"
44 #include "XSUB.h"
45
46 #include <dld.h> /* GNU DLD header file */
47 #include <unistd.h>
48
49 typedef struct {
50 AV * x_resolve_using;
51 AV * x_require_symbols;
52 } my_cxtx_t; /* this *must* be named my_cxtx_t */
53
54 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
55 #include "dlutils.c" /* for SaveError() etc */
56
57 #define dl_resolve_using (dl_cxtx.x_resolve_using)
58 #define dl_require_symbols (dl_cxtx.x_require_symbols)
59
60 static void
dl_private_init(pTHX)61 dl_private_init(pTHX)
62 {
63 dl_generic_private_init(aTHX);
64 {
65 int dlderr;
66 dMY_CXT;
67
68 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
69 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
70 dlderr = dld_init("/kern/self/exe");
71 if (dlderr) {
72 dlderr = dld_init(dld_find_executable(PL_origargv[0]));
73 if (dlderr) {
74 char *msg = dld_strerror(dlderr);
75 SaveError(aTHX_ "dld_init(%s) failed: %s", dld_find_executable(PL_origargv[0]), msg);
76 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error));
77 }
78 }
79 }
80 }
81
82
83 MODULE = DynaLoader PACKAGE = DynaLoader
84
85 BOOT:
86 (void)dl_private_init();
87
88
89 void
90 dl_load_file(filename, flags=0)
91 char * filename
92 int flags
93 PREINIT:
94 int dlderr,x,max;
95 GV *gv;
96 dMY_CXT;
97 CODE:
98 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
99 if (flags & 0x01)
100 Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
101 max = AvFILL(dl_require_symbols);
102 for (x = 0; x <= max; x++) {
103 char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
104 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
105 if (dlderr = dld_create_reference(sym)) {
106 SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
107 dld_strerror(dlderr));
108 goto haverror;
109 }
110 }
111
112 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
113 if (dlderr = dld_link(filename)) {
114 SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr));
115 goto haverror;
116 }
117
118 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libm.a)\n"));
119 if (dlderr = dld_link("/usr/lib/libm.a")) {
120 SaveError(aTHX_ "dld_link(libm.a): %s", dld_strerror(dlderr));
121 goto haverror;
122 }
123
124 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libc.a)\n"));
125 if (dlderr = dld_link("/usr/lib/libc.a")) {
126 SaveError(aTHX_ "dld_link(libc.a): %s", dld_strerror(dlderr));
127 goto haverror;
128 }
129
130 max = AvFILL(dl_resolve_using);
131 for (x = 0; x <= max; x++) {
132 char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
133 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
134 if (dlderr = dld_link(sym)) {
135 SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
136 goto haverror;
137 }
138 }
139 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", filename));
140 haverror:
141 ST(0) = sv_newmortal() ;
142 if (dlderr == 0)
143 sv_setiv(ST(0), PTR2IV(filename));
144 XSRETURN(1);
145
146
147 void
148 dl_find_symbol(libhandle, symbolname, ign_err=0)
149 void * libhandle
150 char * symbolname
151 int ign_err
152 PREINIT:
153 void *retv;
154 CODE:
155 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
156 libhandle, symbolname));
157 retv = (void *)dld_get_func(symbolname);
158 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", (unsigned int)retv));
159 ST(0) = sv_newmortal() ;
160 if (retv == NULL) {
161 if (!ign_err)
162 SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
163 } else
164 sv_setiv(ST(0), PTR2IV(retv));
165 XSRETURN(1);
166
167
168 void
169 dl_undef_symbols()
170 PPCODE:
171 if (dld_undefined_sym_count) {
172 int x;
173 char **undef_syms = dld_list_undefined_sym();
174 EXTEND(SP, dld_undefined_sym_count);
175 for (x=0; x < dld_undefined_sym_count; x++)
176 PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
177 free(undef_syms);
178 }
179
180
181
182 # These functions should not need changing on any platform:
183
184 void
185 dl_install_xsub(perl_name, symref, filename="$Package")
186 char * perl_name
187 void * symref
188 const char * filename
189 CODE:
190 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
191 perl_name, symref));
192 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
193 (void(*)(pTHX_ CV *))symref,
194 filename, NULL,
195 XS_DYNAMIC_FILENAME)));
196 XSRETURN(1);
197
198 SV *
199 dl_error()
200 CODE:
201 dMY_CXT;
202 RETVAL = newSVsv(MY_CXT.x_dl_last_error);
203 OUTPUT:
204 RETVAL
205
206 #if defined(USE_ITHREADS)
207
208 void
209 CLONE(...)
210 CODE:
211 MY_CXT_CLONE;
212
213 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
214 * using Perl variables that belong to another thread, we create our
215 * own for this thread.
216 */
217 MY_CXT.x_dl_last_error = newSVpvs("");
218 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
219 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
220
221 #endif
222
223 # end.
224