Rename WebKitTools to Tools
[WebKit-https.git] / 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 }