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 | |
45 | #include "dlutils.c" /* for SaveError() etc */ |
46 | |
8e07c86e |
47 | static AV *dl_resolve_using = Nullav; |
48 | static AV *dl_require_symbols = Nullav; |
49 | |
a0d0e21e |
50 | static void |
51 | dl_private_init() |
52 | { |
53 | int dlderr; |
54 | dl_generic_private_init(); |
8e07c86e |
55 | dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); |
56 | dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4); |
a0d0e21e |
57 | #ifdef __linux__ |
58 | dlderr = dld_init("/proc/self/exe"); |
59 | if (dlderr) { |
60 | #endif |
61 | dlderr = dld_init(dld_find_executable(origargv[0])); |
62 | if (dlderr) { |
63 | char *msg = dld_strerror(dlderr); |
64 | SaveError("dld_init(%s) failed: %s", origargv[0], msg); |
760ac839 |
65 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError)); |
a0d0e21e |
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 |
82 | int flags |
83 | PREINIT: |
a0d0e21e |
84 | int dlderr,x,max; |
85 | GV *gv; |
ff7f3c60 |
86 | CODE: |
a0d0e21e |
87 | RETVAL = filename; |
ff7f3c60 |
88 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); |
89 | if (flags & 0x01) |
90 | croak("Can't make loaded symbols global on this platform while loading %s",filename); |
8e07c86e |
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)) { |
96 | SaveError("dld_create_reference(%s): %s", sym, |
97 | dld_strerror(dlderr)); |
98 | goto haverror; |
a0d0e21e |
99 | } |
100 | } |
8e07c86e |
101 | |
760ac839 |
102 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename)); |
a0d0e21e |
103 | if (dlderr = dld_link(filename)) { |
104 | SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr)); |
105 | goto haverror; |
106 | } |
8e07c86e |
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)) { |
113 | SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); |
114 | goto haverror; |
a0d0e21e |
115 | } |
116 | } |
760ac839 |
117 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL)); |
a0d0e21e |
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 |
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 |
134 | ST(0) = sv_newmortal() ; |
135 | if (RETVAL == NULL) |
136 | SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ; |
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(); |
147 | EXTEND(sp, dld_undefined_sym_count); |
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)); |
165 | ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); |
166 | |
167 | |
168 | char * |
169 | dl_error() |
170 | CODE: |
171 | RETVAL = LastError ; |
172 | OUTPUT: |
173 | RETVAL |
174 | |
175 | # end. |