mirror of https://github.com/ctm/syn68k.git
358 lines
8.1 KiB
Perl
Executable File
358 lines
8.1 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
sub mem_range
|
|
{
|
|
local ($base, $offset, $size) = @_;
|
|
local ($result, $real_size);
|
|
|
|
$real_size = 1 if ($size eq "b");
|
|
$real_size = 2 if ($size eq "w");
|
|
$real_size = 4 if ($size eq "l");
|
|
|
|
foreach (0 .. $real_size-1)
|
|
{
|
|
$result .= $base . ($offset + $_) . ' ';
|
|
}
|
|
|
|
chop $result;
|
|
return $result;
|
|
}
|
|
|
|
sub break_it_down
|
|
{
|
|
local($operand, $size) = @_;
|
|
local ($result);
|
|
|
|
# No operand
|
|
if (!$operand)
|
|
{
|
|
return "";
|
|
}
|
|
|
|
# _cpu_state+offset
|
|
if ($operand =~ /^_cpu_state(\+\d+)?$/)
|
|
{
|
|
return &mem_range ("mem_cs_", $1, $size);
|
|
}
|
|
|
|
# _cpu_state...
|
|
if ($operand =~ /^_cpu_state/)
|
|
{
|
|
return "mem_cs_.*";
|
|
}
|
|
|
|
# %reg
|
|
if ($operand =~ /^%(.*)$/)
|
|
{
|
|
die "No info for $1, $size"
|
|
if (!defined ($register_info{$1, $size}));
|
|
return $register_info{$1, $size};
|
|
}
|
|
|
|
# Memory ref
|
|
if ($operand =~ /^[_A-Za-z]/)
|
|
{
|
|
return "mem_.*";
|
|
}
|
|
|
|
# offset(%reg)
|
|
if ($operand =~ /^([^%()]*)\(%(e[a-z][a-z])\)$/)
|
|
{
|
|
return &mem_range ("mem_code_", $1, $size) if ($2 eq 'esi');
|
|
return &mem_range ("mem_bp_", $1, $size) if ($2 eq 'ebp');
|
|
|
|
return "mem_.*";
|
|
}
|
|
|
|
# ($reg, $reg, n)
|
|
if ($operand =~ /$\(%e[a-z][a-z],%e[a-z][a-z],[24])\)/)
|
|
{
|
|
return ("mem_.* ");
|
|
}
|
|
|
|
# ($reg, $reg)
|
|
if ($operand =~ /$\(%e[a-z][a-z],%e[a-z][a-z])\)/)
|
|
{
|
|
return ("mem_.*");
|
|
}
|
|
|
|
# $constant
|
|
if ($operand =~ /^\$.*$/)
|
|
{
|
|
return "";
|
|
}
|
|
|
|
# offset(,$reg,const)
|
|
if ($operand =~ /^(-?\d+)?\(,%e[a-z][a-z],\d+\)$/)
|
|
{
|
|
return "mem_.*";
|
|
}
|
|
|
|
die "Unrecognized operand $operand\n";
|
|
}
|
|
|
|
# Recognize an instruction. Returns (inputs, outputs, latency).
|
|
sub recognize
|
|
{
|
|
local ($insn) = @_;
|
|
local ($operand_regexp) = '((.*\(.*\).*)|([^\(\)]+))';
|
|
local ($mnem, @operands);
|
|
local ($inputs, $outputs, $latency, $reg);
|
|
local ($no_union_inputs);
|
|
|
|
$_ = $insn;
|
|
$no_union_inputs = 0;
|
|
|
|
# First, grab the mnemonic and the operand(s)
|
|
grab:
|
|
{
|
|
if (/^\t([a-z]+) $operand_regexp,\s*$operand_regexp$/)
|
|
{
|
|
$mnem = $1;
|
|
@operands = ($2, $5);
|
|
|
|
# print "$insn\n";
|
|
# print " Operand 1: $operands[0] Operand 2: $operands[1]\n";
|
|
last grab;
|
|
}
|
|
|
|
elsif (/^\t([a-z]+) $operand_regexp$/)
|
|
{
|
|
$mnem = $1;
|
|
@operands = ($2);
|
|
# print "$insn\n";
|
|
# print " Operand: $2\n";
|
|
last grab;
|
|
}
|
|
|
|
elsif (/^\t([a-z]+)$/)
|
|
{
|
|
$mnem = $1;
|
|
# print " No operands\n";
|
|
last grab;
|
|
}
|
|
|
|
elsif (/^([^\t]|\t\.)/)
|
|
{
|
|
last grab;
|
|
}
|
|
|
|
die "Unable to figure out $insn\n";
|
|
}
|
|
|
|
# Barrier if we couldn't find the mnemonic.
|
|
return (".*", ".*", 1) if (!$mnem);
|
|
|
|
$inputs .= "eip "; # everyone takes program counter as input
|
|
|
|
# Find registers in parens and add to inputs
|
|
foreach $reg (keys %regs)
|
|
{
|
|
if (/\([^\)]*%$reg[^\)]*\)/)
|
|
{
|
|
$inputs .= &break_it_down ("%$reg", "l") . " ";
|
|
}
|
|
}
|
|
|
|
|
|
$_ = $mnem;
|
|
|
|
the_switch:
|
|
{
|
|
local ($op, $len, $srclen, $dstlen);
|
|
|
|
# Easy binops
|
|
if (($op, $len) = /^(adc|add|cmp|sbb|sub|test|and|or|xor)([bwl])$/) {
|
|
die if (@operands != 2);
|
|
$inputs .= "reg_ccc " if ($op = /^adc/);
|
|
$outputs .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc ";
|
|
$inputs .= &break_it_down ($operands[0], $len) . " ";
|
|
$inputs .= &break_it_down ($operands[1], $len) . " ";
|
|
if ($op !~ /^cmp|test$/)
|
|
{
|
|
$outputs .= &break_it_down ($operands[1], $len) . " ";
|
|
}
|
|
last the_switch;
|
|
}
|
|
|
|
# Easy uniops
|
|
if (($op, $len) = /^(dec|inc|neg|not|bswap)([bwl])?$/) {
|
|
die if (@operands != 1);
|
|
$len = "l" if (!$len);
|
|
$outputs .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc "
|
|
if ($op =~ /^neg$/);
|
|
$outputs .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp "
|
|
if ($op =~ /^dec|inc/);
|
|
$inputs .= &break_it_down ($operands[0], $len) . " ";
|
|
$outputs .= &break_it_down ($operands[0], $len) . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# Set
|
|
if (($op) = /^(set.*)$/) {
|
|
die if (@operands != 1);
|
|
$inputs .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc ";
|
|
$outputs .= &break_it_down ($operands[0], "b") . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# When we jmp to the next instruction, note that nearly everything
|
|
# is dead.
|
|
if ((/^jmp$/) && (@operands == 1) && ($operands[0] =~ /^\*%edi$/)) {
|
|
$inputs .= "reg_di_.* ";
|
|
$outputs .= "eip reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc "
|
|
. "reg_a_.* reg_b_.* reg_c_.* reg_d_.* reg_di_.* ";
|
|
$no_union_inputs = 1;
|
|
last the_switch;
|
|
}
|
|
|
|
# Barriers
|
|
if (/^[j.].*|call|ret|leave$/) {
|
|
$inputs .= ".* ";
|
|
$outputs .= "eip "; # program counter
|
|
last the_switch;
|
|
}
|
|
|
|
# Shifts
|
|
if (($op, $len) = /^(rc|ro|sa|sh)[rl]([bwl])$/) {
|
|
die if (@operands != 2);
|
|
$inputs .= "reg_ccc "
|
|
if ($op =~ /^rc/); #FIXME - not sure if this is right
|
|
$outputs .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc ";
|
|
$inputs .= &break_it_down ($operands[0], "b") . " ";
|
|
$inputs .= &break_it_down ($operands[1], $len) . " ";
|
|
$outputs .= &break_it_down ($operands[1], $len) . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# Divide
|
|
if (($op, $len) = /^(div|idiv|mul|imul)([bwl])$/) {
|
|
local ($inout);
|
|
die if (@operands != 1 && @operands != 2);
|
|
$inout .= "reg_cco reg_ccs reg_ccz reg_cca reg_ccp reg_ccc ";
|
|
if (@operands == 1)
|
|
{
|
|
if ($len eq "b")
|
|
{
|
|
$inout .= &break_it_down ("%ax", "w") . " ";
|
|
}
|
|
elsif ($len eq "w")
|
|
{
|
|
$inout .= (&break_it_down ("%ax", "w") . " "
|
|
. &break_it_down ("%dx", "w") . " ");
|
|
}
|
|
elsif ($len eq "l")
|
|
{
|
|
$inout .= (&break_it_down ("%eax", "l") . " "
|
|
. &break_it_down ("%edx", "l") . " ");
|
|
}
|
|
}
|
|
else
|
|
{
|
|
$inout .= ".* "; # be paranoid, who cares.
|
|
}
|
|
$inputs .= $inout;
|
|
$outputs .= $inout;
|
|
last the_switch;
|
|
}
|
|
|
|
# LEA and MOV
|
|
if (($op, $len) = /^(lea|mov)([bwl])$/) {
|
|
die if (@operands != 2);
|
|
if ($op eq "mov")
|
|
{
|
|
$inputs .= &break_it_down ($operands[0], $len) . " ";
|
|
}
|
|
$outputs .= &break_it_down ($operands[1], $len) . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# Move and extend
|
|
if (($op, $srclen, $dstlen) = /^(mov[sz])([bwl])([bwl])$/) {
|
|
die if (@operands != 2);
|
|
$inputs .= &break_it_down ($operands[0], $srclen) . " ";
|
|
$outputs .= &break_it_down ($operands[1], $dstlen) . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# Push and pop
|
|
if (($op, $len) = /^(push|pop)([bwl])$/) {
|
|
die if (@operands != 1);
|
|
$inputs .= &break_it_down ("%esp", "l") . " ";
|
|
$outputs .= &break_it_down ("%esp", "l") . " ";
|
|
if ($op eq "push")
|
|
{
|
|
$inputs .= &break_it_down ($operands[0], $len) . " ";
|
|
$outputs .= &break_it_down ("(%esp)", $len) . " ";
|
|
}
|
|
else
|
|
{
|
|
$inputs .= &break_it_down ("(%esp)", $len) . " ";
|
|
$outputs .= &break_it_down ($operands[0], $len) . " ";
|
|
}
|
|
last the_switch;
|
|
}
|
|
|
|
# LODS
|
|
# if (($op, $len) = /^(lods)([bwl])$/) {
|
|
# die if (@operands != 0);
|
|
# $inputs .= &break_it_down ("%esi", "l") . " ";
|
|
# $outputs .= &break_it_down ("%esi", "l") . " ";
|
|
# $inputs .= &break_it_down ("(%esi)", $len) . " ";
|
|
# $outputs .= &break_it_down ("%eax", $len) . " ";
|
|
# $inputs .= "reg_ccd";
|
|
# last the_switch;
|
|
# }
|
|
|
|
# CWTL
|
|
if (($op, $len) = /^(cwt)(l)$/) {
|
|
die if (@operands != 0);
|
|
$inputs .= &break_it_down ("%ax", "w") . " ";
|
|
$outputs .= &break_it_down ("%eax", "l") . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
# CLTD
|
|
if (/^cltd$/) {
|
|
die if (@operands != 0);
|
|
$inputs .= &break_it_down ("%eax", "l") . " ";
|
|
$outputs .= &break_it_down ("%edx", "l") . " ";
|
|
last the_switch;
|
|
}
|
|
|
|
die "Unrecognized instruction $insn\n";
|
|
}
|
|
|
|
if (!$no_union_inputs) {
|
|
$inputs .= join (' ', grep (/\*/, split (' ', $outputs))) . " ";
|
|
}
|
|
|
|
chop $inputs;
|
|
chop $outputs;
|
|
$inputs = &union ($inputs);
|
|
$outputs = &union ($outputs);
|
|
# print "$insn\n Inputs: $inputs\n Outputs: $outputs\n";
|
|
return ($inputs, $outputs, 2);
|
|
}
|
|
|
|
sub compute_info
|
|
{
|
|
local($lineno) = @_;
|
|
|
|
($inputs[$lineno], $outputs[$lineno], $latency[$lineno]) =
|
|
&recognize ($lines[$lineno]);
|
|
}
|
|
|
|
open (REG, "reg") || die;
|
|
|
|
while (<REG>)
|
|
{
|
|
local ($reg, $len, $info);
|
|
chop;
|
|
($reg, $len, $info) = split (/\t+/);
|
|
$register_info{$reg, $len} = $info;
|
|
$regs{$reg}++;
|
|
}
|
|
|
|
close (REG);
|