use strict;
use warnings;
+use Digest::SHA;
sub id()
{
}
if($op =~ /^DONE$|^RETURN$/)
{
- return { a => 'inglobal', isreturn => 1 };
+ return { a => 'inglobalvec', isreturn => 1 };
}
return { a => 'inglobal', b => 'inglobal', c => 'outglobal' };
}
int => ['V', 4, signed 32],
ushort => ['v', 2, id],
short => ['v', 2, signed 16],
- opcode => ['v', 2, sub { OPCODE_E->[$_[0]] or die "Invalid opcode: $_[0]"; }],
+ opcode => ['v', 2, sub { OPCODE_E->[$_[0]] or do { warn "Invalid opcode: $_[0]"; "INVALID#$_[0]"; }; }],
float => ['f', 4, id],
uchar8 => ['a8', 8, sub { [unpack 'C8', $_[0]] }],
global => ['i', 4, sub { { int => $_[0], float => unpack "f", pack "L", $_[0] }; }],
return $out[0];
}
+sub nfa_default_state_checker()
+{
+ my %seen;
+ return sub
+ {
+ my ($ip, $state) = @_;
+ return $seen{"$ip $state"}++;
+ };
+}
+
sub run_nfa($$$$$$)
{
- my ($progs, $ip, $state, $copy_handler, $state_hasher, $instruction_handler) = @_;
- my %seen = ();
+ my ($progs, $ip, $state, $copy_handler, $state_checker, $instruction_handler) = @_;
my $statements = $progs->{statements};
no warnings 'recursion';
my ($ip, $state) = @_;
+ my $ret = 0;
for(;;)
{
- my $statestr = $state_hasher->($state);
- return
- if $seen{"$ip:$statestr"}++;
+ return $ret
+ if $state_checker->($ip, $state);
my $s = $statements->[$ip];
my $c = checkop $s->{op};
- if($instruction_handler->($ip, $state, $s, $c))
+ if(($ret = $instruction_handler->($ip, $state, $s, $c)))
{
# abort execution
last;
{
if($c->{isconditional})
{
- $nfa->($ip+1, $copy_handler->($state));
- $ip += $s->{$c->{isjump}};
+ if(rand 2)
+ {
+ if(($ret = $nfa->($ip+$s->{$c->{isjump}}, $copy_handler->($state))) < 0)
+ {
+ last;
+ }
+ $ip += 1;
+ }
+ else
+ {
+ $nfa->($ip+1, $copy_handler->($state));
+ $ip += $s->{$c->{isjump}};
+ }
}
else
{
$ip += 1;
}
}
+
+ return $ret;
};
$nfa->($ip, $copy_handler->($state));
}
}
-use constant PRE_MARK_STATEMENT => "\e[1m";
-use constant POST_MARK_STATEMENT => "\e[m";
-use constant PRE_MARK_OPERAND => "\e[41m";
-use constant POST_MARK_OPERAND => "\e[49m";
+use constant PRE_MARK_STATEMENT => "";
+use constant POST_MARK_STATEMENT => "";
+use constant PRE_MARK_OPERAND => "*** ";
+use constant POST_MARK_OPERAND => " ***";
use constant INSTRUCTION_FORMAT => "%8s %3s | %-12s ";
use constant OPERAND_FORMAT => "%s";
my $p = $func->{parm_start};
for(0..($func->{numparms}-1))
{
- $override_locals{$p} //= "argv[$_]";
+ $override_locals{$p} //= "argv_$_";
for my $comp(0..($func->{parm_size}[$_]-1))
{
- $override_locals{$p} //= "argv[$_][$comp]";
+ $override_locals{$p} //= "argv_$_\[$comp]";
++$p;
}
printf INSTRUCTION_FORMAT, '', '', '.ARG';
- printf OPERAND_FORMAT, "argv[$_]";
+ printf OPERAND_FORMAT, "argv_$_";
print OPERAND_SEPARATOR;
printf OPERAND_FORMAT, $func->{parm_size}[$_];
print INSTRUCTION_SEPARATOR;
{
next
if exists $override_locals{$_};
- $override_locals{$_} = "<local>\@$_";
+ $override_locals{$_} = "local_$_";
printf INSTRUCTION_FORMAT, '', '', '.LOCAL';
- printf OPERAND_FORMAT, "<local>\@$_";
+ printf OPERAND_FORMAT, "local_$_";
$initializer->($_);
print INSTRUCTION_SEPARATOR;
}
my %statements = ();
my %come_from = ();
- run_nfa $progs, $func->{first_statement}, "", id, id,
+ run_nfa $progs, $func->{first_statement}, "", id, nfa_default_state_checker,
sub
{
my ($ip, $state, $s, $c) = @_;
{
my ($progs, $func) = @_;
+
return
if $func->{first_statement} < 0; # builtin
if not exists $watchme{$_};
}
- run_nfa $progs, $func->{first_statement}, "", id, id,
+ my %write_places = ();
+ run_nfa $progs, $func->{first_statement}, "", id, nfa_default_state_checker,
sub
{
my ($ip, $state, $s, $c) = @_;
elsif($type eq 'outglobal')
{
$watchme{$ofs} |= WATCHME_W;
+ $write_places{$ip}{$_} = [$ofs]
+ if $watchme{$ofs} & WATCHME_X;
}
elsif($type eq 'outglobalvec')
{
$watchme{$ofs} |= WATCHME_W;
$watchme{$ofs+1} |= WATCHME_W;
$watchme{$ofs+2} |= WATCHME_W;
+ my @l = grep { $watchme{$_} & WATCHME_X } $ofs .. ($ofs+2);
+ $write_places{$ip}{$_} = \@l
+ if @l;
}
}
{
$watchme{$_} = {
flags => $watchme{$_},
- valid => 0
+ valid => [0, undef, undef]
};
}
# mark parameters as initialized
for($func->{parm_start} .. ($p-1))
{
- $watchme{$_}{valid} = 1
+ $watchme{$_}{valid} = [1, undef, undef]
if defined $watchme{$_};
}
# an initial run of STORE instruction is for receiving extra parameters
my $s = $progs->{statements}[$_];
if($s->{op} eq 'STORE_V')
{
- $watchme{$s->{a}}{valid} = 1
+ $watchme{$s->{a}}{valid} = [1, undef, undef]
if defined $watchme{$s->{a}};
- $watchme{$s->{a}+1}{valid} = 1
+ $watchme{$s->{a}+1}{valid} = [1, undef, undef]
if defined $watchme{$s->{a}+1};
- $watchme{$s->{a}+2}{valid} = 1
+ $watchme{$s->{a}+2}{valid} = [1, undef, undef]
if defined $watchme{$s->{a}+2};
}
elsif($s->{op} =~ /^STORE_/)
{
- $watchme{$s->{a}}{valid} = 1
+ $watchme{$s->{a}}{valid} = [1, undef, undef]
if defined $watchme{$s->{a}};
}
else
}
my %warned = ();
+ my %ip_seen = ();
run_nfa $progs, $func->{first_statement}, \%watchme,
sub {
my ($h) = @_;
return { map { $_ => { %{$h->{$_}} } } keys %$h };
},
sub {
- my ($h) = @_;
- return join ' ', map { $h->{$_}->{valid}; } sort keys %$h;
+ my ($ip, $state) = @_;
+
+ my $s = $ip_seen{$ip};
+ if($s)
+ {
+ # if $state is stronger or equal to $s, return 1
+
+ for(keys %$state)
+ {
+ if($state->{$_}{valid}[0] < $s->{$_})
+ {
+ # The current state is LESS valid than the previously run one. We NEED to run this.
+ # The saved state can safely become the intersection [citation needed].
+ for(keys %$state)
+ {
+ $s->{$_} = $state->{$_}{valid}[0]
+ if $state->{$_}{valid}[0] < $s->{$_};
+ }
+ return 0;
+ }
+ }
+ # if we get here, $state is stronger or equal. No need to try it.
+ return 1;
+ }
+ else
+ {
+ # Never seen this IP yet.
+ $ip_seen{$ip} = { map { ($_ => $state->{$_}{valid}[0]); } keys %$state };
+ return 0;
+ }
},
sub {
my ($ip, $state, $s, $c) = @_;
my $op = $s->{op};
+
+ my $return_hack = $c->{isreturn} // 0;
+
for(qw(a b c))
{
my $type = $c->{$_};
my $read = sub
{
my ($ofs) = @_;
+ ++$return_hack
+ if $return_hack;
return
if not exists $state->{$ofs};
my $valid = $state->{$ofs}{valid};
- if($valid == 0)
+ if($valid->[0] == 0)
{
- print "; Use of uninitialized value $ofs in $func->{debugname} at $ip.$_\n";
- ++$warned{$ip}{$_};
+ if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) # fteqcc logicops cause this
+ {
+ print "; Use of uninitialized value $ofs in $func->{debugname} at $ip.$_\n";
+ ++$warned{$ip}{$_};
+ }
}
- elsif($valid < 0)
+ elsif($valid->[0] < 0)
{
- print "; Use of temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
- ++$warned{$ip}{$_};
+ if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) # fteqcc logicops cause this
+ {
+ print "; Use of temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
+ ++$warned{$ip}{$_};
+ }
+ }
+ else
+ {
+ # it's VALID
+ if(defined $valid->[1])
+ {
+ delete $write_places{$valid->[1]}{$valid->[2]};
+ }
}
};
my $write = sub
{
my ($ofs) = @_;
- $state->{$ofs}{valid} = 1
+ $state->{$ofs}{valid} = [1, $ip, $_]
if exists $state->{$ofs};
};
if($type eq 'inglobal' || $type eq 'inglobalfunc')
{
- if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
- {
- $read->($ofs);
- }
+ $read->($ofs);
}
elsif($type eq 'inglobalvec')
{
- if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
- {
- $read->($ofs);
- $read->($ofs+1);
- $read->($ofs+2);
- }
+ $read->($ofs);
+ $read->($ofs+1);
+ $read->($ofs+2);
}
elsif($type eq 'outglobal')
{
my $func = $s->{a};
my $funcid = $progs->{globals}[$func]{v}{int};
my $funcobj = $progs->{functions}[$funcid];
- if($funcobj->{first_statement} >= 0)
+ if(!$funcobj || $funcobj->{first_statement} >= 0)
{
# invalidate temps
for(values %$state)
{
if($_->{flags} & WATCHME_T)
{
- $_->{valid} = -1;
+ $_->{valid} = [-1, undef, undef];
}
}
}
- elsif($funcobj->{debugname} =~ /(^|:)error$/)
+ else # builtin
{
- return 1;
+ my $def = $progs->{globaldef_byoffset}->($func);
+ return 1
+ if $def->{debugname} eq 'error';
}
}
return 0;
};
+
+ for my $ip(keys %write_places)
+ {
+ for my $operand(keys %{$write_places{$ip}})
+ {
+ # TODO verify it
+ my %left = map { $_ => 1 } @{$write_places{$ip}{$operand}};
+ my $isread = 0;
+
+ my %writeplace_seen = ();
+ run_nfa $progs, $ip+1, \%left,
+ sub
+ {
+ return { %{$_[0]} };
+ },
+ sub
+ {
+ my ($ip, $state) = @_;
+ return $writeplace_seen{"$ip " . join " ", sort keys %$state}++;
+ },
+ sub
+ {
+ my ($ip, $state, $s, $c) = @_;
+ for(qw(a b c))
+ {
+ my $type = $c->{$_};
+ next
+ unless defined $type;
+
+ my $ofs = $s->{$_};
+ if($type eq 'inglobal' || $type eq 'inglobalfunc')
+ {
+ if($state->{$ofs})
+ {
+ $isread = 1;
+ return -1; # exit TOTALLY
+ }
+ }
+ elsif($type eq 'inglobalvec')
+ {
+ if($state->{$ofs} || $state->{$ofs+1} || $state->{$ofs+2})
+ {
+ $isread = 1;
+ return -1; # exit TOTALLY
+ }
+ }
+ elsif($type eq 'outglobal')
+ {
+ delete $state->{$ofs};
+ return 1
+ if !%$state;
+ }
+ elsif($type eq 'outglobalvec')
+ {
+ delete $state->{$ofs};
+ delete $state->{$ofs+1};
+ delete $state->{$ofs+2};
+ return 1
+ if !%$state;
+ }
+ }
+ return 0;
+ };
+
+ if(!$isread)
+ {
+ print "; Value is never used in $func->{debugname} at $ip.$operand\n";
+ ++$warned{$ip}{$operand};
+ }
+ }
+ }
disassemble_function($progs, $func, \%warned)
if keys %warned;
}
use constant DEFAULTGLOBALS => [
- "<OFS_NULL>",
- "<OFS_RETURN>",
- "<OFS_RETURN>[1]",
- "<OFS_RETURN>[2]",
- "<OFS_PARM0>",
- "<OFS_PARM0>[1]",
- "<OFS_PARM0>[2]",
- "<OFS_PARM1>",
- "<OFS_PARM1>[1]",
- "<OFS_PARM1>[2]",
- "<OFS_PARM2>",
- "<OFS_PARM2>[1]",
- "<OFS_PARM2>[2]",
- "<OFS_PARM3>",
- "<OFS_PARM3>[1]",
- "<OFS_PARM3>[2]",
- "<OFS_PARM4>",
- "<OFS_PARM4>[1]",
- "<OFS_PARM4>[2]",
- "<OFS_PARM5>",
- "<OFS_PARM5>[1]",
- "<OFS_PARM5>[2]",
- "<OFS_PARM6>",
- "<OFS_PARM6>[1]",
- "<OFS_PARM6>[2]",
- "<OFS_PARM7>",
- "<OFS_PARM7>[1]",
- "<OFS_PARM7>[2]"
+ "OFS_NULL",
+ "OFS_RETURN",
+ "OFS_RETURN[1]",
+ "OFS_RETURN[2]",
+ "OFS_PARM0",
+ "OFS_PARM0[1]",
+ "OFS_PARM0[2]",
+ "OFS_PARM1",
+ "OFS_PARM1[1]",
+ "OFS_PARM1[2]",
+ "OFS_PARM2",
+ "OFS_PARM2[1]",
+ "OFS_PARM2[2]",
+ "OFS_PARM3",
+ "OFS_PARM3[1]",
+ "OFS_PARM3[2]",
+ "OFS_PARM4",
+ "OFS_PARM4[1]",
+ "OFS_PARM4[2]",
+ "OFS_PARM5",
+ "OFS_PARM5[1]",
+ "OFS_PARM5[2]",
+ "OFS_PARM6",
+ "OFS_PARM6[1]",
+ "OFS_PARM6[2]",
+ "OFS_PARM7",
+ "OFS_PARM7[1]",
+ "OFS_PARM7[2]"
];
sub defaultglobal($)
my @globaldefs = ();
for(@{$p{globaldefs}})
{
- $_->{debugname} = $p{getstring}->($_->{s_name});
+ my $s = $p{getstring}->($_->{s_name});
+ $_->{debugname} //= "_$s"
+ if length $s;
}
for(@{$p{globaldefs}})
{
$globaldefs[$_->{ofs}] //= $_
- if $_->{debugname} ne "";
+ if defined $_->{debugname};
}
for(@{$p{globaldefs}})
{
$globaldefs[$_] //= {
ofs => $_,
s_name => undef,
- debugname => ""
+ debugname => undef
};
}
my %globaldefs = ();
for(@globaldefs)
{
- if($_->{debugname} eq "")
+ if(!defined $_->{debugname})
{
if($istemp{$_->{ofs}})
{
- $_->{debugname} = "<temp>\@$_->{ofs}";
+ $_->{debugname} = "temp_$_->{ofs}";
}
elsif($isconst{$_->{ofs}})
{
- $_->{debugname} = "<" . get_constant(\%p, $p{globals}[$_->{ofs}]{v}) . ">\@$_->{ofs}";
+ $_->{debugname} = "(" . get_constant(\%p, $p{globals}[$_->{ofs}]{v}) . ")";
}
else
{
- $_->{debugname} = "<nodef>\@$_->{ofs}";
+ $_->{debugname} = "global_$_->{ofs}";
}
}
++$globaldefs{$_->{debugname}};
{
next
if $globaldefs{$_->{debugname}} <= 1;
+ print "Not unique: $_->{debugname} at $_->{ofs}\n";
$_->{debugname} .= "\@$_->{ofs}";
}
$p{globaldef_byoffset} = sub
projects / xonotic / xonotic.git / blobdiff