This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ExtUtils::CBuilder Tru64 support
[perl5.git] / lib / ExtUtils / CBuilder / Platform / Windows.pm
CommitLineData
6b09c160
YST
1package ExtUtils::CBuilder::Platform::Windows;
2
3use strict;
4use warnings;
5
6use File::Basename;
7use File::Spec;
8
9use ExtUtils::CBuilder::Base;
10
11use vars qw($VERSION @ISA);
12$VERSION = '0.01';
13@ISA = qw(ExtUtils::CBuilder::Base);
14
15sub new {
16 my $class = shift;
17 my $self = $class->SUPER::new(@_);
18 my $cf = $self->{config};
19
20 # Inherit from an appropriate compiler driver class
21 unshift @ISA, "ExtUtils::CBuilder::Platform::Windows::" . $self->_compiler_type;
22
23 return $self;
24}
25
26sub _compiler_type {
27 my $self = shift;
28 my $cc = $self->{config}{cc};
29
30 return ( $cc =~ /cl(\.exe)?$/ ? 'MSVC'
31 : $cc =~ /bcc32(\.exe)?$/ ? 'BCC'
32 : 'GCC');
33}
34
35sub 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.
43
44 (my $self, local $_) = @_;
45
46 return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
47
48 my @argv;
49 return @argv unless defined() && length();
50
51 my $arg = '';
52 my( $i, $quote_mode ) = ( 0, 0 );
53
54 while ( $i < length() ) {
55
56 my $ch = substr( $_, $i , 1 );
57 my $next_ch = substr( $_, $i+1, 1 );
58
59 if ( $ch eq '\\' && $next_ch eq '"' ) {
60 $arg .= '"';
61 $i++;
62 } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
63 $arg .= '\\';
64 $i++;
65 } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
66 $quote_mode = !$quote_mode;
67 $arg .= '"';
68 $i++;
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' ]
73 push( @argv, $arg );
74 $arg = '';
75 $i += 2;
76 } elsif ( $ch eq '"' ) {
77 $quote_mode = !$quote_mode;
78 } elsif ( $ch eq ' ' && !$quote_mode ) {
79 push( @argv, $arg ) if $arg;
80 $arg = '';
81 ++$i while substr( $_, $i + 1, 1 ) eq ' ';
82 } else {
83 $arg .= $ch;
84 }
85
86 $i++;
87 }
88
89 push( @argv, $arg ) if defined( $arg ) && length( $arg );
90 return @argv;
91}
92
93sub compile {
94 my ($self, %args) = @_;
95 my $cf = $self->{config};
96
97 die "Missing 'source' argument to compile()" unless defined $args{source};
98
99 my ($basename, $srcdir) =
100 ( File::Basename::fileparse($args{source}, '\.[^.]+$') )[0,1];
101
102 $srcdir ||= File::Spec->curdir();
103
104 my %spec = (
105 srcdir => $srcdir,
106 builddir => $srcdir,
107 basename => $basename,
108 source => $args{source},
109 output => File::Spec->catfile($srcdir, $basename) . $cf->{obj_ext},
110 cc => $cf->{cc},
111 cflags => [
112 $self->split_like_shell($cf->{ccflags}),
113 $self->split_like_shell($cf->{cccdlflags}),
114 ],
115 optimize => [ $self->split_like_shell($cf->{optimize}) ],
116 defines => [ '' ],
117 includes => [ @{$args{include_dirs} || []} ],
118 perlinc => [
119 $self->perl_inc(),
120 $self->split_like_shell($cf->{incpath}),
121 ],
122 use_scripts => 1, # XXX provide user option to change this???
123 );
124
125 $self->add_to_cleanup($spec{output});
126
127 $self->normalize_filespecs(
128 \$spec{source},
129 \$spec{output},
130 $spec{includes},
131 $spec{perlinc},
132 );
133
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}'";
138 }
139
140 (my $out = $spec{output}) =~ tr/'"//d;
141 return $out;
142}
143
144sub need_prelink { 1 }
145
146sub link {
147 my ($self, %args) = @_;
148 my $cf = $self->{config};
149
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();
153
154 (my $file_base = $args{module_name}) =~ s/.*:://;
155 my $output = $args{lib_file} ||
156 File::Spec->catfile($to, "$file_base.$cf->{dlext}");
157
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;
162
163 my %spec = (
164 srcdir => $to,
165 builddir => $to,
166 startup => [ ],
167 objects => \@objects,
168 libs => [ ],
169 output => $output,
170 ld => $cf->{ld},
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???
177 );
178
179 unless ( $spec{basename} ) {
180 ($spec{basename} = $args{module_name}) =~ s/.*:://;
181 }
182
183 $spec{srcdir} = File::Spec->canonpath( $spec{srcdir} );
184 $spec{builddir} = File::Spec->canonpath( $spec{builddir} );
185
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' );
196
197 $self->add_to_cleanup(
198 grep defined,
199 @{[ @spec{qw(output implib explib def_file base_file map_file)} ]}
200 );
201
202 foreach my $opt ( qw(output implib explib def_file map_file base_file) ) {
203 $self->normalize_filespecs( \$spec{$opt} );
204 }
205
206 foreach my $opt ( qw(libpath startup objects) ) {
207 $self->normalize_filespecs( $spec{$opt} );
208 }
209
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} );
215
216 my @cmds = $self->format_linker_cmd(%spec);
217 while ( my $cmd = shift @cmds ) {
218 $self->do_system( @$cmd );
219 }
220
221 $spec{output} =~ tr/'"//d;
222 return wantarray
223 ? grep defined, @spec{qw[output implib explib def_file map_file base_file]}
224 : $spec{output};
225}
226
227# canonize & quote paths
228sub 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;
235 next unless $$spec;
236 $$spec = '"' . File::Spec->canonpath($$spec) . '"';
237 } elsif ( ref $spec eq '' ) {
238 $spec = '"' . File::Spec->canonpath($spec) . '"';
239 } else {
240 die "Don't know how to normalize " . (ref $spec || $spec) . "\n";
241 }
242 }
243}
244
245# directory of perl's include files
246sub perl_inc {
247 my $self = shift;
248
249 my $perl_src = $self->perl_src();
250
251 if ($perl_src) {
252 File::Spec->catdir($perl_src, "lib", "CORE");
253 } else {
254 File::Spec->catdir($self->{config}{archlibexp},"CORE");
255 }
256}
257
2581;
259
260########################################################################
261
262=begin comment
263
264The packages below implement functions for generating properly
265formated commandlines for the compiler being used. Each package
266defines two primary functions 'format_linker_cmd()' &
267'format_compiler_cmd()' that accepts a list of named arguments (a
268hash) and returns a list of formated options suitable for invoking the
269compiler. By default, if the compiler supports scripting of its
270operation then a script file is built containing the options while
271those options are removed from the commandline, and a reference to the
272script is pushed onto the commandline in their place. Scripting the
273compiler in this way helps to avoid the problems associated with long
274commandlines under some shells.
275
276=end comment
277
278=cut
279
280########################################################################
281package ExtUtils::CBuilder::Platform::Windows::MSVC;
282
283sub format_compiler_cmd {
284 my ($self, %spec) = @_;
285
286 foreach my $path ( @{ $spec{includes} || [] },
287 @{ $spec{perlinc} || [] } ) {
288 $path = '-I' . $path;
289 }
290
291 %spec = $self->write_compiler_script(%spec)
292 if $spec{use_scripts};
293
294 return [ grep {defined && length} (
295 $spec{cc},'-nologo','-c',
296 @{$spec{includes}} ,
297 @{$spec{cflags}} ,
298 @{$spec{optimize}} ,
299 @{$spec{defines}} ,
300 @{$spec{perlinc}} ,
301 "-Fo$spec{output}" ,
302 $spec{source} ,
303 ) ];
304}
305
306sub write_compiler_script {
307 my ($self, %spec) = @_;
308
309 my $script = File::Spec->catfile( $spec{srcdir},
310 $spec{basename} . '.ccs' );
311
312 $self->add_to_cleanup($script);
313
314 print "Generating script '$script'\n" if !$self->{quiet};
315
316 open( SCRIPT, ">$script" )
317 or die( "Could not create script '$script': $!" );
318
319 print SCRIPT join( "\n",
320 map { ref $_ ? @{$_} : $_ }
321 grep defined,
322 delete(
323 @spec{ qw(includes cflags optimize defines perlinc) } )
324 );
325
326 close SCRIPT;
327
328 push @{$spec{includes}}, '@"' . $script . '"';
329
330 return %spec;
331}
332
333sub format_linker_cmd {
334 my ($self, %spec) = @_;
335
336 foreach my $path ( @{$spec{libpath}} ) {
337 $path = "-libpath:$path";
338 }
339
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};
344
345 %spec = $self->write_linker_script(%spec)
346 if $spec{use_scripts};
347
348 return [ grep {defined && length} (
349 $spec{ld} ,
350 @{$spec{lddlflags}} ,
351 @{$spec{libpath}} ,
352 @{$spec{other_ldflags}} ,
353 @{$spec{startup}} ,
354 @{$spec{objects}} ,
355 $spec{map_file} ,
356 $spec{libperl} ,
357 @{$spec{perllibs}} ,
358 $spec{def_file} ,
359 $spec{implib} ,
360 $spec{output} ,
361 ) ];
362}
363
364sub write_linker_script {
365 my ($self, %spec) = @_;
366
367 my $script = File::Spec->catfile( $spec{srcdir},
368 $spec{basename} . '.lds' );
369
370 $self->add_to_cleanup($script);
371
372 print "Generating script '$script'\n" if !$self->{quiet};
373
374 open( SCRIPT, ">$script" )
375 or die( "Could not create script '$script': $!" );
376
377 print SCRIPT join( "\n",
378 map { ref $_ ? @{$_} : $_ }
379 grep defined,
380 delete(
381 @spec{ qw(lddlflags libpath other_ldflags
382 startup objects libperl perllibs
383 def_file implib map_file) } )
384 );
385
386 close SCRIPT;
387
388 push @{$spec{lddlflags}}, '@"' . $script . '"';
389
390 return %spec;
391}
392
3931;
394
395########################################################################
396package ExtUtils::CBuilder::Platform::Windows::BCC;
397
398sub format_compiler_cmd {
399 my ($self, %spec) = @_;
400
401 foreach my $path ( @{ $spec{includes} || [] },
402 @{ $spec{perlinc} || [] } ) {
403 $path = '-I' . $path;
404 }
405
406 %spec = $self->write_compiler_script(%spec)
407 if $spec{use_scripts};
408
409 return [ grep {defined && length} (
410 $spec{cc}, '-c' ,
411 @{$spec{includes}} ,
412 @{$spec{cflags}} ,
413 @{$spec{optimize}} ,
414 @{$spec{defines}} ,
415 @{$spec{perlinc}} ,
416 "-o$spec{output}" ,
417 $spec{source} ,
418 ) ];
419}
420
421sub write_compiler_script {
422 my ($self, %spec) = @_;
423
424 my $script = File::Spec->catfile( $spec{srcdir},
425 $spec{basename} . '.ccs' );
426
427 $self->add_to_cleanup($script);
428
429 print "Generating script '$script'\n" if !$self->{quiet};
430
431 open( SCRIPT, ">$script" )
432 or die( "Could not create script '$script': $!" );
433
434 print SCRIPT join( "\n",
435 map { ref $_ ? @{$_} : $_ }
436 grep defined,
437 delete(
438 @spec{ qw(includes cflags optimize defines perlinc) } )
439 );
440
441 close SCRIPT;
442
443 push @{$spec{includes}}, '@"' . $script . '"';
444
445 return %spec;
446}
447
448sub format_linker_cmd {
449 my ($self, %spec) = @_;
450
451 foreach my $path ( @{$spec{libpath}} ) {
452 $path = "-L$path";
453 }
454
455 push( @{$spec{startup}}, 'c0d32.obj' )
456 unless ( $spec{starup} && @{$spec{startup}} );
457
458 %spec = $self->write_linker_script(%spec)
459 if $spec{use_scripts};
460
461 return [ grep {defined && length} (
462 $spec{ld} ,
463 @{$spec{lddlflags}} ,
464 @{$spec{libpath}} ,
465 @{$spec{other_ldflags}} ,
466 @{$spec{startup}} ,
467 @{$spec{objects}} , ',',
468 $spec{output} , ',',
469 $spec{map_file} , ',',
470 $spec{libperl} ,
471 @{$spec{perllibs}} , ',',
472 $spec{def_file}
473 ) ];
474}
475
476sub write_linker_script {
477 my ($self, %spec) = @_;
478
479 # To work around Borlands "unique" commandline syntax,
480 # two scripts are used:
481
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' );
486
487 $self->add_to_cleanup($ld_script, $ld_libs);
488
489 print "Generating scripts '$ld_script' and '$ld_libs'.\n" if !$self->{quiet};
490
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': $!" );
494
495 print LD_SCRIPT join( " +\n",
496 map { @{$_} }
497 grep defined,
498 delete(
499 @spec{ qw(lddlflags libpath other_ldflags startup objects) } )
500 );
501
502 close LD_SCRIPT;
503
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': $!" );
507
508 print LD_LIBS join( " +\n",
509 (delete $spec{libperl} || ''),
510 @{delete $spec{perllibs} || []},
511 );
512
513 close LD_LIBS;
514
515 push @{$spec{lddlflags}}, '@"' . $ld_script . '"';
516 push @{$spec{perllibs}}, '@"' . $ld_libs . '"';
517
518 return %spec;
519}
520
5211;
522
523########################################################################
524package ExtUtils::CBuilder::Platform::Windows::GCC;
525
526sub format_compiler_cmd {
527 my ($self, %spec) = @_;
528
529 foreach my $path ( @{ $spec{includes} || [] },
530 @{ $spec{perlinc} || [] } ) {
531 $path = '-I' . $path;
532 }
533
534 # split off any -arguments included in cc
535 my @cc = split / (?=-)/, $spec{cc};
536
537 return [ grep {defined && length} (
538 @cc, '-c' ,
539 @{$spec{includes}} ,
540 @{$spec{cflags}} ,
541 @{$spec{optimize}} ,
542 @{$spec{defines}} ,
543 @{$spec{perlinc}} ,
544 '-o', $spec{output} ,
545 $spec{source} ,
546 ) ];
547}
548
549sub format_linker_cmd {
550 my ($self, %spec) = @_;
551
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/;
556
557 unshift( @{$spec{other_ldflags}}, '-nostartfiles' )
558 if ( $spec{startup} && @{$spec{startup}} );
559
560 # From ExtUtils::MM_Win32:
561 #
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) );
568
569 %spec = $self->write_linker_script(%spec)
570 if $spec{use_scripts};
571
572 foreach my $path ( @{$spec{libpath}} ) {
573 $path = "-L$path";
574 }
575
576 my @cmds; # Stores the series of commands needed to build the module.
577
578 push @cmds, [
579 'dlltool', '--def' , $spec{def_file},
580 '--output-exp' , $spec{explib}
581 ];
582
583 # split off any -arguments included in ld
584 my @ld = split / (?=-)/, $spec{ld};
585
586 push @cmds, [ grep {defined && length} (
587 @ld ,
588 '-o', $spec{output} ,
589 "-Wl,--base-file,$spec{base_file}" ,
590 "-Wl,--image-base,$spec{image_base}" ,
591 @{$spec{lddlflags}} ,
592 @{$spec{libpath}} ,
593 @{$spec{startup}} ,
594 @{$spec{objects}} ,
595 @{$spec{other_ldflags}} ,
596 $spec{libperl} ,
597 @{$spec{perllibs}} ,
598 $spec{explib} ,
599 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
600 ) ];
601
602 push @cmds, [
603 'dlltool', '--def' , $spec{def_file},
604 '--output-exp' , $spec{explib},
605 '--base-file' , $spec{base_file}
606 ];
607
608 push @cmds, [ grep {defined && length} (
609 @ld ,
610 '-o', $spec{output} ,
611 "-Wl,--image-base,$spec{image_base}" ,
612 @{$spec{lddlflags}} ,
613 @{$spec{libpath}} ,
614 @{$spec{startup}} ,
615 @{$spec{objects}} ,
616 @{$spec{other_ldflags}} ,
617 $spec{libperl} ,
618 @{$spec{perllibs}} ,
619 $spec{explib} ,
620 $spec{map_file} ? ('-Map', $spec{map_file}) : ''
621 ) ];
622
623 return @cmds;
624}
625
626sub write_linker_script {
627 my ($self, %spec) = @_;
628
629 my $script = File::Spec->catfile( $spec{srcdir},
630 $spec{basename} . '.lds' );
631
632 $self->add_to_cleanup($script);
633
634 print "Generating script '$script'\n" if !$self->{quiet};
635
636 open( SCRIPT, ">$script" )
637 or die( "Could not create script '$script': $!" );
638
639 print( SCRIPT 'SEARCH_DIR(' . $_ . ")\n" )
640 for @{delete $spec{libpath} || []};
641
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} || []};
649 }
650
651 print SCRIPT 'INPUT(' . join( ',',
652 @{delete $spec{objects} || []}
653 ) . ")\n";
654
655 print SCRIPT 'INPUT(' . join( ' ',
656 (delete $spec{libperl} || ''),
657 @{delete $spec{perllibs} || []},
658 ) . ")\n";
659
660 close SCRIPT;
661
662 push @{$spec{other_ldflags}}, '"' . $script . '"';
663
664 return %spec;
665}
666
6671;
668
669__END__
670
671=head1 NAME
672
673ExtUtils::CBuilder::Platform::Windows - Builder class for Windows platforms
674
675=head1 DESCRIPTION
676
677This module implements the Windows-specific parts of ExtUtils::CBuilder.
678Most of the Windows-specific stuff has to do with compiling and
679linking C code. Currently we support the 3 compilers perl itself
680supports: MSVC, BCC, and GCC.
681
682This module inherits from C<ExtUtils::CBuilder::Base>, so any functionality
683not implemented here will be implemented there. The interfaces are
684defined by the L<ExtUtils::CBuilder> documentation.
685
686=head1 AUTHOR
687
688Ken Williams <ken@mathforum.org>
689
690Most of the code here was written by Randy W. Sims <RandyS@ThePierianSpring.org>.
691
692=head1 SEE ALSO
693
694perl(1), ExtUtils::CBuilder(3), ExtUtils::MakeMaker(3)
695
696=cut