chiark - git - mdw - rhodes/blob - dispatch

   1 #! /usr/bin/perl
   2
   3 use POSIX qw(:sys_wait_h);
   4
   5 @ARGV == 2 or die "usage: $0 DIR WORKERS";
   6 my ($DIR, $WORKERS) = @ARGV;
   7
   8 open my $fh, "<", $WORKERS or die "open($WORKERS): $!";
   9 my @W = ();
  10 my @C = ();
  11 my %P = ();
  12 my @F = ();
  13 while (<$fh>) {
  14   next unless /^\s*[^#]/;
  15   my ($w, $n, @c) = split;
  16   for (my $i = 0; $i < $n; $i++) {
  17     push @W, "$w#$i";
  18     push @C, \@c;
  19   }
  20 }
  21 for (my $i = 0; $i < @W; $i++) { push @F, $i; }
  22
  23 sub state {
  24   system "./rhodes", "done", $DIR;
  25   if ($? == 0) { return 'DONE'; }
  26   elsif ($? == 512) { return 'IDLE'; }
  27   elsif ($? != 256) { die "job broken: done rc = $?"; }
  28   else { $STATE = 'BUSY'; }
  29 }
  30
  31 my $STATE = 'BUSY';
  32 my $RUN = 0;
  33 while ($RUN || $STATE ne 'DONE') {
  34   if ($STATE ne 'DONE') { $STATE = state; }
  35   while (@F && $STATE eq 'BUSY') {
  36     my $i = shift @F;
  37     print "## -> $W[$i]\n";
  38     defined (my $kid = fork) or die "fork: $!";
  39     if (!$kid) {
  40       exec "./rhodes", "step", $DIR, @{$C[$i]};
  41       die "exec: $!";
  42     }
  43     $P{$kid} = $i;
  44     $RUN++;
  45     $STATE = state;
  46   }
  47
  48   my $kid = waitpid -1, 0;
  49   while ($kid > 0) {
  50     next unless exists $P{$kid};
  51     my $i = $P{$kid};
  52     print "## <- $W[$i] rc = $?\n";
  53     push @F, $i; $RUN--;
  54     $kid = waitpid -1, WNOHANG;
  55   }
  56 }