1 | package ExtUtils::Mksymlists;
|
---|
2 |
|
---|
3 | use 5.00503;
|
---|
4 | use strict qw[ subs refs ];
|
---|
5 | # no strict 'vars'; # until filehandles are exempted
|
---|
6 |
|
---|
7 | use Carp;
|
---|
8 | use Exporter;
|
---|
9 | use Config;
|
---|
10 |
|
---|
11 | use vars qw(@ISA @EXPORT $VERSION);
|
---|
12 | @ISA = 'Exporter';
|
---|
13 | @EXPORT = '&Mksymlists';
|
---|
14 | $VERSION = 1.19;
|
---|
15 |
|
---|
16 | sub Mksymlists {
|
---|
17 | my(%spec) = @_;
|
---|
18 | my($osname) = $^O;
|
---|
19 |
|
---|
20 | croak("Insufficient information specified to Mksymlists")
|
---|
21 | unless ( $spec{NAME} or
|
---|
22 | ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
|
---|
23 |
|
---|
24 | $spec{DL_VARS} = [] unless $spec{DL_VARS};
|
---|
25 | ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
|
---|
26 | $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
|
---|
27 | $spec{DL_FUNCS} = { $spec{NAME} => [] }
|
---|
28 | unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
|
---|
29 | @{$spec{FUNCLIST}});
|
---|
30 | if (defined $spec{DL_FUNCS}) {
|
---|
31 | my($package);
|
---|
32 | foreach $package (keys %{$spec{DL_FUNCS}}) {
|
---|
33 | my($packprefix,$sym,$bootseen);
|
---|
34 | ($packprefix = $package) =~ s/\W/_/g;
|
---|
35 | foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
|
---|
36 | if ($sym =~ /^boot_/) {
|
---|
37 | push(@{$spec{FUNCLIST}},$sym);
|
---|
38 | $bootseen++;
|
---|
39 | }
|
---|
40 | else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
|
---|
41 | }
|
---|
42 | push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
|
---|
43 | }
|
---|
44 | }
|
---|
45 |
|
---|
46 | # We'll need this if we ever add any OS which uses mod2fname
|
---|
47 | # not as pseudo-builtin.
|
---|
48 | # require DynaLoader;
|
---|
49 | if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
|
---|
50 | $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
|
---|
51 | }
|
---|
52 |
|
---|
53 | if ($osname eq 'aix') { _write_aix(\%spec); }
|
---|
54 | elsif ($osname eq 'MacOS'){ _write_aix(\%spec) }
|
---|
55 | elsif ($osname eq 'VMS') { _write_vms(\%spec) }
|
---|
56 | elsif ($osname eq 'os2') { _write_os2(\%spec) }
|
---|
57 | elsif ($osname eq 'MSWin32') { _write_win32(\%spec) }
|
---|
58 | else { croak("Don't know how to create linker option file for $osname\n"); }
|
---|
59 | }
|
---|
60 |
|
---|
61 |
|
---|
62 | sub _write_aix {
|
---|
63 | my($data) = @_;
|
---|
64 |
|
---|
65 | rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
|
---|
66 |
|
---|
67 | open(EXP,">$data->{FILE}.exp")
|
---|
68 | or croak("Can't create $data->{FILE}.exp: $!\n");
|
---|
69 | print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
|
---|
70 | print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
|
---|
71 | close EXP;
|
---|
72 | }
|
---|
73 |
|
---|
74 |
|
---|
75 | sub _write_os2 {
|
---|
76 | my($data) = @_;
|
---|
77 | require Config;
|
---|
78 | my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : "");
|
---|
79 |
|
---|
80 | if (not $data->{DLBASE}) {
|
---|
81 | ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
|
---|
82 | $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
|
---|
83 | }
|
---|
84 | my $distname = $data->{DISTNAME} || $data->{NAME};
|
---|
85 | $distname = "Distribution $distname";
|
---|
86 | my $patchlevel = " pl$Config{perl_patchlevel}" || '';
|
---|
87 | my $comment = sprintf "Perl (v%s%s%s) module %s",
|
---|
88 | $Config::Config{version}, $threaded, $patchlevel, $data->{NAME};
|
---|
89 | chomp $comment;
|
---|
90 | if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') {
|
---|
91 | $distname = '[email protected]';
|
---|
92 | $comment = "Core $comment";
|
---|
93 | }
|
---|
94 | $comment = "$comment (Perl-config: $Config{config_args})";
|
---|
95 | $comment = substr($comment, 0, 200) . "...)" if length $comment > 203;
|
---|
96 | rename "$data->{FILE}.def", "$data->{FILE}_def.old";
|
---|
97 |
|
---|
98 | open(DEF,">$data->{FILE}.def")
|
---|
99 | or croak("Can't create $data->{FILE}.def: $!\n");
|
---|
100 | print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
|
---|
101 | print DEF "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n";
|
---|
102 | print DEF "CODE LOADONCALL\n";
|
---|
103 | print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
|
---|
104 | print DEF "EXPORTS\n ";
|
---|
105 | print DEF join("\n ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
|
---|
106 | print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
|
---|
107 | if (%{$data->{IMPORTS}}) {
|
---|
108 | print DEF "IMPORTS\n";
|
---|
109 | my ($name, $exp);
|
---|
110 | while (($name, $exp)= each %{$data->{IMPORTS}}) {
|
---|
111 | print DEF " $name=$exp\n";
|
---|
112 | }
|
---|
113 | }
|
---|
114 | close DEF;
|
---|
115 | }
|
---|
116 |
|
---|
117 | sub _write_win32 {
|
---|
118 | my($data) = @_;
|
---|
119 |
|
---|
120 | require Config;
|
---|
121 | if (not $data->{DLBASE}) {
|
---|
122 | ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
|
---|
123 | $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
|
---|
124 | }
|
---|
125 | rename "$data->{FILE}.def", "$data->{FILE}_def.old";
|
---|
126 |
|
---|
127 | open(DEF,">$data->{FILE}.def")
|
---|
128 | or croak("Can't create $data->{FILE}.def: $!\n");
|
---|
129 | # put library name in quotes (it could be a keyword, like 'Alias')
|
---|
130 | if ($Config::Config{'cc'} !~ /^gcc/i) {
|
---|
131 | print DEF "LIBRARY \"$data->{DLBASE}\"\n";
|
---|
132 | }
|
---|
133 | print DEF "EXPORTS\n ";
|
---|
134 | my @syms;
|
---|
135 | # Export public symbols both with and without underscores to
|
---|
136 | # ensure compatibility between DLLs from different compilers
|
---|
137 | # NOTE: DynaLoader itself only uses the names without underscores,
|
---|
138 | # so this is only to cover the case when the extension DLL may be
|
---|
139 | # linked to directly from C. GSAR 97-07-10
|
---|
140 | if ($Config::Config{'cc'} =~ /^bcc/i) {
|
---|
141 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
|
---|
142 | push @syms, "_$_", "$_ = _$_";
|
---|
143 | }
|
---|
144 | }
|
---|
145 | else {
|
---|
146 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) {
|
---|
147 | push @syms, "$_", "_$_ = $_";
|
---|
148 | }
|
---|
149 | }
|
---|
150 | print DEF join("\n ",@syms, "\n") if @syms;
|
---|
151 | if (%{$data->{IMPORTS}}) {
|
---|
152 | print DEF "IMPORTS\n";
|
---|
153 | my ($name, $exp);
|
---|
154 | while (($name, $exp)= each %{$data->{IMPORTS}}) {
|
---|
155 | print DEF " $name=$exp\n";
|
---|
156 | }
|
---|
157 | }
|
---|
158 | close DEF;
|
---|
159 | }
|
---|
160 |
|
---|
161 |
|
---|
162 | sub _write_vms {
|
---|
163 | my($data) = @_;
|
---|
164 |
|
---|
165 | require Config; # a reminder for once we do $^O
|
---|
166 | require ExtUtils::XSSymSet;
|
---|
167 |
|
---|
168 | my($isvax) = $Config::Config{'archname'} =~ /VAX/i;
|
---|
169 | my($set) = new ExtUtils::XSSymSet;
|
---|
170 | my($sym);
|
---|
171 |
|
---|
172 | rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
|
---|
173 |
|
---|
174 | open(OPT,">$data->{FILE}.opt")
|
---|
175 | or croak("Can't create $data->{FILE}.opt: $!\n");
|
---|
176 |
|
---|
177 | # Options file declaring universal symbols
|
---|
178 | # Used when linking shareable image for dynamic extension,
|
---|
179 | # or when linking PerlShr into which we've added this package
|
---|
180 | # as a static extension
|
---|
181 | # We don't do anything to preserve order, so we won't relax
|
---|
182 | # the GSMATCH criteria for a dynamic extension
|
---|
183 |
|
---|
184 | print OPT "case_sensitive=yes\n"
|
---|
185 | if $Config::Config{d_vms_case_sensitive_symbols};
|
---|
186 | foreach $sym (@{$data->{FUNCLIST}}) {
|
---|
187 | my $safe = $set->addsym($sym);
|
---|
188 | if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
|
---|
189 | else { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; }
|
---|
190 | }
|
---|
191 | foreach $sym (@{$data->{DL_VARS}}) {
|
---|
192 | my $safe = $set->addsym($sym);
|
---|
193 | print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
|
---|
194 | if ($isvax) { print OPT "UNIVERSAL=$safe\n" }
|
---|
195 | else { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; }
|
---|
196 | }
|
---|
197 | close OPT;
|
---|
198 |
|
---|
199 | }
|
---|
200 |
|
---|
201 | 1;
|
---|
202 |
|
---|
203 | __END__
|
---|
204 |
|
---|
205 | =head1 NAME
|
---|
206 |
|
---|
207 | ExtUtils::Mksymlists - write linker options files for dynamic extension
|
---|
208 |
|
---|
209 | =head1 SYNOPSIS
|
---|
210 |
|
---|
211 | use ExtUtils::Mksymlists;
|
---|
212 | Mksymlists({ NAME => $name ,
|
---|
213 | DL_VARS => [ $var1, $var2, $var3 ],
|
---|
214 | DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
|
---|
215 | $pkg2 => [ $func3 ] });
|
---|
216 |
|
---|
217 | =head1 DESCRIPTION
|
---|
218 |
|
---|
219 | C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
|
---|
220 | during the creation of shared libraries for dynamic extensions. It is
|
---|
221 | normally called from a MakeMaker-generated Makefile when the extension
|
---|
222 | is built. The linker option file is generated by calling the function
|
---|
223 | C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
|
---|
224 | It takes one argument, a list of key-value pairs, in which the following
|
---|
225 | keys are recognized:
|
---|
226 |
|
---|
227 | =over 4
|
---|
228 |
|
---|
229 | =item DLBASE
|
---|
230 |
|
---|
231 | This item specifies the name by which the linker knows the
|
---|
232 | extension, which may be different from the name of the
|
---|
233 | extension itself (for instance, some linkers add an '_' to the
|
---|
234 | name of the extension). If it is not specified, it is derived
|
---|
235 | from the NAME attribute. It is presently used only by OS2 and Win32.
|
---|
236 |
|
---|
237 | =item DL_FUNCS
|
---|
238 |
|
---|
239 | This is identical to the DL_FUNCS attribute available via MakeMaker,
|
---|
240 | from which it is usually taken. Its value is a reference to an
|
---|
241 | associative array, in which each key is the name of a package, and
|
---|
242 | each value is an a reference to an array of function names which
|
---|
243 | should be exported by the extension. For instance, one might say
|
---|
244 | C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
|
---|
245 | Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The
|
---|
246 | function names should be identical to those in the XSUB code;
|
---|
247 | C<Mksymlists> will alter the names written to the linker option
|
---|
248 | file to match the changes made by F<xsubpp>. In addition, if
|
---|
249 | none of the functions in a list begin with the string B<boot_>,
|
---|
250 | C<Mksymlists> will add a bootstrap function for that package,
|
---|
251 | just as xsubpp does. (If a B<boot_E<lt>pkgE<gt>> function is
|
---|
252 | present in the list, it is passed through unchanged.) If
|
---|
253 | DL_FUNCS is not specified, it defaults to the bootstrap
|
---|
254 | function for the extension specified in NAME.
|
---|
255 |
|
---|
256 | =item DL_VARS
|
---|
257 |
|
---|
258 | This is identical to the DL_VARS attribute available via MakeMaker,
|
---|
259 | and, like DL_FUNCS, it is usually specified via MakeMaker. Its
|
---|
260 | value is a reference to an array of variable names which should
|
---|
261 | be exported by the extension.
|
---|
262 |
|
---|
263 | =item FILE
|
---|
264 |
|
---|
265 | This key can be used to specify the name of the linker option file
|
---|
266 | (minus the OS-specific extension), if for some reason you do not
|
---|
267 | want to use the default value, which is the last word of the NAME
|
---|
268 | attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
|
---|
269 |
|
---|
270 | =item FUNCLIST
|
---|
271 |
|
---|
272 | This provides an alternate means to specify function names to be
|
---|
273 | exported from the extension. Its value is a reference to an
|
---|
274 | array of function names to be exported by the extension. These
|
---|
275 | names are passed through unaltered to the linker options file.
|
---|
276 | Specifying a value for the FUNCLIST attribute suppresses automatic
|
---|
277 | generation of the bootstrap function for the package. To still create
|
---|
278 | the bootstrap name you have to specify the package name in the
|
---|
279 | DL_FUNCS hash:
|
---|
280 |
|
---|
281 | Mksymlists({ NAME => $name ,
|
---|
282 | FUNCLIST => [ $func1, $func2 ],
|
---|
283 | DL_FUNCS => { $pkg => [] } });
|
---|
284 |
|
---|
285 |
|
---|
286 | =item IMPORTS
|
---|
287 |
|
---|
288 | This attribute is used to specify names to be imported into the
|
---|
289 | extension. It is currently only used by OS/2 and Win32.
|
---|
290 |
|
---|
291 | =item NAME
|
---|
292 |
|
---|
293 | This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
|
---|
294 | the linker option file will be produced.
|
---|
295 |
|
---|
296 | =back
|
---|
297 |
|
---|
298 | When calling C<Mksymlists>, one should always specify the NAME
|
---|
299 | attribute. In most cases, this is all that's necessary. In
|
---|
300 | the case of unusual extensions, however, the other attributes
|
---|
301 | can be used to provide additional information to the linker.
|
---|
302 |
|
---|
303 | =head1 AUTHOR
|
---|
304 |
|
---|
305 | Charles Bailey I<E<lt>[email protected]<gt>>
|
---|
306 |
|
---|
307 | =head1 REVISION
|
---|
308 |
|
---|
309 | Last revised 14-Feb-1996, for Perl 5.002.
|
---|