in maxas/MaxAs/MaxAs.pm [819:1129]
sub Scheduler
{
my ($block, $blockNum, $regMap, $debug) = @_;
my $vectors = $regMap->{__vectors};
my $lineNum = 0;
my (@instructs, @comments, $ordered, $first);
foreach my $line (split "\n", $block)
{
# keep track of line nums in the physical file
$lineNum++;
unless (preProcessLine($line))
{
push @comments, $line if $line =~ m'\S';
next;
}
# match an instruction
if (my $inst = processAsmLine($line, $lineNum))
{
# if the first instruction in the block is waiting on a dep, it should go first.
$inst->{first} = !$first++ && ($inst->{ctrl} & 0x1f800) ? 0 : 1;
# if the instruction has a stall of zero set, it's meant to be last (to mesh with next block)
#$inst->{first} = $inst->{ctrl} & 0x0000f ? 1 : 2;
$inst->{exeTime} = 0;
$inst->{order} = $ordered++ if $ordered;
$inst->{force_stall} = $inst->{ctrl} & 0xf if $inst->{comment} =~ m'FORCE';
push @instructs, $inst;
}
# match a label
elsif ($line =~ m'^([a-zA-Z]\w*):')
{
die "SCHEDULE_BLOCK's cannot contain labels. block: $blockNum line: $lineNum\n";
}
# open an ORDERED block
elsif ($line =~ m'^<ORDERED>')
{
die "you cannot use nested <ORDERED> tags" if $ordered;
$ordered = 1;
}
# close an ORDERED block
elsif ($line =~ m'^</ORDERED>')
{
die "missing opening <ORDERED> for closing </ORDERED> tag" if !$ordered;
$ordered = 0;
}
else
{
die "badly formed line at block: $blockNum line: $lineNum: $line\n";
}
}
my (%writes, %reads, @ready, @schedule, $orderedParent);
# assemble the instructions to op codes
foreach my $instruct (@instructs)
{
my $match = 0;
foreach my $gram (@{$grammar{$instruct->{op}}})
{
my $capData = parseInstruct($instruct->{inst}, $gram) or next;
my (@dest, @src);
# copy over instruction types for easier access
@{$instruct}{@itypes} = @{$gram->{type}}{@itypes};
$instruct->{dualCnt} = $instruct->{dual} ? 1 : 0;
# A predicate prefix is treated as a source reg
push @src, $instruct->{predReg} if $instruct->{pred};
# Handle P2R and R2P specially
if ($instruct->{op} =~ m'P2R|R2P' && $capData->{i20w7})
{
my $list = $instruct->{op} eq 'R2P' ? \@dest : \@src;
my $mask = hex($capData->{i20w7});
foreach my $p (0..6)
{
if ($mask & (1 << $p))
{
push @$list, "P$p";
}
# make this instruction dependent on any predicates it's not setting
# this is to prevent a race condition for any predicate sets that are pending
elsif ($instruct->{op} eq 'R2P')
{
push @src, "P$p";
}
}
# These instructions can't be dual issued
$instruct->{nodual} = 1;
}
# Populate our register source and destination lists, skipping any zero or true values
foreach my $operand (grep { exists $regops{$_} } sort keys %$capData)
{
# figure out which list to populate
my $list = exists($destReg{$operand}) && !exists($noDest{$instruct->{op}}) ? \@dest : \@src;
# Filter out RZ and PT
my $badVal = substr($operand,0,1) eq 'r' ? 'RZ' : 'PT';
if ($capData->{$operand} ne $badVal)
{
# add the value to list with the correct prefix
push @$list,
$operand eq 'r0' ? map(getRegNum($regMap, $_), getVecRegisters($vectors, $capData)) :
$operand eq 'r8' ? map(getRegNum($regMap, $_), getAddrVecRegisters($vectors, $capData)) :
$operand eq 'CC' ? 'CC' :
$operand eq 'X' ? 'CC' :
getRegNum($regMap, $capData->{$operand});
}
}
$instruct->{const} = 1 if exists($capData->{c20}) || exists($capData->{c39});
# Find Read-After-Write dependencies
foreach my $src (grep { exists $writes{$_} } @src)
{
# Memory operations get delayed access to registers but not to the predicate
my $regLatency = $src eq $instruct->{predReg} ? 0 : $instruct->{rlat};
# the parent should be the most recently added dest op to the stack
foreach my $parent (@{$writes{$src}})
{
# add this instruction as a child of the parent
# set the edge to the total latency of reg source availability
#print "R $parent->{inst}\n\t\t$instruct->{inst}\n";
my $latency = $src =~ m'^P\d' ? 13 : $parent->{lat};
push @{$parent->{children}}, [$instruct, $latency - $regLatency];
$instruct->{parents}++;
# if the destination was conditionally executed, we also need to keep going back till it wasn't
last unless $parent->{pred};
}
}
# Find Write-After-Read dependencies
foreach my $dest (grep { exists $reads{$_} } @dest)
{
# Flag this instruction as dependent to any previous read
foreach my $reader (@{$reads{$dest}})
{
# no need to stall for these types of dependencies
#print "W $reader->{inst} \t\t\t $instruct->{inst}\n";
push @{$reader->{children}}, [$instruct, 0];
$instruct->{parents}++;
}
# Once dependence is marked we can clear out the read list (unless this write was conditional).
# The assumption here is that you would never want to write out a register without
# subsequently reading it in some way prior to writing it again.
delete $reads{$dest} unless $instruct->{pred};
}
# Enforce instruction ordering where requested
if ($instruct->{order})
{
if ($orderedParent && $instruct->{order} > $orderedParent->{order})
{
push @{$orderedParent->{children}}, [$instruct, 0];
$instruct->{parents}++;
}
$orderedParent = $instruct;
}
elsif ($orderedParent)
{ $orderedParent = 0; }
# For a dest reg, push it onto the write stack
unshift @{$writes{$_}}, $instruct foreach @dest;
# For a src reg, push it into the read list
push @{$reads{$_}}, $instruct foreach @src;
# if this instruction has no dependencies it's ready to go
push @ready, $instruct if !exists $instruct->{parents};
$match = 1;
last;
}
die "Unable to recognize instruction at block: $blockNum line: $lineNum: $instruct->{inst}\n" unless $match;
}
%writes = ();
%reads = ();
if (@ready)
{
# update dependent counts for sorting hueristic
my $readyParent = { children => [ map { [ $_, 1 ] } @ready ], inst => "root" };
countUniqueDescendants($readyParent, {});
updateDepCounts($readyParent, {});
# sort the initial ready list
@ready = sort {
$a->{first} <=> $b->{first} ||
$b->{deps} <=> $a->{deps} ||
$a->{dualCnt} <=> $b->{dualCnt} ||
$a->{lineNum} <=> $b->{lineNum}
} @ready;
if ($debug)
{
print "0: Initial Ready List State:\n\tf,ext,stl,mix,dep,lin, inst\n";
printf "\t%d,%3s,%3s,%3s,%3s,%3s,%3s, %s\n", @{$_}{qw(first exeTime stall dualCnt mix deps lineNum inst)} foreach @ready;
}
}
# Process the ready list, adding new instructions to the list as we go.
my $clock = 0;
while (my $instruct = shift @ready)
{
my $stall = $instruct->{stall};
# apply the stall to the previous instruction
if (@schedule && $stall < 16)
{
my $prev = $schedule[$#schedule];
$stall = $prev->{force_stall} if $prev->{force_stall} > $stall;
# if stall is greater than 4 then also yield
# the yield flag is required to get stall counts 12-15 working correctly.
$prev->{ctrl} &= $stall > 4 ? 0x1ffe0 : 0x1fff0;
$prev->{ctrl} |= $stall;
$clock += $stall;
}
# For stalls bigger than 15 we assume the user is managing it with a barrier
else
{
$instruct->{ctrl} &= 0x1fff0;
$instruct->{ctrl} |= 1;
$clock += 1;
}
print "$clock: $instruct->{inst}\n" if $debug;
# add a new instruction to the schedule
push @schedule, $instruct;
# update each child with a new earliest execution time
if (my $children = $instruct->{children})
{
foreach (@$children)
{
my ($child, $latency) = @$_;
# update the earliest clock value this child can safely execute
my $earliest = $clock + $latency;
$child->{exeTime} = $earliest if $child->{exeTime} < $earliest;
print "\t\t$child->{exeTime},$child->{parents} $child->{inst}\n" if $debug;
# decrement parent count and add to ready queue if none remaining.
push @ready, $child if --$child->{parents} < 1;
}
delete $instruct->{children};
}
# update stall and mix values in the ready queue on each iteration
foreach my $ready (@ready)
{
# calculate how many instructions this would cause the just added instruction to stall.
$stall = $ready->{exeTime} - $clock;
$stall = 1 if $stall < 1;
# if using the same compute resource as the prior instruction then limit the throughput
if ($ready->{class} eq $instruct->{class})
{
$stall = $ready->{tput} if $stall < $ready->{tput};
}
# dual issue with a simple instruction (tput <= 2)
# can't dual issue two instructions that both load a constant
elsif ($ready->{dual} && !$instruct->{dual} && $instruct->{tput} <= 2 && !$instruct->{nodual} &&
$stall == 1 && $ready->{exeTime} <= $clock && !($ready->{const} && $instruct->{const}))
{
$stall = 0;
}
$ready->{stall} = $stall;
# add an instruction class mixing huristic that catches anything not handled by the stall
$ready->{mix} = $ready->{class} ne $instruct->{class} || 0;
$ready->{mix} = 2 if $ready->{mix} && $ready->{op} eq 'R2P';
}
# sort the ready list by stall time, mixing huristic, dependencies and line number
@ready = sort {
$a->{first} <=> $b->{first} ||
$a->{stall} <=> $b->{stall} ||
$a->{dualCnt} <=> $b->{dualCnt} ||
$b->{mix} <=> $a->{mix} ||
$b->{deps} <=> $a->{deps} ||
$a->{lineNum} <=> $b->{lineNum}
} @ready;
if ($debug)
{
print "\tf,ext,stl,duc,mix,dep,lin, inst\n";
printf "\t%d,%3s,%3s,%3s,%3s,%3s,%3s, %s\n", @{$_}{qw(f exeTime stall dualCnt mix deps lineNum inst)} foreach @ready;
}
foreach my $ready (@ready)
{
$ready->{dualCnt} = 0 if $ready->{dualCnt} && $ready->{stall} == 1;
}
}
my $out;
#$out .= "$_\n" foreach @comments;
$out .= join('', printCtrl($_->{ctrl}), @{$_}{qw(space inst comment)}, "\n") foreach @schedule;
return $out;
}