dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm

   1 package ExtUtils::CBuilder::Platform::Windows::GCC;
   2
   3 use vars qw($VERSION);
   4 $VERSION = '0.280201';
   5
   6 sub format_compiler_cmd {
   7   my ($self, %spec) = @_;
   8
   9   foreach my $path ( @{ $spec{includes} || [] },
  10                      @{ $spec{perlinc}  || [] } ) {
  11     $path = '-I' . $path;
  12   }
  13
  14   # split off any -arguments included in cc
  15   my @cc = split / (?=-)/, $spec{cc};
  16
  17   return [ grep {defined && length} (
  18     @cc, '-c'               ,
  19     @{$spec{includes}}      ,
  20     @{$spec{cflags}}        ,
  21     @{$spec{optimize}}      ,
  22     @{$spec{defines}}       ,
  23     @{$spec{perlinc}}       ,
  24     '-o', $spec{output}     ,
  25     $spec{source}           ,
  26   ) ];
  27 }
  28
  29 sub format_linker_cmd {
  30   my ($self, %spec) = @_;
  31   my $cf = $self->{config};
  32
  33   # The Config.pm variable 'libperl' is hardcoded to the full name
  34   # of the perl import library (i.e. 'libperl56.a'). GCC will not
  35   # find it unless the 'lib' prefix & the extension are stripped.
  36   $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
  37
  38   unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
  39     if ( $spec{startup} && @{$spec{startup}} );
  40
  41   # From ExtUtils::MM_Win32:
  42   #
  43   ## one thing for GCC/Mingw32:
  44   ## we try to overcome non-relocateable-DLL problems by generating
  45   ##    a (hopefully unique) image-base from the dll's name
  46   ## -- BKS, 10-19-1999
  47   File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
  48   $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
  49
  50   %spec = $self->write_linker_script(%spec)
  51     if $spec{use_scripts};
  52
  53   foreach my $path ( @{$spec{libpath}} ) {
  54     $path = "-L$path";
  55   }
  56
  57   my @cmds; # Stores the series of commands needed to build the module.
  58
  59   my $DLLTOOL = $cf->{dlltool} || 'dlltool';
  60
  61   push @cmds, [
  62     $DLLTOOL, '--def'        , $spec{def_file},
  63               '--output-exp' , $spec{explib}
  64   ];
  65
  66   # split off any -arguments included in ld
  67   my @ld = split / (?=-)/, $spec{ld};
  68
  69   push @cmds, [ grep {defined && length} (
  70     @ld                       ,
  71     '-o', $spec{output}       ,
  72     "-Wl,--base-file,$spec{base_file}"   ,
  73     "-Wl,--image-base,$spec{image_base}" ,
  74     @{$spec{lddlflags}}       ,
  75     @{$spec{libpath}}         ,
  76     @{$spec{startup}}         ,
  77     @{$spec{objects}}         ,
  78     @{$spec{other_ldflags}}   ,
  79     $spec{libperl}            ,
  80     @{$spec{perllibs}}        ,
  81     $spec{explib}             ,
  82     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
  83   ) ];
  84
  85   push @cmds, [
  86     $DLLTOOL, '--def'        , $spec{def_file},
  87               '--output-exp' , $spec{explib},
  88               '--base-file'  , $spec{base_file}
  89   ];
  90
  91   push @cmds, [ grep {defined && length} (
  92     @ld                       ,
  93     '-o', $spec{output}       ,
  94     "-Wl,--image-base,$spec{image_base}" ,
  95     @{$spec{lddlflags}}       ,
  96     @{$spec{libpath}}         ,
  97     @{$spec{startup}}         ,
  98     @{$spec{objects}}         ,
  99     @{$spec{other_ldflags}}   ,
 100     $spec{libperl}            ,
 101     @{$spec{perllibs}}        ,
 102     $spec{explib}             ,
 103     $spec{map_file} ? ('-Map', $spec{map_file}) : ''
 104   ) ];
 105
 106   return @cmds;
 107 }
 108
 109 sub write_linker_script {
 110   my ($self, %spec) = @_;
 111
 112   my $script = File::Spec->catfile( $spec{srcdir},
 113                                     $spec{basename} . '.lds' );
 114
 115   $self->add_to_cleanup($script);
 116
 117   print "Generating script '$script'\n" if !$self->{quiet};
 118
 119   my $SCRIPT = IO::File->new( ">$script" )
 120     or die( "Could not create script '$script': $!" );
 121
 122   print $SCRIPT ( 'SEARCH_DIR(' . $_ . ")\n" )
 123     for @{delete $spec{libpath} || []};
 124
 125   # gcc takes only one startup file, so the first object in startup is
 126   # specified as the startup file and any others are shifted into the
 127   # beginning of the list of objects.
 128   if ( $spec{startup} && @{$spec{startup}} ) {
 129     print $SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
 130     unshift @{$spec{objects}},
 131       @{delete $spec{startup} || []};
 132   }
 133
 134   print $SCRIPT 'INPUT(' . join( ',',
 135     @{delete $spec{objects}  || []}
 136   ) . ")\n";
 137
 138   print $SCRIPT 'INPUT(' . join( ' ',
 139      (delete $spec{libperl}  || ''),
 140     @{delete $spec{perllibs} || []},
 141   ) . ")\n";
 142
 143   #it is important to keep the order 1.linker_script - 2.other_ldflags
 144   unshift @{$spec{other_ldflags}}, '"' . $script . '"';
 145
 146   return %spec;
 147 }
 148
 149 1;
 150
 151