| 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 = 'perl5-porters@perl.org'; |
| 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>bailey@newman.upenn.eduE<gt>> |
| 306 | |
| 307 | =head1 REVISION |
| 308 | |
| 309 | Last revised 14-Feb-1996, for Perl 5.002. |