Commit | Line | Data |
---|---|---|
c07a80fd | 1 | package ExtUtils::Mksymlists; |
cb50131a | 2 | |
57b1a898 | 3 | use 5.00503; |
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 MS |
10 | |
11 | use vars qw(@ISA @EXPORT $VERSION); | |
f1387719 | 12 | @ISA = 'Exporter'; |
13 | @EXPORT = '&Mksymlists'; | |
69ff8adf | 14 | $VERSION = 1.19; |
c07a80fd | 15 | |
16 | sub Mksymlists { | |
17 | my(%spec) = @_; | |
f1387719 | 18 | my($osname) = $^O; |
c07a80fd | 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}; | |
348844dc | 26 | $spec{FUNCLIST} = [] unless $spec{FUNCLIST}; |
c07a80fd | 27 | $spec{DL_FUNCS} = { $spec{NAME} => [] } |
28 | unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or | |
348844dc | 29 | @{$spec{FUNCLIST}}); |
c07a80fd | 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 | |
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) } |
f1387719 | 58 | else { croak("Don't know how to create linker option file for $osname\n"); } |
c07a80fd | 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) = @_; | |
6ee623d5 GS |
77 | require Config; |
78 | my $threaded = ($Config::Config{archname} =~ /-thread/ ? " threaded" : ""); | |
c07a80fd | 79 | |
80 | if (not $data->{DLBASE}) { | |
81 | ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://; | |
82 | $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_'; | |
83 | } | |
3cfae81b IZ |
84 | my $distname = $data->{DISTNAME} || $data->{NAME}; |
85 | $distname = "Distribution $distname"; | |
f6d6199c MS |
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}; | |
52e4c282 | 89 | chomp $comment; |
3cfae81b IZ |
90 | if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { |
91 | $distname = 'perl5-porters@perl.org'; | |
92 | $comment = "Core $comment"; | |
93 | } | |
1102eebe IZ |
94 | $comment = "$comment (Perl-config: $Config{config_args})"; |
95 | $comment = substr($comment, 0, 200) . "...)" if length $comment > 203; | |
c07a80fd | 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"; | |
3cfae81b | 101 | print DEF "DESCRIPTION '\@#$distname:$data->{VERSION}#\@ $comment'\n"; |
c07a80fd | 102 | print DEF "CODE LOADONCALL\n"; |
103 | print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n"; | |
c2e89b3d | 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"; | |
875fa795 JD |
109 | my ($name, $exp); |
110 | while (($name, $exp)= each %{$data->{IMPORTS}}) { | |
111 | print DEF " $name=$exp\n"; | |
112 | } | |
c2e89b3d | 113 | } |
c07a80fd | 114 | close DEF; |
115 | } | |
116 | ||
68dc0745 | 117 | sub _write_win32 { |
118 | my($data) = @_; | |
119 | ||
3e3baf6d | 120 | require Config; |
68dc0745 | 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"); | |
84902520 | 129 | # put library name in quotes (it could be a keyword, like 'Alias') |
5b0d9cbe NIS |
130 | if ($Config::Config{'cc'} !~ /^gcc/i) { |
131 | print DEF "LIBRARY \"$data->{DLBASE}\"\n"; | |
5b0d9cbe | 132 | } |
68dc0745 | 133 | print DEF "EXPORTS\n "; |
84902520 TB |
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 | |
3e3baf6d | 140 | if ($Config::Config{'cc'} =~ /^bcc/i) { |
84902520 TB |
141 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { |
142 | push @syms, "_$_", "$_ = _$_"; | |
143 | } | |
3e3baf6d | 144 | } |
84902520 TB |
145 | else { |
146 | for (@{$data->{DL_VARS}}, @{$data->{FUNCLIST}}) { | |
147 | push @syms, "$_", "_$_ = $_"; | |
148 | } | |
149 | } | |
150 | print DEF join("\n ",@syms, "\n") if @syms; | |
68dc0745 | 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 | ||
c07a80fd | 161 | |
162 | sub _write_vms { | |
163 | my($data) = @_; | |
a6e61155 | 164 | |
f1387719 | 165 | require Config; # a reminder for once we do $^O |
ff0cee69 | 166 | require ExtUtils::XSSymSet; |
a6e61155 | 167 | |
8c99d73e | 168 | my($isvax) = $Config::Config{'archname'} =~ /VAX/i; |
ff0cee69 | 169 | my($set) = new ExtUtils::XSSymSet; |
c07a80fd | 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 | ||
80601f72 CB |
184 | print OPT "case_sensitive=yes\n" |
185 | if $Config::Config{d_vms_case_sensitive_symbols}; | |
c07a80fd | 186 | foreach $sym (@{$data->{FUNCLIST}}) { |
ff0cee69 | 187 | my $safe = $set->addsym($sym); |
188 | if ($isvax) { print OPT "UNIVERSAL=$safe\n" } | |
189 | else { print OPT "SYMBOL_VECTOR=($safe=PROCEDURE)\n"; } | |
c07a80fd | 190 | } |
191 | foreach $sym (@{$data->{DL_VARS}}) { | |
ff0cee69 | 192 | my $safe = $set->addsym($sym); |
c07a80fd | 193 | print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n"; |
ff0cee69 | 194 | if ($isvax) { print OPT "UNIVERSAL=$safe\n" } |
195 | else { print OPT "SYMBOL_VECTOR=($safe=DATA)\n"; } | |
c07a80fd | 196 | } |
197 | close OPT; | |
198 | ||
c07a80fd | 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 | |
1fef88e7 | 220 | during the creation of shared libraries for dynamic extensions. It is |
c07a80fd | 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 | ||
bbc7dcd2 | 227 | =over 4 |
2ae324a7 | 228 | |
875fa795 | 229 | =item DLBASE |
c07a80fd | 230 | |
875fa795 JD |
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. | |
c07a80fd | 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 | |
875fa795 | 244 | C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ], |
a5f75d66 | 245 | Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The |
c07a80fd | 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 | |
875fa795 | 268 | attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>). |
c07a80fd | 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. | |
de592821 | 276 | Specifying a value for the FUNCLIST attribute suppresses automatic |
875fa795 JD |
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: | |
c07a80fd | 280 | |
875fa795 JD |
281 | Mksymlists({ NAME => $name , |
282 | FUNCLIST => [ $func1, $func2 ], | |
283 | DL_FUNCS => { $pkg => [] } }); | |
c07a80fd | 284 | |
875fa795 JD |
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. | |
c07a80fd | 295 | |
2ae324a7 | 296 | =back |
297 | ||
c07a80fd | 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 | ||
bd3fa61c | 305 | Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> |
c07a80fd | 306 | |
307 | =head1 REVISION | |
308 | ||
a5f75d66 | 309 | Last revised 14-Feb-1996, for Perl 5.002. |