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