syn68k/runtime/sched.pl
2008-09-26 08:25:10 -06:00

320 lines
6.5 KiB
Perl
Executable File

#!/usr/bin/perl
require "x86_recog.pl";
sub intersect {
local (@sets) = @_;
local ($set, $elem);
local (%mark);
foreach $set (@sets) {
foreach $elem (split (' ', $set))
{
local (@keys);
$mark{$elem} = $mark{$elem};
@keys = keys %mark;
grep (do { $mark{$_}++ if /$elem/; }, @keys);
grep (do { $mark{$elem}++ if $elem =~ /$_/; }, @keys);
$mark{$elem}--;
# grep (do { $mark{$elem}-- if $elem eq $_; }, @keys);
}
}
return &union (join (' ', grep ($mark{$_} >= @sets, keys (%mark))));
}
sub union {
local (@sets) = @_;
local (@from, @to);
local ($elem);
@from = split (' ', join (' ', @sets));
while ($elem = shift @from)
{
next if grep ($elem =~ /$_/, @from);
next if grep ($elem =~ /$_/, @to);
push (@to, $elem);
}
return join (' ', sort (@to));
}
sub is_subset {
local ($little, $big) = @_;
return ($little eq &intersect ($little, $big));
}
sub make_parents {
local($lineno, $earlier);
local($seeking, $not_seeking, $found);
foreach $lineno ($first_line .. $last_line)
{
local (*par_ref) = 'parents' . $lineno;
@par_ref = ();
undef $not_seeking;
$seeking = $inputs[$lineno];
next if (!$seeking);
foreach $earlier (reverse ($first_line .. $lineno-1))
{
$found = &intersect ($seeking, $outputs[$earlier]);
next if (&is_subset ($found, $not_seeking));
$not_seeking = &union ($not_seeking, $found);
if ($found) {
#print $lineno . " " . $earlier . "\n";
push (@par_ref, $earlier);
}
}
}
}
sub bad_order {
local ($first, $middle, $last) = @_;
if (($first < $middle) && ($middle < $last)) {
return 0;
}
if (!defined ($cached_bad{$first, $middle, $last})) {
if (&intersect ($outputs[$first],
&intersect($outputs[$middle],
$inputs[$last])))
{
$cached_bad{$first, $middle, $last} = 1;
}
else
{
$cached_bad{$first, $middle, $last} = 0;
}
}
return $cached_bad{$first, $middle, $last};
}
sub max
{
local (@values) = @_;
local ($result);
grep (do { $result = $_ if $result < $_ } && 0, @values);
return $result;
}
sub static_eval {
return ($start_time[$schedule[$#schedule]] + 1 + $last_line -
$first_line + 1 - @schedule);
}
sub push_schedule {
local ($lineno) = @_;
local (@parents_times);
local ($parent);
if ($lineno == 0)
{
$start_time[$lineno] = 0;
}
else
{
local (*par_ref) = 'parents' . $lineno;
foreach $parent (@par_ref)
{
push (@parents_times, $start_time[$parent] + $latency[$parent]);
}
$start_time[$lineno] = &max ($start_time[$schedule[$#schedule]] + 1,
@parents_times);
}
push (@schedule, $lineno);
}
sub pop_schedule {
pop (@schedule);
}
sub dump_schedule
{
local ($lineno);
foreach $lineno (@_)
{
print "$lines[$lineno]\t; $start_time[$lineno]\n"
}
}
sub create_greedy_lookup
{
local (@which_lines) = @_;
local ($lineno);
foreach $lineno (@which_lines)
{
&push_schedule ($lineno);
$greedy_lookup[$lineno] = &static_eval ();
&pop_schedule ();
}
}
sub bygreed
{
local ($foo);
$foo = $greedy_lookup[$a] <=> $greedy_lookup[$b];
return ($a <=> $b) if (!$foo);
return $foo;
}
sub parents_scheduled
{
local ($lineno) = @_;
local (*par_ref) = 'parents' . $lineno;
return !grep (!$scheduled[$_], @par_ref);
}
sub create_schedule {
local ($lineno, $unscheduled_line);
local ($static_value);
local (@valid_next_lines);
local (@unscheduled);
local (@possible_problems);
return if ($best_so_far == $last_line - $first_line + 1);
$static_value = &static_eval();
return if ($static_value >= $best_so_far);
if (@schedule == $last_line - $first_line + 1)
{
# &dump_schedule (@schedule);
# print " Value: $static_value\n";
if ($static_value <= $best_so_far)
{
@best_schedule = @schedule;
$best_so_far = $static_value;
}
return;
}
@unscheduled = grep (!$scheduled[$_], ($first_line .. $last_line));
@valid_next_lines = grep (&parents_scheduled ($_), @unscheduled);
&create_greedy_lookup (@valid_next_lines);
foreach $lineno (sort bygreed (@valid_next_lines))
{
local ($bad);
$bad = 0;
foreach $unscheduled_line (@unscheduled)
{
local ($possible_problem);
local (*par_ref) = 'parents' . $unscheduled_line;
next if $unscheduled_line == $lineno;
@possible_problems = grep ($scheduled[$_], @par_ref);
foreach $possible_problem (@possible_problems)
{
next if (!&bad_order ($possible_problem, $lineno,
$unscheduled_line));
$bad = 1;
last;
}
last if $bad;
}
next if $bad;
&push_schedule ($lineno);
$scheduled[$lineno] = 1;
&create_schedule ();
&pop_schedule ();
$scheduled[$lineno] = 0;
}
}
@parents0 = @parents1 = @parents2 = @parents3 = ();
@parents4 = @parents5 = @parents6 = @parents7 = ();
@parents8 = @parents9 = @parents10 = @parents11 = ();
while (<>) {
next if /^\s*$/;
next if /^#(NO_)?APP/;
if (!@lines && /^\s*\./)
{
print;
next;
}
chop;
if (!@lines) {
# Prepend a dummy instruction
push (@lines, '@@@@bogo@@@@');
$inputs[$#lines] = "";
$outputs[$#lines] = "";
$latency[$#lines] = 0;
}
push (@lines, $_);
($inputs[$#lines], $outputs[$#lines], $latency[$#lines]) =
&recognize ($_);
if (@lines >= 10 || eof() || $inputs[$#lines] eq '.*'
|| $outputs[$#lines] =~ /eip/)
{
local ($saved_outputs);
$saved_outputs = $outputs[0];
$outputs[0] = '.*';
# Append a dummy instruction
push (@lines, '@@@@bogo@@@@');
$inputs[$#lines] = ".*";
$outputs[$#lines] = ".*";
$latency[$#lines] = 0;
$first_line = 0;
$last_line = $#lines;
&make_parents ();
$best_so_far = 999999;
undef %cached_bad;
undef @schedule;
undef @start_time;
undef @best_schedule;
undef @scheduled;
# print "\nInput block:\n", join ("\n", @lines), "\n";
&create_schedule ();
# print "\nOutput block:\n", join ("\n", @lines[@best_schedule]), "\n\n";
$outputs[0] = $saved_outputs;
# Renumber everything
@lines = @lines[@best_schedule];
@inputs = @inputs[@best_schedule];
@outputs = @outputs[@best_schedule];
@latency = @latency[@best_schedule];
while ($line = shift @lines)
{
local ($foo, $bar);
$foo = shift @inputs;
$bar = shift @outputs;
shift @latency;
print "$line\n" if ($line !~ /\@\@\@\@bogo\@\@\@\@/);
print STDERR "$line\n" if ($line =~ /^\w*:\s*$/);
# print " Inputs: $foo\n Outputs: $bar\n";
# last if ((@lines <= 5) && !eof() && !($inputs[$#lines] eq '.*'));
}
}
}