FS#9721 - No error check after writes in ata.c
[kugel-rb.git] / tools / multigcc.pl
blobfbe7c17aae6cf2367afaaa03649bcb26bc56b241
1 #!/usr/bin/perl
2 use List::Util 'shuffle'; # standard from Perl 5.8 and later
4 my $tempfile = "multigcc.out";
5 my @params;
6 my @files;
7 my $list = \@params;
9 # parse command line arguments
10 for my $a (@ARGV) {
11 if ($a eq "--") {
12 $list = \@files;
13 next;
16 push @{$list}, $a;
19 exit if (not @files);
21 my $command = join " ", @params;
23 # shuffle the file list to spread the load as evenly as we can
24 @files = shuffle(@files);
26 # count number of cores
27 my $cores = 1;
28 if (open CPUINFO, "</proc/cpuinfo") {
29 $cores = scalar grep /^processor/i, <CPUINFO>;
30 close CPUINFO;
33 # don't run empty children
34 if (scalar @files <= $cores)
36 $cores = 1;
39 # fork children
40 my @pids;
41 my $slice = int((scalar @files + $cores) / $cores);
42 for my $i (0 .. $cores-1)
44 my $pid = fork;
45 if ($pid)
47 # mother
48 $pids[$i] = $pid;
50 else
52 # get my slice of the files
53 my @list = @files[$i * $slice .. $i * $slice + $slice - 1];
55 # run command
56 system("$command @list > $tempfile.$$");
58 exit;
62 for my $i (0 .. $cores - 1)
64 # wait for child to complete
65 waitpid $pids[$i], 0;
67 # read & print result
68 if (open F, "<$tempfile.$pids[$i]")
70 print <F>;
71 close F;
72 unlink "$tempfile.$pids[$i]";