Tools/Scripts/parallelcl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Basename;
   7 use File::Spec;
   8 use File::Temp;
   9 use POSIX;
  10
  11 sub makeJob(\@$);
  12 sub forkAndCompileFiles(\@$);
  13 sub Exec($);
  14 sub waitForChild(\@);
  15 sub cleanup(\@);
  16
  17 my $debug = 0;
  18
  19 chomp(my $clexe = `cygpath -u '$ENV{'VS80COMNTOOLS'}/../../VC/bin/cl.exe'`);
  20
  21 if ($debug) {
  22     print STDERR "Received " . @ARGV . " arguments:\n";
  23     foreach my $arg (@ARGV) {
  24         print STDERR "$arg\n";
  25     }
  26 }
  27
  28 my $commandFile;
  29 foreach my $arg (@ARGV) {
  30     if ($arg =~ /^[\/-](E|EP|P)$/) {
  31         print STDERR "The invoking process wants preprocessed source, so let's hand off this whole command to the real cl.exe\n" if $debug;
  32         Exec("\"$clexe\" \"" . join('" "', @ARGV) . "\"");
  33     } elsif ($arg =~ /^@(.*)$/) {
  34         chomp($commandFile = `cygpath -u '$1'`);
  35     }
  36 }
  37
  38 die "No command file specified!" unless $commandFile;
  39 die "Couldn't find $commandFile!" unless -f $commandFile;
  40
  41 my @sources;
  42
  43 open(COMMAND, '<:raw:encoding(UTF16-LE):crlf:utf8', $commandFile) or die "Couldn't open $commandFile!";
  44
  45 # The first line of the command file contains all the options to cl.exe plus the first (possibly quoted) filename
  46 my $firstLine = <COMMAND>;
  47 $firstLine =~ s/\r?\n$//;
  48
  49 # To find the start of the first filename, look for either the last space on the line.
  50 # If the filename is quoted, the last character on the line will be a quote, so look for the quote before that.
  51 my $firstFileIndex;
  52 print STDERR "Last character of first line = '" . substr($firstLine, -1, 1) . "'\n" if $debug;
  53 if (substr($firstLine, -1, 1) eq '"') {
  54     print STDERR "First file is quoted\n" if $debug;
  55     $firstFileIndex = rindex($firstLine, '"', length($firstLine) - 2);
  56 } else {
  57     print STDERR "First file is NOT quoted\n" if $debug;
  58     $firstFileIndex = rindex($firstLine, ' ') + 1;
  59 }
  60
  61 my $options = substr($firstLine, 0, $firstFileIndex) . join(' ', @ARGV[1 .. $#ARGV]);
  62 my $possibleFirstFile = substr($firstLine, $firstFileIndex);
  63 if ($possibleFirstFile =~ /\.(cpp|c)/) {
  64     push(@sources, $possibleFirstFile);
  65 } else {
  66     $options .= " $possibleFirstFile";
  67 }
  68
  69 print STDERR "######## Found options $options ##########\n" if $debug;
  70 print STDERR "####### Found first source file $sources[0] ########\n" if @sources && $debug;
  71
  72 # The rest of the lines of the command file just contain source files, one per line
  73 while (my $source = <COMMAND>) {
  74     chomp($source);
  75     $source =~ s/^\s+//;
  76     $source =~ s/\s+$//;
  77     push(@sources, $source) if length($source);
  78 }
  79 close(COMMAND);
  80
  81 my $numSources = @sources;
  82 exit unless $numSources > 0;
  83
  84 my $numJobs;
  85 if ($options =~ s/-j\s*([0-9]+)//) {
  86     $numJobs = $1;
  87 } else {
  88     chomp($numJobs = `num-cpus`);
  89 }
  90
  91 print STDERR "\n\n####### COMPILING $numSources FILES USING AT MOST $numJobs PARALLEL INSTANCES OF cl.exe ###########\n\n";# if $debug;
  92
  93 # Magic determination of job size
  94 # The hope is that by splitting the source files up into 2*$numJobs pieces, we
  95 # won't suffer too much if one job finishes much more quickly than another.
  96 # However, we don't want to split it up too much due to cl.exe overhead, so set
  97 # the minimum job size to 5.
  98 my $jobSize = POSIX::ceil($numSources / (2 * $numJobs));
  99 $jobSize = $jobSize < 5 ? 5 : $jobSize;
 100
 101 print STDERR "######## jobSize = $jobSize ##########\n" if $debug;
 102
 103 # Sort the source files randomly so that we don't end up with big clumps of large files (aka SVG)
 104 sub fisher_yates_shuffle(\@)
 105 {
 106     my ($array) = @_;
 107     for (my $i = @{$array}; --$i; ) {
 108         my $j = int(rand($i+1));
 109         next if $i == $j;
 110         @{$array}[$i,$j] = @{$array}[$j,$i];
 111     }
 112 }
 113
 114 fisher_yates_shuffle(@sources);    # permutes @array in place
 115
 116 my @children;
 117 my @tmpFiles;
 118 my $status = 0;
 119 while (@sources) {
 120     while (@sources && @children < $numJobs) {
 121         my $pid;
 122         my $tmpFile;
 123         my $job = makeJob(@sources, $jobSize);
 124         ($pid, $tmpFile) = forkAndCompileFiles(@{$job}, $options);
 125
 126         print STDERR "####### Spawned child with PID $pid and tmpFile $tmpFile ##########\n" if $debug;
 127         push(@children, $pid);
 128         push(@tmpFiles, $tmpFile);
 129     }
 130
 131     $status |= waitForChild(@children);
 132 }
 133
 134 while (@children) {
 135     $status |= waitForChild(@children);
 136 }
 137 cleanup(@tmpFiles);
 138
 139 exit WEXITSTATUS($status);
 140
 141
 142 sub makeJob(\@$)
 143 {
 144     my ($files, $jobSize) = @_;
 145
 146     my @job;
 147     if (@{$files} > ($jobSize * 1.5)) {
 148         @job = splice(@{$files}, -$jobSize);
 149     } else {
 150         # Compile all the remaining files in this job to avoid having a small job later
 151         @job = splice(@{$files});
 152     }
 153
 154     return \@job;
 155 }
 156
 157 sub forkAndCompileFiles(\@$)
 158 {
 159     print STDERR "######## forkAndCompileFiles()\n" if $debug;
 160     my ($files, $options) = @_;
 161
 162     if ($debug) {
 163         foreach my $file (@{$files}) {
 164             print STDERR "######## $file\n";
 165         }
 166     }
 167
 168     my (undef, $tmpFile) = File::Temp::tempfile('clcommandXXXXX', DIR => File::Spec->tmpdir, OPEN => 0);
 169
 170     my $pid = fork();
 171     die "Fork failed" unless defined($pid);
 172
 173     unless ($pid) {
 174         # Child process
 175         open(TMP, '>:raw:encoding(UTF16-LE):crlf:utf8', $tmpFile) or die "Couldn't open $tmpFile";
 176         print TMP "$options\n";
 177         foreach my $file (@{$files}) {
 178             print TMP "$file\n";
 179         }
 180         close(TMP);
 181
 182         chomp(my $winTmpFile = `cygpath -m $tmpFile`);
 183         Exec "\"$clexe\" \@\"$winTmpFile\"";
 184     } else {
 185         return ($pid, $tmpFile);
 186     }
 187 }
 188
 189 sub Exec($)
 190 {
 191     my ($command) = @_;
 192
 193     print STDERR "Exec($command)\n" if $debug;
 194
 195     exec($command);
 196 }
 197
 198 sub waitForChild(\@)
 199 {
 200     my ($children) = @_;
 201
 202     return unless @{$children};
 203
 204     my $deceased = wait();
 205     my $status = $?;
 206     print STDERR "######## Child with PID $deceased finished ###########\n" if $debug;
 207     for (my $i = 0; $i < @{$children}; $i++) {
 208         if ($children->[$i] == $deceased) {
 209             splice(@{$children}, $i, 1);
 210             last;
 211         }
 212     }
 213
 214     return $status;
 215 }
 216
 217 sub cleanup(\@)
 218 {
 219     my ($tmpFiles) = @_;
 220
 221     foreach my $file (@{$tmpFiles}) {
 222         unlink $file;
 223     }
 224 }