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