lib/perl5/5.6.1/ExtUtils/Mksymlists.pm

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