1 package ExtUtils::CBuilder::Platform::Windows;
9 use ExtUtils::CBuilder::Base;
11 use vars qw($VERSION @ISA);
13 @ISA = qw(ExtUtils::CBuilder::Base);
17 my $self = $class->SUPER::new(@_);
18 my $cf = $self->{config};
20 # Inherit from an appropriate compiler driver class
21 unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
28 my $cc = $self->{config}{cc};
30 return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
31 : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
35 sub split_like_shell {
36 # As it turns out, Windows command-parsing is very different from
37 # Unix command-parsing. Double-quotes mean different things,
38 # backslashes don't necessarily mean escapes, and so on. So we
39 # can't use Text::ParseWords::shellwords() to break a command string
40 # into words. The algorithm below was bashed out by Randy and Ken
41 # (mostly Randy), and there are a lot of regression tests, so we
42 # should feel free to adjust if desired.
44 (my $self, local $_) = @_;
46 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
49 return @argv unless defined() && length();
52 my( $i, $quote_mode ) = ( 0, 0 );
54 while ( $i < length() ) {
56 my $ch = substr( $_, $i , 1 );
57 my $next_ch = substr( $_, $i+1, 1 );
59 if ( $ch eq '\\' && $next_ch eq '"' ) {
62 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
65 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
66 $quote_mode = !$quote_mode;
69 } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
70 ( $i + 2 == length() ||
71 substr( $_, $i + 2, 1 ) eq ' ' )
72 ) { # for cases like: a"" => [ 'a' ]
76 } elsif ( $ch eq '"' ) {
77 $quote_mode = !$quote_mode;
78 } elsif ( $ch eq ' ' && !$quote_mode ) {
79 push( @argv, $arg ) if $arg;
81 ++$i while substr( $_, $i + 1, 1 ) eq ' ';
89 push( @argv, $arg ) if defined( $arg ) && length( $arg );
94 my ($self, %args) = @_;
95 my $cf = $self->{config};
97 die "Missing 'source' argument to compile()" unless defined $args{source};
99 my ($basename, $srcdir) =
100 ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
102 $srcdir ||= File::Spec->curdir();
107 basename => $basename,
108 source => $args{source},
109 output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
112 $self->split_like_shell($cf->{ccflags}),
113 $self->split_like_shell($cf->{cccdlflags}),
115 optimize => [ $self->split_like_shell($cf->{optimize}) ],
117 includes => [ @{$args{include_dirs} || []} ],
120 $self->split_like_shell($cf->{incpath}),
122 use_scripts => 1, # XXX provide user option to change this???
125 $self->add_to_cleanup($spec{output});
127 $self->normalize_filespecs(
134 my @cmds = $self->format_compiler_cmd(%spec);
135 while ( my $cmd = shift @cmds ) {
136 $self->do_system( @$cmd )
137 or die "error building $cf->{dlext} file from '$args{source}'";
140 (my $out = $spec{output}) =~ tr/'"//d;
144 sub need_prelink { 1 }
147 my ($self, %args) = @_;
148 my $cf = $self->{config};
150 my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
151 my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
152 $to ||= File::Spec->curdir();
154 (my $file_base = $args{module_name}) =~ s/.*:://;
155 my $output = $args{lib_file} ||
156 File::Spec->catfile($to, "$file_base.$cf->{dlext}");
158 # if running in perl source tree, look for libs there, not installed
159 my $lddlflags = $cf->{lddlflags};
160 my $perl_src = $self->perl_src();
161 $lddlflags =~ s/\Q$cf->{archlibexp}\E\\CORE/$perl_src/ if $perl_src;
167 objects => \@objects,
171 libperl => $cf->{libperl},
172 perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
173 libpath => [ $self->split_like_shell($cf->{libpth}) ],
174 lddlflags => [ $self->split_like_shell($lddlflags) ],
175 other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
176 use_scripts => 1, # XXX provide user option to change this???
179 unless ( $spec{basename} ) {
180 ($spec{basename} = $args{module_name}) =~ s/.*:://;
183 $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
184 $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
186 $spec{output} ||= File::Spec->catfile( $spec{builddir},
187 $spec{basename} . '.'.$cf->{dlext} );
188 $spec{implib} ||= File::Spec->catfile( $spec{builddir},
189 $spec{basename} . $cf->{lib_ext} );
190 $spec{explib} ||= File::Spec->catfile( $spec{builddir},
191 $spec{basename} . '.exp' );
192 $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} ,
193 $spec{basename} . '.def' );
194 $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} ,
195 $spec{basename} . '.base' );
197 $self->add_to_cleanup(
199 @{[ @spec{qw(output implib explib def_file base_file map_file)} ]}
202 foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
203 $self->normalize_filespecs( \$spec{$opt} );
206 foreach my $opt ( qw(libpath startup objects) ) {
207 $self->normalize_filespecs( $spec{$opt} );
210 (my $def_base = $spec{def_file}) =~ tr/'"//d;
211 $def_base =~ s/\.def$//;
212 $self->prelink( dl_name => $args{module_name},
213 dl_file => $def_base,
214 dl_base => $spec{basename} );
216 my @cmds = $self->format_linker_cmd(%spec);
217 while ( my $cmd = shift @cmds ) {
218 $self->do_system( @$cmd );
221 $spec{output} =~ tr/'"//d;
223 ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
227 # canonize & quote paths
228 sub normalize_filespecs {
229 my ($self, @specs) = @_;
230 foreach my $spec ( grep defined, @specs ) {
231 if ( ref $spec eq 'ARRAY') {
232 $self->normalize_filespecs( map {\$_} grep defined, @$spec )
233 } elsif ( ref $spec eq 'SCALAR' ) {
234 $$spec =~ tr/"//d if $$spec;
236 $$spec = '"' . File::Spec->canonpath($$spec) . '"';
237 } elsif ( ref $spec eq '' ) {
238 $spec = '"' . File::Spec->canonpath($spec) . '"';
240 die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
245 # directory of perl's include files
249 my $perl_src = $self->perl_src();
252 File::Spec->catdir($perl_src, "lib", "CORE");
254 File::Spec->catdir($self->{config}{archlibexp},"CORE");
260 ########################################################################
264 The packages below implement functions for generating properly
265 formated commandlines for the compiler being used. Each package
266 defines two primary functions 'format_linker_cmd()' &
267 'format_compiler_cmd()' that accepts a list of named arguments (a
268 hash) and returns a list of formated options suitable for invoking the
269 compiler. By default, if the compiler supports scripting of its
270 operation then a script file is built containing the options while
271 those options are removed from the commandline, and a reference to the
272 script is pushed onto the commandline in their place. Scripting the
273 compiler in this way helps to avoid the problems associated with long
274 commandlines under some shells.
280 ########################################################################
281 package ExtUtils::CBuilder::Platform::Windows::MSVC;
283 sub format_compiler_cmd {
284 my ($self, %spec) = @_;
286 foreach my $path ( @{ $spec{includes} || [] },
287 @{ $spec{perlinc} || [] } ) {
288 $path = '-I' . $path;
291 %spec = $self->write_compiler_script(%spec)
292 if $spec{use_scripts};
294 return [ grep {defined && length} (
295 $spec{cc},'-nologo','-c',
306 sub write_compiler_script {
307 my ($self, %spec) = @_;
309 my $script = File::Spec->catfile( $spec{srcdir},
310 $spec{basename} . '.ccs' );
312 $self->add_to_cleanup($script);
314 print "Generating script '$script'\n" if !$self->{quiet};
316 open( SCRIPT, ">$script" )
317 or die( "Could not create script '$script': $!" );
319 print SCRIPT join( "\n",
320 map { ref $_ ? @{$_} : $_ }
323 @spec{ qw(includes cflags optimize defines perlinc) } )
328 push @{$spec{includes}}, '@"' . $script . '"';
333 sub format_linker_cmd {
334 my ($self, %spec) = @_;
336 foreach my $path ( @{$spec{libpath}} ) {
337 $path = "-libpath:$path";
340 $spec{def_file} &&= '-def:' . $spec{def_file};
341 $spec{output} &&= '-out:' . $spec{output};
342 $spec{implib} &&= '-implib:' . $spec{implib};
343 $spec{map_file} &&= '-map:' . $spec{map_file};
345 %spec = $self->write_linker_script(%spec)
346 if $spec{use_scripts};
348 return [ grep {defined && length} (
350 @{$spec{lddlflags}} ,
352 @{$spec{other_ldflags}} ,
364 sub write_linker_script {
365 my ($self, %spec) = @_;
367 my $script = File::Spec->catfile( $spec{srcdir},
368 $spec{basename} . '.lds' );
370 $self->add_to_cleanup($script);
372 print "Generating script '$script'\n" if !$self->{quiet};
374 open( SCRIPT, ">$script" )
375 or die( "Could not create script '$script': $!" );
377 print SCRIPT join( "\n",
378 map { ref $_ ? @{$_} : $_ }
381 @spec{ qw(lddlflags libpath other_ldflags
382 startup objects libperl perllibs
383 def_file implib map_file) } )
388 push @{$spec{lddlflags}}, '@"' . $script . '"';
395 ########################################################################
396 package ExtUtils::CBuilder::Platform::Windows::BCC;
398 sub format_compiler_cmd {
399 my ($self, %spec) = @_;
401 foreach my $path ( @{ $spec{includes} || [] },
402 @{ $spec{perlinc} || [] } ) {
403 $path = '-I' . $path;
406 %spec = $self->write_compiler_script(%spec)
407 if $spec{use_scripts};
409 return [ grep {defined && length} (
421 sub write_compiler_script {
422 my ($self, %spec) = @_;
424 my $script = File::Spec->catfile( $spec{srcdir},
425 $spec{basename} . '.ccs' );
427 $self->add_to_cleanup($script);
429 print "Generating script '$script'\n" if !$self->{quiet};
431 open( SCRIPT, ">$script" )
432 or die( "Could not create script '$script': $!" );
434 print SCRIPT join( "\n",
435 map { ref $_ ? @{$_} : $_ }
438 @spec{ qw(includes cflags optimize defines perlinc) } )
443 push @{$spec{includes}}, '@"' . $script . '"';
448 sub format_linker_cmd {
449 my ($self, %spec) = @_;
451 foreach my $path ( @{$spec{libpath}} ) {
455 push( @{$spec{startup}}, 'c0d32.obj' )
456 unless ( $spec{starup} && @{$spec{startup}} );
458 %spec = $self->write_linker_script(%spec)
459 if $spec{use_scripts};
461 return [ grep {defined && length} (
463 @{$spec{lddlflags}} ,
465 @{$spec{other_ldflags}} ,
467 @{$spec{objects}} , ',',
469 $spec{map_file} , ',',
471 @{$spec{perllibs}} , ',',
476 sub write_linker_script {
477 my ($self, %spec) = @_;
479 # To work around Borlands "unique" commandline syntax,
480 # two scripts are used:
482 my $ld_script = File::Spec->catfile( $spec{srcdir},
483 $spec{basename} . '.lds' );
484 my $ld_libs = File::Spec->catfile( $spec{srcdir},
485 $spec{basename} . '.lbs' );
487 $self->add_to_cleanup($ld_script, $ld_libs);
489 print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
491 # Script 1: contains options & names of object files.
492 open( LD_SCRIPT, ">$ld_script" )
493 or die( "Could not create linker script '$ld_script': $!" );
495 print LD_SCRIPT join( " +\n",
499 @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
504 # Script 2: contains name of libs to link against.
505 open( LD_LIBS, ">$ld_libs" )
506 or die( "Could not create linker script '$ld_libs': $!" );
508 print LD_LIBS join( " +\n",
509 (delete $spec{libperl} || ''),
510 @{delete $spec{perllibs} || []},
515 push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
516 push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
523 ########################################################################
524 package ExtUtils::CBuilder::Platform::Windows::GCC;
526 sub format_compiler_cmd {
527 my ($self, %spec) = @_;
529 foreach my $path ( @{ $spec{includes} || [] },
530 @{ $spec{perlinc} || [] } ) {
531 $path = '-I' . $path;
534 # split off any -arguments included in cc
535 my @cc = split / (?=-)/, $spec{cc};
537 return [ grep {defined && length} (
544 '-o', $spec{output} ,
549 sub format_linker_cmd {
550 my ($self, %spec) = @_;
552 # The Config.pm variable 'libperl' is hardcoded to the full name
553 # of the perl import library (i.e. 'libperl56.a'). GCC will not
554 # find it unless the 'lib' prefix & the extension are stripped.
555 $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
557 unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
558 if ( $spec{startup} && @{$spec{startup}} );
560 # From ExtUtils::MM_Win32:
562 ## one thing for GCC/Mingw32:
563 ## we try to overcome non-relocateable-DLL problems by generating
564 ## a (hopefully unique) image-base from the dll's name
565 ## -- BKS, 10-19-1999
566 File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
567 $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
569 %spec = $self->write_linker_script(%spec)
570 if $spec{use_scripts};
572 foreach my $path ( @{$spec{libpath}} ) {
576 my @cmds; # Stores the series of commands needed to build the module.
579 'dlltool', '--def' , $spec{def_file},
580 '--output-exp' , $spec{explib}
583 # split off any -arguments included in ld
584 my @ld = split / (?=-)/, $spec{ld};
586 push @cmds, [ grep {defined && length} (
588 '-o', $spec{output} ,
589 "-Wl,--base-file,$spec{base_file}" ,
590 "-Wl,--image-base,$spec{image_base}" ,
591 @{$spec{lddlflags}} ,
595 @{$spec{other_ldflags}} ,
599 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
603 'dlltool', '--def' , $spec{def_file},
604 '--output-exp' , $spec{explib},
605 '--base-file' , $spec{base_file}
608 push @cmds, [ grep {defined && length} (
610 '-o', $spec{output} ,
611 "-Wl,--image-base,$spec{image_base}" ,
612 @{$spec{lddlflags}} ,
616 @{$spec{other_ldflags}} ,
620 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
626 sub write_linker_script {
627 my ($self, %spec) = @_;
629 my $script = File::Spec->catfile( $spec{srcdir},
630 $spec{basename} . '.lds' );
632 $self->add_to_cleanup($script);
634 print "Generating script '$script'\n" if !$self->{quiet};
636 open( SCRIPT, ">$script" )
637 or die( "Could not create script '$script': $!" );
639 print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
640 for @{delete $spec{libpath} || []};
642 # gcc takes only one startup file, so the first object in startup is
643 # specified as the startup file and any others are shifted into the
644 # beginning of the list of objects.
645 if ( $spec{startup} && @{$spec{startup}} ) {
646 print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
647 unshift @{$spec{objects}},
648 @{delete $spec{startup} || []};
651 print SCRIPT 'INPUT(' . join( ',',
652 @{delete $spec{objects} || []}
655 print SCRIPT 'INPUT(' . join( ' ',
656 (delete $spec{libperl} || ''),
657 @{delete $spec{perllibs} || []},
662 push @{$spec{other_ldflags}}, '"' . $script . '"';
673 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
677 This module implements the Windows-specific parts of ExtUtils::CBuilder.
678 Most of the Windows-specific stuff has to do with compiling and
679 linking C code. Currently we support the 3 compilers perl itself
680 supports: MSVC, BCC, and GCC.
682 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
683 not implemented here will be implemented there. The interfaces are
684 defined by the L<ExtUtils::CBuilder> documentation.
688 Ken Williams <ken@mathforum.org>
690 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
694 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)