#!/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####### RUNNING 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;

    }

}