Fix LUA red and yellow.
[kugel-rb.git] / tools / multigcc.pl
blob5222f61b4969dc74fec0c28aa75d27a21241c35a
1 #!/usr/bin/perl
2 use Switch;
3 use List::Util 'shuffle'; # standard from Perl 5.8 and later
5 my $tempfile = "multigcc.out";
6 my @params;
7 my @files;
8 my $list = \@params;
10 # parse command line arguments
11 for my $a (@ARGV) {
12 if ($a eq "--") {
13 $list = \@files;
14 next;
17 push @{$list}, $a;
20 exit if (not @files);
22 my $command = join " ", @params;
24 # shuffle the file list to spread the load as evenly as we can
25 @files = shuffle(@files);
27 # count number of cores
28 my $cores;
29 switch($^O) {
30 case "darwin" {
31 chomp($cores = `sysctl -n hw.ncpu`);
32 $cores = 1 if ($?);
34 case "solaris" {
35 $cores = scalar grep /on-line/i, `psrinfo`;
36 $cores = 1 if ($?);
38 else {
39 if (open CPUINFO, "</proc/cpuinfo") {
40 $cores = scalar grep /^processor/i, <CPUINFO>;
41 close CPUINFO;
43 else {
44 $cores = 1;
49 # don't run empty children
50 if (scalar @files <= $cores)
52 $cores = 1;
55 # fork children
56 my @pids;
57 my $slice = int((scalar @files + $cores) / $cores);
58 for my $i (0 .. $cores-1)
60 my $pid = fork;
61 if ($pid)
63 # mother
64 $pids[$i] = $pid;
66 else
68 # get my slice of the files
69 my @list = @files[$i * $slice .. $i * $slice + $slice - 1];
71 # run command
72 system("$command @list > $tempfile.$$");
74 exit;
78 for my $i (0 .. $cores - 1)
80 # wait for child to complete
81 waitpid $pids[$i], 0;
83 # read & print result
84 if (open F, "<$tempfile.$pids[$i]")
86 print <F>;
87 close F;
88 unlink "$tempfile.$pids[$i]";