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