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->normalize_filespecs(
132 my @cmds = $self->format_compiler_cmd(%spec);
133 while ( my $cmd = shift @cmds ) {
134 $self->do_system( @$cmd )
135 or die "error building $cf->{dlext} file from '$args{source}'";
138 (my $out = $spec{output}) =~ tr/'"//d;
142 sub need_prelink { 1 }
145 my ($self, %args) = @_;
146 my $cf = $self->{config};
148 my @objects = ( ref $args{objects} eq 'ARRAY' ? @{$args{objects}} : $args{objects} );
149 my $to = join '', (File::Spec->splitpath($objects[0]))[0,1];
150 $to ||= File::Spec->curdir();
152 (my $file_base = $args{module_name}) =~ s/.*:://;
153 my $output = $args{lib_file} ||
154 File::Spec->catfile($to, "$file_base.$cf->{dlext}");
156 # if running in perl source tree, look for libs there, not installed
157 my $lddlflags = $cf->{lddlflags};
158 my $perl_src = $self->perl_src();
159 $lddlflags =~ s/\Q$cf->{archlibexp}\E[\\\/]CORE/$perl_src/ if $perl_src;
165 objects => \@objects,
169 libperl => $cf->{libperl},
170 perllibs => [ $self->split_like_shell($cf->{perllibs}) ],
171 libpath => [ $self->split_like_shell($cf->{libpth}) ],
172 lddlflags => [ $self->split_like_shell($lddlflags) ],
173 other_ldflags => [ $self->split_like_shell($args{extra_linker_flags} || '') ],
174 use_scripts => 1, # XXX provide user option to change this???
177 unless ( $spec{basename} ) {
178 ($spec{basename} = $args{module_name}) =~ s/.*:://;
181 $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
182 $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
184 $spec{output} ||= File::Spec->catfile( $spec{builddir},
185 $spec{basename} . '.'.$cf->{dlext} );
186 $spec{implib} ||= File::Spec->catfile( $spec{builddir},
187 $spec{basename} . $cf->{lib_ext} );
188 $spec{explib} ||= File::Spec->catfile( $spec{builddir},
189 $spec{basename} . '.exp' );
190 $spec{def_file} ||= File::Spec->catfile( $spec{srcdir} ,
191 $spec{basename} . '.def' );
192 $spec{base_file} ||= File::Spec->catfile( $spec{srcdir} ,
193 $spec{basename} . '.base' );
195 $self->add_to_cleanup(
197 @{[ @spec{qw(implib explib def_file base_file map_file)} ]}
200 foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
201 $self->normalize_filespecs( \$spec{$opt} );
204 foreach my $opt ( qw(libpath startup objects) ) {
205 $self->normalize_filespecs( $spec{$opt} );
208 (my $def_base = $spec{def_file}) =~ tr/'"//d;
209 $def_base =~ s/\.def$//;
210 $self->prelink( dl_name => $args{module_name},
211 dl_file => $def_base,
212 dl_base => $spec{basename} );
214 my @cmds = $self->format_linker_cmd(%spec);
215 while ( my $cmd = shift @cmds ) {
216 $self->do_system( @$cmd );
219 $spec{output} =~ tr/'"//d;
221 ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
225 # canonize & quote paths
226 sub normalize_filespecs {
227 my ($self, @specs) = @_;
228 foreach my $spec ( grep defined, @specs ) {
229 if ( ref $spec eq 'ARRAY') {
230 $self->normalize_filespecs( map {\$_} grep defined, @$spec )
231 } elsif ( ref $spec eq 'SCALAR' ) {
232 $$spec =~ tr/"//d if $$spec;
234 $$spec = '"' . File::Spec->canonpath($$spec) . '"';
235 } elsif ( ref $spec eq '' ) {
236 $spec = '"' . File::Spec->canonpath($spec) . '"';
238 die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
243 # directory of perl's include files
247 my $perl_src = $self->perl_src();
250 File::Spec->catdir($perl_src, "lib", "CORE");
252 File::Spec->catdir($self->{config}{archlibexp},"CORE");
258 ########################################################################
262 The packages below implement functions for generating properly
263 formated commandlines for the compiler being used. Each package
264 defines two primary functions 'format_linker_cmd()' &
265 'format_compiler_cmd()' that accepts a list of named arguments (a
266 hash) and returns a list of formated options suitable for invoking the
267 compiler. By default, if the compiler supports scripting of its
268 operation then a script file is built containing the options while
269 those options are removed from the commandline, and a reference to the
270 script is pushed onto the commandline in their place. Scripting the
271 compiler in this way helps to avoid the problems associated with long
272 commandlines under some shells.
278 ########################################################################
279 package ExtUtils::CBuilder::Platform::Windows::MSVC;
281 sub format_compiler_cmd {
282 my ($self, %spec) = @_;
284 foreach my $path ( @{ $spec{includes} || [] },
285 @{ $spec{perlinc} || [] } ) {
286 $path = '-I' . $path;
289 %spec = $self->write_compiler_script(%spec)
290 if $spec{use_scripts};
292 return [ grep {defined && length} (
293 $spec{cc},'-nologo','-c',
304 sub write_compiler_script {
305 my ($self, %spec) = @_;
307 my $script = File::Spec->catfile( $spec{srcdir},
308 $spec{basename} . '.ccs' );
310 $self->add_to_cleanup($script);
312 print "Generating script '$script'\n" if !$self->{quiet};
314 open( SCRIPT, ">$script" )
315 or die( "Could not create script '$script': $!" );
317 print SCRIPT join( "\n",
318 map { ref $_ ? @{$_} : $_ }
321 @spec{ qw(includes cflags optimize defines perlinc) } )
326 push @{$spec{includes}}, '@"' . $script . '"';
331 sub format_linker_cmd {
332 my ($self, %spec) = @_;
334 foreach my $path ( @{$spec{libpath}} ) {
335 $path = "-libpath:$path";
338 $spec{def_file} &&= '-def:' . $spec{def_file};
339 $spec{output} &&= '-out:' . $spec{output};
340 $spec{implib} &&= '-implib:' . $spec{implib};
341 $spec{map_file} &&= '-map:' . $spec{map_file};
343 %spec = $self->write_linker_script(%spec)
344 if $spec{use_scripts};
346 return [ grep {defined && length} (
348 @{$spec{lddlflags}} ,
350 @{$spec{other_ldflags}} ,
362 sub write_linker_script {
363 my ($self, %spec) = @_;
365 my $script = File::Spec->catfile( $spec{srcdir},
366 $spec{basename} . '.lds' );
368 $self->add_to_cleanup($script);
370 print "Generating script '$script'\n" if !$self->{quiet};
372 open( SCRIPT, ">$script" )
373 or die( "Could not create script '$script': $!" );
375 print SCRIPT join( "\n",
376 map { ref $_ ? @{$_} : $_ }
379 @spec{ qw(lddlflags libpath other_ldflags
380 startup objects libperl perllibs
381 def_file implib map_file) } )
386 push @{$spec{lddlflags}}, '@"' . $script . '"';
393 ########################################################################
394 package ExtUtils::CBuilder::Platform::Windows::BCC;
396 sub format_compiler_cmd {
397 my ($self, %spec) = @_;
399 foreach my $path ( @{ $spec{includes} || [] },
400 @{ $spec{perlinc} || [] } ) {
401 $path = '-I' . $path;
404 %spec = $self->write_compiler_script(%spec)
405 if $spec{use_scripts};
407 return [ grep {defined && length} (
419 sub write_compiler_script {
420 my ($self, %spec) = @_;
422 my $script = File::Spec->catfile( $spec{srcdir},
423 $spec{basename} . '.ccs' );
425 $self->add_to_cleanup($script);
427 print "Generating script '$script'\n" if !$self->{quiet};
429 open( SCRIPT, ">$script" )
430 or die( "Could not create script '$script': $!" );
432 print SCRIPT join( "\n",
433 map { ref $_ ? @{$_} : $_ }
436 @spec{ qw(includes cflags optimize defines perlinc) } )
441 push @{$spec{includes}}, '@"' . $script . '"';
446 sub format_linker_cmd {
447 my ($self, %spec) = @_;
449 foreach my $path ( @{$spec{libpath}} ) {
453 push( @{$spec{startup}}, 'c0d32.obj' )
454 unless ( $spec{starup} && @{$spec{startup}} );
456 %spec = $self->write_linker_script(%spec)
457 if $spec{use_scripts};
459 return [ grep {defined && length} (
461 @{$spec{lddlflags}} ,
463 @{$spec{other_ldflags}} ,
465 @{$spec{objects}} , ',',
467 $spec{map_file} , ',',
469 @{$spec{perllibs}} , ',',
474 sub write_linker_script {
475 my ($self, %spec) = @_;
477 # To work around Borlands "unique" commandline syntax,
478 # two scripts are used:
480 my $ld_script = File::Spec->catfile( $spec{srcdir},
481 $spec{basename} . '.lds' );
482 my $ld_libs = File::Spec->catfile( $spec{srcdir},
483 $spec{basename} . '.lbs' );
485 $self->add_to_cleanup($ld_script, $ld_libs);
487 print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
489 # Script 1: contains options & names of object files.
490 open( LD_SCRIPT, ">$ld_script" )
491 or die( "Could not create linker script '$ld_script': $!" );
493 print LD_SCRIPT join( " +\n",
497 @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
502 # Script 2: contains name of libs to link against.
503 open( LD_LIBS, ">$ld_libs" )
504 or die( "Could not create linker script '$ld_libs': $!" );
506 print LD_LIBS join( " +\n",
507 (delete $spec{libperl} || ''),
508 @{delete $spec{perllibs} || []},
513 push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
514 push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
521 ########################################################################
522 package ExtUtils::CBuilder::Platform::Windows::GCC;
524 sub format_compiler_cmd {
525 my ($self, %spec) = @_;
527 foreach my $path ( @{ $spec{includes} || [] },
528 @{ $spec{perlinc} || [] } ) {
529 $path = '-I' . $path;
532 # split off any -arguments included in cc
533 my @cc = split / (?=-)/, $spec{cc};
535 return [ grep {defined && length} (
542 '-o', $spec{output} ,
547 sub format_linker_cmd {
548 my ($self, %spec) = @_;
550 # The Config.pm variable 'libperl' is hardcoded to the full name
551 # of the perl import library (i.e. 'libperl56.a'). GCC will not
552 # find it unless the 'lib' prefix & the extension are stripped.
553 $spec{libperl} =~ s/^(?:lib)?([^.]+).*$/-l$1/;
555 unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
556 if ( $spec{startup} && @{$spec{startup}} );
558 # From ExtUtils::MM_Win32:
560 ## one thing for GCC/Mingw32:
561 ## we try to overcome non-relocateable-DLL problems by generating
562 ## a (hopefully unique) image-base from the dll's name
563 ## -- BKS, 10-19-1999
564 File::Basename::basename( $spec{output} ) =~ /(....)(.{0,4})/;
565 $spec{image_base} = sprintf( "0x%x0000", unpack('n', $1 ^ $2) );
567 %spec = $self->write_linker_script(%spec)
568 if $spec{use_scripts};
570 foreach my $path ( @{$spec{libpath}} ) {
574 my @cmds; # Stores the series of commands needed to build the module.
577 'dlltool', '--def' , $spec{def_file},
578 '--output-exp' , $spec{explib}
581 # split off any -arguments included in ld
582 my @ld = split / (?=-)/, $spec{ld};
584 push @cmds, [ grep {defined && length} (
586 '-o', $spec{output} ,
587 "-Wl,--base-file,$spec{base_file}" ,
588 "-Wl,--image-base,$spec{image_base}" ,
589 @{$spec{lddlflags}} ,
593 @{$spec{other_ldflags}} ,
597 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
601 'dlltool', '--def' , $spec{def_file},
602 '--output-exp' , $spec{explib},
603 '--base-file' , $spec{base_file}
606 push @cmds, [ grep {defined && length} (
608 '-o', $spec{output} ,
609 "-Wl,--image-base,$spec{image_base}" ,
610 @{$spec{lddlflags}} ,
614 @{$spec{other_ldflags}} ,
618 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
624 sub write_linker_script {
625 my ($self, %spec) = @_;
627 my $script = File::Spec->catfile( $spec{srcdir},
628 $spec{basename} . '.lds' );
630 $self->add_to_cleanup($script);
632 print "Generating script '$script'\n" if !$self->{quiet};
634 open( SCRIPT, ">$script" )
635 or die( "Could not create script '$script': $!" );
637 print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
638 for @{delete $spec{libpath} || []};
640 # gcc takes only one startup file, so the first object in startup is
641 # specified as the startup file and any others are shifted into the
642 # beginning of the list of objects.
643 if ( $spec{startup} && @{$spec{startup}} ) {
644 print SCRIPT 'STARTUP(' . shift( @{$spec{startup}} ) . ")\n";
645 unshift @{$spec{objects}},
646 @{delete $spec{startup} || []};
649 print SCRIPT 'INPUT(' . join( ',',
650 @{delete $spec{objects} || []}
653 print SCRIPT 'INPUT(' . join( ' ',
654 (delete $spec{libperl} || ''),
655 @{delete $spec{perllibs} || []},
660 push @{$spec{other_ldflags}}, '"' . $script . '"';
671 ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
675 This module implements the Windows-specific parts of ExtUtils::CBuilder.
676 Most of the Windows-specific stuff has to do with compiling and
677 linking C code. Currently we support the 3 compilers perl itself
678 supports: MSVC, BCC, and GCC.
680 This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
681 not implemented here will be implemented there. The interfaces are
682 defined by the L<ExtUtils::CBuilder> documentation.
686 Ken Williams <ken@mathforum.org>
688 Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
692 perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)