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 RGS |
11 | our @ISA = qw(Exporter); |
12 | our @EXPORT = qw(&Mksymlists); | |
eb7cfb31 | 13 | our $VERSION = '6.70'; |
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}) { |
2d4cc5ff | 30 | foreach my $package (sort keys %{$spec{DL_FUNCS}}) { |
a592ba15 | 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 RGS |
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 RGS |
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 RGS |
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 GS |
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 IZ |
86 | my $distname = $data->{DISTNAME} || $data->{NAME}; |
87 | $distname = "Distribution $distname"; | |
f6d6199c | 88 | my $patchlevel = " pl$Config{perl_patchlevel}" || ''; |
eb7cfb31 | 89 | my $comment = sprintf "Perl (v%s%s%s) module %s", |
f6d6199c | 90 | $Config::Config{version}, $threaded, $patchlevel, $data->{NAME}; |
52e4c282 | 91 | chomp $comment; |
3cfae81b | 92 | if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { |
a592ba15 RGS |
93 | $distname = 'perl5-porters@perl.org'; |
94 | $comment = "Core $comment"; | |
3cfae81b | 95 | } |
1102eebe IZ |
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 RGS |
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}}; | |
2d4cc5ff YO |
109 | _print_imports($def, $data); |
110 | close $def; | |
111 | } | |
112 | ||
113 | sub _print_imports { | |
114 | my ($def, $data)= @_; | |
115 | my $imports= $data->{IMPORTS} | |
116 | or return; | |
78fd4358 | 117 | if ( keys %$imports ) { |
a592ba15 | 118 | print $def "IMPORTS\n"; |
2d4cc5ff YO |
119 | foreach my $name (sort keys %$imports) { |
120 | print $def " $name=$imports->{$name}\n"; | |
a592ba15 | 121 | } |
c2e89b3d | 122 | } |
c07a80fd | 123 | } |
124 | ||
68dc0745 | 125 | sub _write_win32 { |
126 | my($data) = @_; | |
127 | ||
3e3baf6d | 128 | require Config; |
68dc0745 | 129 | if (not $data->{DLBASE}) { |
130 | ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; | |
131 | $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; | |
132 | } | |
133 | rename "$data->{FILE}.def", "$data->{FILE}_def.old"; | |
134 | ||
a592ba15 | 135 | open( my $def, ">", "$data->{FILE}.def" ) |
68dc0745 | 136 | or croak("Can't create $data->{FILE}.def: $!\n"); |
84902520 | 137 | # put library name in quotes (it could be a keyword, like 'Alias') |
5b0d9cbe | 138 | if ($Config::Config{'cc'} !~ /^gcc/i) { |
a592ba15 | 139 | print $def "LIBRARY \"$data->{DLBASE}\"\n"; |
5b0d9cbe | 140 | } |
a592ba15 | 141 | print $def "EXPORTS\n "; |
84902520 TB |
142 | my @syms; |
143 | # Export public symbols both with and without underscores to | |
144 | # ensure compatibility between DLLs from different compilers | |
145 | # NOTE: DynaLoader itself only uses the names without underscores, | |
146 | # so this is only to cover the case when the extension DLL may be | |
147 | # linked to directly from C. GSAR 97-07-10 | |
3e3baf6d | 148 | if ($Config::Config{'cc'} =~ /^bcc/i) { |
a592ba15 RGS |
149 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { |
150 | push @syms, "_$_", "$_ = _$_"; | |
151 | } | |
3e3baf6d | 152 | } |
84902520 | 153 | else { |
a592ba15 RGS |
154 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { |
155 | push @syms, "$_", "_$_ = $_"; | |
156 | } | |
84902520 | 157 | } |
a592ba15 | 158 | print $def join("\n ",@syms, "\n") if @syms; |
2d4cc5ff | 159 | _print_imports($def, $data); |
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 RGS |
187 | |
188 | foreach my $sym (@{$data->{FUNCLIST}}) { | |
ff0cee69 | 189 | my $safe = $set->addsym($sym); |
a592ba15 RGS |
190 | if ($isvax) { print $opt "UNIVERSAL=$safe\n" } |
191 | else { print $opt "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; } | |
c07a80fd | 192 | } |
a592ba15 RGS |
193 | |
194 | foreach my $sym (@{$data->{DL_VARS}}) { | |
ff0cee69 | 195 | my $safe = $set->addsym($sym); |
a592ba15 RGS |
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 | } |
eb7cfb31 | 200 | |
a592ba15 | 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; | |
2d4cc5ff | 215 | Mksymlists( NAME => $name , |
c07a80fd | 216 | DL_VARS => [ $var1, $var2, $var3 ], |
217 | DL_FUNCS => { $pkg1 => [ $func1, $func2 ], | |
2d4cc5ff | 218 | $pkg2 => [ $func3 ] ); |
c07a80fd | 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 JD |
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 JD |
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 | |
2d4cc5ff | 284 | Mksymlists( NAME => $name , |
875fa795 | 285 | FUNCLIST => [ $func1, $func2 ], |
2d4cc5ff | 286 | DL_FUNCS => { $pkg => [] } ); |
c07a80fd | 287 | |
875fa795 JD |
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. |