--- /usr/local/bin/cons Thu May 20 05:19:09 1999 +++ cons Thu Aug 19 17:11:17 1999 @@ -152,6 +152,8 @@ -v Show cons version and continue processing. -V Show cons version and exit. -x Show this message and exit. + + -j Allow up to jobs to be spawned in parallel Please report any bugs/fixes/suggestions through the cons-discuss@eng.fore.com mailing list. To subscribe, send mail to @@ -176,6 +178,7 @@ $param::salt = undef; # Salt derived file signatures with this. $param::rep_sig_times_ok = 1; # Repository .consign times are in sync w/files. $param::quiet = 0; # should we show the command being executed. +$param::max_jobs = 1; # Display a command while executing or otherwise. This # should be called by command builder action methods. @@ -192,7 +195,9 @@ 'LINKCOM' => '%LINK %LDFLAGS -o %> %< %_LDIRS %LIBS', 'LINKMODULECOM'=> '%LD -r -o %> %<', 'AR' => 'ar', - 'ARCOM' => "%AR %ARFLAGS %> %<\n%RANLIB %>", + # multi-commands are broken with parallel cons, must use && instead + # of \n + 'ARCOM' => "%AR %ARFLAGS %> %< && %RANLIB %>", 'ARFLAGS' => 'r', # rs? 'RANLIB' => 'ranlib', 'AS' => 'as', @@ -282,6 +287,8 @@ my($repository) = shift(@ARGV); die("$0: -R option requires a repository argument.\n") if !$repository; script::Repository($repository); + } elsif ($_ eq 'j') { + $param::max_jobs = shift(@ARGV); } else { die qq($0: unrecognized option "-$_". Use -x for a usage message.\n) if $_; } @@ -1102,6 +1109,7 @@ if ($main::_WIN32) { system($com); } else { + &file::wait_on_max_jobs(); my($pid) = fork(); die("$0: unable to fork child process ($!)\n") if !defined $pid; if (!$pid) { @@ -1111,26 +1119,8 @@ die qq($0: failed to execute "$com" ($!). ) . qq(Is this an executable on path "$ENV{PATH}"?\n); } - for (;;) { - do {} until wait() == $pid; - my($b0, $b1 ) = ($? & 0xFF, $? >> 8); - # Don't actually see 0177 on stopped process; is this necessary? - next if $b0 == 0177; # process stopped; we can wait. - if ($b0) { - my($core, $sig) = ($b0 & 0200, $b0 & 0177); - my($coremsg) = $core ? "; core dumped" : ""; - $com =~ s/\s.*//; - my($path) = $tgt->path; - warn qq($0: *** [$path] $com terminated by signal $sig$coremsg\n); - return undef; - } - if ($b1) { - my($path) = $tgt->path; - warn qq($0: *** [$path] Error $b1\n); # trying to be like make. - return undef; - } - last; - } + $file::child_queue->{$pid}->{com} = $com; + $file::child_queue->{$pid}->{tgt} = $tgt; } } @@ -1438,7 +1428,13 @@ # Now do the action to build all the targets. For consistency # we always call the action on the first target, just so that # $> is deterministic. - $self->{built} = $self->{builder}->action($tgts->[0]); + { + # action now is non-blocking, so we must kludge blocking for this + # explicit call + local( $file::child_queue ) = { parent => $tgts->[0] }; + $self->{built} = $self->{builder}->action($tgts->[0]); + &file::wait_on_all_children(); + } # Now "build" all the other targets (except for the one # we were called with). This guarantees that the signature @@ -1973,6 +1969,18 @@ } sub _build { + my($tgt) = @_; + local( $child_queue ) = { parent => $tgt }; + _pbuild( $tgt ); + wait_on_all_children(); + return $tgt->{status}; +} + +sub pbuild { + $_[0]->{status} || &file::_pbuild; +} + +sub _pbuild { my($self) = @_; print main::DEPFILE $self->path, "\n" if param::depfile; print((' ' x $level), $self->path, "\n") if $param::depends; @@ -2008,14 +2016,20 @@ $rdeps = [values(%rdeps)]; } - for $dep (@$rdeps) { - if ((build $dep) eq 'errors') { - # Propagate dependent errors to target. - # but try to build all dependents regardless of errors. - $self->{status} = 'errors'; + my $sig; + { + #print "in ", $self->path, "\n"; + local( $file::child_queue ) = { parent => $self }; + for $dep (@$rdeps) { + if ((pbuild $dep) eq 'errors') { + # Propagate dependent errors to target. + # but try to build all dependents regardless of errors. + $self->{status} = 'errors'; + } } - } + wait_on_all_children(); + } # If any dependents had errors, then we abort. if ($self->{status} eq 'errors') { $level -= 2; @@ -2025,7 +2039,8 @@ # Compute the final signature of the file, based on # the static dependencies (in order), dynamic dependencies, # output path name, and (non-substituted) build script. - my($sig) = sig->collect(map(sig->signature($_->rfile), @deps), + + $sig = $self->{sign} = sig->collect(map(sig->signature($_->rfile), @deps), $builder->includes($self), $builder->script); @@ -2043,7 +2058,7 @@ # our calculated signature). if ($self->local) { # ...but they want a local copy, so provide it. - main::showcom("Local copy of ${\$self->path} from ${\$self->rpath}"); + main::showcom("Local copy of ${\$self->path} from ${\$self->rpath}"); futil::install($self->rpath, $self); sig->set($self, $sig); } @@ -2063,7 +2078,13 @@ # First check to see if the built file is cached. if ($builder->cachin($self, $sig)) { sig->set($self, $sig); - return $self->{status} = 'built'; + return $self->{status} = 'built'; + + # action no longer blocks (for most actions), so this returns + # immediately, before any commands are actually run. The + # signature and return status should be overridden later in + # wait_on_child if a process was forked, but they are still set + # here in case a non-spawning action was called } elsif ($builder->action($self)) { $builder->cachout($self, $sig); sig->set($self, $sig); @@ -2086,6 +2107,82 @@ return $self->{status} = 'handled'; } } + +sub wait_on_max_jobs { + while( grep( /\d+/, keys %{$child_queue} ) >= $param::max_jobs ) { + wait_on_child(); + } +} + +sub wait_on_all_children { + + while( grep( /\d+/, keys %{$child_queue} ) != 0 ) { + wait_on_child(); + } +} + +sub wait_on_child { + my( $queue ) = $child_queue; + my( $parent ) = $queue->{parent}; + + #print "par: ", $parent->path, "\n" if ref($parent) eq 'file'; + my $pid = undef; + + # first check for jobs that have already been collected from child + # targets + for $p ( @finished ) { + if( $queue->{$p} ) { + $pid = $p; + last; + } + } + + while( !$queue->{$pid} ) { + $pid = wait(); + if( $pid < 1 ) { + die "wait returned invalid pid $pid"; + } else { + # this job was meant for a parent, save it so that it can be + # found later + if( !$queue->{$pid} ) { + push @finished, $pid; + } + } + } + + my $child = $queue->{$pid}; + my $tgt = $queue->{$pid}->{tgt}; + my $com = $child->{com}; + $tgt->{status} = 'built'; + #print "waited: ", $tgt->path; + #print "on: ", keys %{$queue}, "\n"; + + my($b0, $b1 ) = ($? & 0xFF, $? >> 8); + # Don't actually see 0177 on stopped process; is this necessary? + # next if $b0 == 0177; # process stopped; we can wait. + if ($b0) { + my($core, $sig) = ($b0 & 0200, $b0 & 0177); + my($coremsg) = $core ? "; core dumped" : ""; + $com =~ s/\s.*//; + my($path) = $tgt->path; + warn qq($0: *** [$path] $com terminated by signal $sig$coremsg\n); + $parent->{status} = $tgt->{status} = 'errors'; + } + if ($b1) { + my($path) = $tgt->path; + warn qq($0: *** [$path] Error $b1\n); # trying to be like make. + $parent->{status} = $tgt->{status} = 'errors'; + } + if( $tgt->{status} eq 'built' ) { + $tgt->{builder}->cachout($tgt, $tgt->{sign}); + sig->set($tgt, $tgt->{sign}); + } else { + die("$0: errors constructing ${\$tgt->path}\n") unless $param::kflag; + } + delete $queue->{$pid}; + +} + # Bind an action to a file, with the specified sources. No return value. sub bind {