blob: 8a46365eb1b6e6470c64746683fa059e52393ede [file] [log] [blame]
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use File::Spec;
use File::Temp;
use POSIX;
sub makeJob(\@$);
sub forkAndCompileFiles(\@$);
sub Exec($);
sub waitForChild(\@);
sub cleanup(\@);
my $debug = 0;
chomp(my $clexe = `cygpath -u '$ENV{'VS80COMNTOOLS'}/../../VC/bin/cl.exe'`);
if ($debug) {
print STDERR "Received " . @ARGV . " arguments:\n";
foreach my $arg (@ARGV) {
print STDERR "$arg\n";
}
}
my $commandFile;
foreach my $arg (@ARGV) {
if ($arg =~ /^[\/-](E|EP|P)$/) {
print STDERR "The invoking process wants preprocessed source, so let's hand off this whole command to the real cl.exe\n" if $debug;
Exec("\"$clexe\" \"" . join('" "', @ARGV) . "\"");
} elsif ($arg =~ /^@(.*)$/) {
chomp($commandFile = `cygpath -u '$1'`);
}
}
die "No command file specified!" unless $commandFile;
die "Couldn't find $commandFile!" unless -f $commandFile;
my @sources;
open(COMMAND, '<:raw:encoding(UTF16-LE):crlf:utf8', $commandFile) or die "Couldn't open $commandFile!";
# The first line of the command file contains all the options to cl.exe plus the first (possibly quoted) filename
my $firstLine = <COMMAND>;
$firstLine =~ s/\r?\n$//;
# To find the start of the first filename, look for either the last space on the line.
# If the filename is quoted, the last character on the line will be a quote, so look for the quote before that.
my $firstFileIndex;
print STDERR "Last character of first line = '" . substr($firstLine, -1, 1) . "'\n" if $debug;
if (substr($firstLine, -1, 1) eq '"') {
print STDERR "First file is quoted\n" if $debug;
$firstFileIndex = rindex($firstLine, '"', length($firstLine) - 2);
} else {
print STDERR "First file is NOT quoted\n" if $debug;
$firstFileIndex = rindex($firstLine, ' ') + 1;
}
my $options = substr($firstLine, 0, $firstFileIndex) . join(' ', @ARGV[1 .. $#ARGV]);
my $possibleFirstFile = substr($firstLine, $firstFileIndex);
if ($possibleFirstFile =~ /\.(cpp|c)/) {
push(@sources, $possibleFirstFile);
} else {
$options .= " $possibleFirstFile";
}
print STDERR "######## Found options $options ##########\n" if $debug;
print STDERR "####### Found first source file $sources[0] ########\n" if @sources && $debug;
# The rest of the lines of the command file just contain source files, one per line
while (my $source = <COMMAND>) {
chomp($source);
$source =~ s/^\s+//;
$source =~ s/\s+$//;
push(@sources, $source) if length($source);
}
close(COMMAND);
my $numSources = @sources;
exit unless $numSources > 0;
my $numJobs;
if ($options =~ s/-j\s*([0-9]+)//) {
$numJobs = $1;
} else {
chomp($numJobs = `num-cpus`);
}
print STDERR "\n\n####### COMPILING $numSources FILES USING AT MOST $numJobs PARALLEL INSTANCES OF cl.exe ###########\n\n";# if $debug;
# Magic determination of job size
# The hope is that by splitting the source files up into 2*$numJobs pieces, we
# won't suffer too much if one job finishes much more quickly than another.
# However, we don't want to split it up too much due to cl.exe overhead, so set
# the minimum job size to 5.
my $jobSize = POSIX::ceil($numSources / (2 * $numJobs));
$jobSize = $jobSize < 5 ? 5 : $jobSize;
print STDERR "######## jobSize = $jobSize ##########\n" if $debug;
# Sort the source files randomly so that we don't end up with big clumps of large files (aka SVG)
sub fisher_yates_shuffle(\@)
{
my ($array) = @_;
for (my $i = @{$array}; --$i; ) {
my $j = int(rand($i+1));
next if $i == $j;
@{$array}[$i,$j] = @{$array}[$j,$i];
}
}
fisher_yates_shuffle(@sources); # permutes @array in place
my @children;
my @tmpFiles;
my $status = 0;
while (@sources) {
while (@sources && @children < $numJobs) {
my $pid;
my $tmpFile;
my $job = makeJob(@sources, $jobSize);
($pid, $tmpFile) = forkAndCompileFiles(@{$job}, $options);
print STDERR "####### Spawned child with PID $pid and tmpFile $tmpFile ##########\n" if $debug;
push(@children, $pid);
push(@tmpFiles, $tmpFile);
}
$status |= waitForChild(@children);
}
while (@children) {
$status |= waitForChild(@children);
}
cleanup(@tmpFiles);
exit WEXITSTATUS($status);
sub makeJob(\@$)
{
my ($files, $jobSize) = @_;
my @job;
if (@{$files} > ($jobSize * 1.5)) {
@job = splice(@{$files}, -$jobSize);
} else {
# Compile all the remaining files in this job to avoid having a small job later
@job = splice(@{$files});
}
return \@job;
}
sub forkAndCompileFiles(\@$)
{
print STDERR "######## forkAndCompileFiles()\n" if $debug;
my ($files, $options) = @_;
if ($debug) {
foreach my $file (@{$files}) {
print STDERR "######## $file\n";
}
}
my (undef, $tmpFile) = File::Temp::tempfile('clcommandXXXXX', DIR => File::Spec->tmpdir, OPEN => 0);
my $pid = fork();
die "Fork failed" unless defined($pid);
unless ($pid) {
# Child process
open(TMP, '>:raw:encoding(UTF16-LE):crlf:utf8', $tmpFile) or die "Couldn't open $tmpFile";
print TMP "$options\n";
foreach my $file (@{$files}) {
print TMP "$file\n";
}
close(TMP);
chomp(my $winTmpFile = `cygpath -m $tmpFile`);
Exec "\"$clexe\" \@\"$winTmpFile\"";
} else {
return ($pid, $tmpFile);
}
}
sub Exec($)
{
my ($command) = @_;
print STDERR "Exec($command)\n" if $debug;
exec($command);
}
sub waitForChild(\@)
{
my ($children) = @_;
return unless @{$children};
my $deceased = wait();
my $status = $?;
print STDERR "######## Child with PID $deceased finished ###########\n" if $debug;
for (my $i = 0; $i < @{$children}; $i++) {
if ($children->[$i] == $deceased) {
splice(@{$children}, $i, 1);
last;
}
}
return $status;
}
sub cleanup(\@)
{
my ($tmpFiles) = @_;
foreach my $file (@{$tmpFiles}) {
unlink $file;
}
}