[Summary view] [Print] [Text view]

   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 = '6.42';
  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.