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' };
}
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};
- $instruction_handler->($ip, $state, $s, $c);
+ if(($ret = $instruction_handler->($ip, $state, $s, $c)))
+ {
+ # abort execution
+ last;
+ }
if($c->{isreturn})
{
{
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";
+sub get_constant($$)
+{
+ my ($progs, $g) = @_;
+ if($g->{int} == 0)
+ {
+ return undef;
+ }
+ elsif($g->{int} > 0 && $g->{int} < 16777216)
+ {
+ if($g->{int} < length $progs->{strings} && $g->{int} > 0)
+ {
+ return str($progs->{getstring}->($g->{int}));
+ }
+ else
+ {
+ return $g->{int} . "i";
+ }
+ }
+ else
+ {
+ return $g->{float};
+ }
+}
+
+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 $initializer = sub
{
my ($ofs) = @_;
- my $g = $progs->{globals}[$ofs]{v};
- if($g->{int} == 0)
- {
- }
- elsif($g->{int} < 16777216)
- {
- print " = $g->{int}%";
- if($g->{int} < length $progs->{strings} && $g->{int} > 0)
- {
- print " " . str($progs->{getstring}->($g->{int}));
- }
- }
- else
- {
- print " = $g->{float}!";
- }
+ my $g = get_constant($progs, $progs->{globals}[$ofs]{v});
+ print " = $g"
+ if defined $g;
};
printf INSTRUCTION_FORMAT, '', '', '.PARM_START';
my $p = $func->{parm_start};
for(0..($func->{numparms}-1))
{
- if($func->{parm_size}[$_] <= 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 $getname = sub
{
my ($ofs) = @_;
+ $ofs &= 0xFFFF;
return $override_locals{$ofs}
if exists $override_locals{$ofs};
- return $progs->{globaldef_byoffset}->($ofs)->{debugname};
+ my $def = $progs->{globaldef_byoffset}->($ofs);
+ return $def->{debugname};
};
my $operand = sub
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 $t = $ip + $s->{$j};
$come_from{$t}{$ip} = $c->{isconditional};
}
+
+ return 0;
};
my $ipprev = undef;
{
my ($progs, $func) = @_;
+
return
if $func->{first_statement} < 0; # builtin
use constant WATCHME_W => 2;
use constant WATCHME_X => 4;
use constant WATCHME_T => 8;
- my %watchme = map { $_ => WATCHME_X } ($p .. ($func->{parm_start} + $func->{locals} - 1));
+ my %watchme = map { $_ => WATCHME_X } ($func->{parm_start} .. ($func->{parm_start} + $func->{locals} - 1));
- for($progs->{temps})
+ for(keys %{$progs->{temps}})
{
$watchme{$_} = WATCHME_T | WATCHME_X
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;
}
}
+
+ return 0;
};
for(keys %watchme)
for(keys %watchme)
{
- $watchme{$_} = { flags => $watchme{$_}, valid => 0 };
+ $watchme{$_} = {
+ flags => $watchme{$_},
+ valid => [0, undef, undef]
+ };
+ }
+
+ # mark parameters as initialized
+ for($func->{parm_start} .. ($p-1))
+ {
+ $watchme{$_}{valid} = [1, undef, undef]
+ if defined $watchme{$_};
+ }
+ # an initial run of STORE instruction is for receiving extra parameters
+ # (beyond 8). Only possible if the function is declared as having 8 params.
+ # Extra parameters behave otherwise like temps, but are initialized at
+ # startup.
+ for($func->{first_statement} .. (@{$progs->{statements}}-1))
+ {
+ my $s = $progs->{statements}[$_];
+ if($s->{op} eq 'STORE_V')
+ {
+ $watchme{$s->{a}}{valid} = [1, undef, undef]
+ if defined $watchme{$s->{a}};
+ $watchme{$s->{a}+1}{valid} = [1, undef, undef]
+ if defined $watchme{$s->{a}+1};
+ $watchme{$s->{a}+2}{valid} = [1, undef, undef]
+ if defined $watchme{$s->{a}+2};
+ }
+ elsif($s->{op} =~ /^STORE_/)
+ {
+ $watchme{$s->{a}}{valid} = [1, undef, undef]
+ if defined $watchme{$s->{a}};
+ }
+ else
+ {
+ last;
+ }
}
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)
+ {
+ 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] < 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 temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
+ ++$warned{$ip}{$_};
+ }
}
- elsif($valid < 0)
+ else
{
- print "; Use of temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
- ++$warned{$ip}{$_};
+ # 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')
{
}
if($c->{iscall})
{
- # invalidate temps
- for(values %$state)
+ # builtin calls may clobber stuff
+ my $func = $s->{a};
+ my $funcid = $progs->{globals}[$func]{v}{int};
+ my $funcobj = $progs->{functions}[$funcid];
+ if(!$funcobj || $funcobj->{first_statement} >= 0)
{
- if($_->{flags} & WATCHME_T)
+ # invalidate temps
+ for(values %$state)
{
- $_->{valid} = -1;
+ if($_->{flags} & WATCHME_T)
+ {
+ $_->{valid} = [-1, undef, undef];
+ }
}
}
+ else # builtin
+ {
+ 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 %offsets_saved = ();
for(@{$p{globaldefs}})
{
+ my $type = $_->{type};
+ my $name = $p{getstring}->($_->{s_name});
next
- unless $_->{type}{save};
- next
- unless $p{getstring}->($_->{s_name}) eq "";
+ unless $type->{save} or $name ne "";
for my $i(0..(typesize($_->{type}{type})-1))
{
++$offsets_saved{$_->{ofs}+$i};
}
}
+ my %offsets_initialized = ();
+ for(0..(@{$p{globals}}-1))
+ {
+ if($p{globals}[$_]{v}{int})
+ {
+ ++$offsets_initialized{$_};
+ }
+ }
my %istemp = ();
+ my %isconst = ();
for(0..(@{$p{globals}}-1))
{
next
- if $offsets_saved{$_};
- $istemp{$_} = 1;
+ if $_ < @{(DEFAULTGLOBALS)};
+ ++$isconst{$_}
+ if !$offsets_saved{$_} and $offsets_initialized{$_};
+ ++$istemp{$_}
+ if !$offsets_saved{$_} and !$offsets_initialized{$_};
}
- $p{temps} = [keys %istemp];
+ $p{temps} = \%istemp;
+ $p{consts} = \%isconst;
print STDERR "Naming...\n";
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}})
{
}
for(0..(@{$p{globals}}-1))
{
- $globaldefs[$_] //= { ofs => $_, s_name => undef, debugname => ($istemp{$_} ? "<temp>" : "<nodef>") . "\@$_" },
+ $globaldefs[$_] //= {
+ ofs => $_,
+ s_name => undef,
+ debugname => undef
+ };
}
my %globaldefs = ();
- for(@{$p{globaldefs}})
+ for(@globaldefs)
{
- $_->{debugname} = "<anon>\@$_->{ofs}"
- if $_->{debugname} eq "";
+ if(!defined $_->{debugname})
+ {
+ if($istemp{$_->{ofs}})
+ {
+ $_->{debugname} = "temp_$_->{ofs}";
+ }
+ elsif($isconst{$_->{ofs}})
+ {
+ $_->{debugname} = "(" . get_constant(\%p, $p{globals}[$_->{ofs}]{v}) . ")";
+ }
+ else
+ {
+ $_->{debugname} = "global_$_->{ofs}";
+ }
+ }
++$globaldefs{$_->{debugname}};
}
- for(@{$p{globaldefs}})
+ for(@globaldefs)
{
next
if $globaldefs{$_->{debugname}} <= 1;
+ print "Not unique: $_->{debugname} at $_->{ofs}\n";
$_->{debugname} .= "\@$_->{ofs}";
}
$p{globaldef_byoffset} = sub
{
my ($ofs) = @_;
- if($ofs < @{(DEFAULTGLOBALS)})
+ $ofs &= 0xFFFF;
+ if($ofs >= 0 && $ofs < @{(DEFAULTGLOBALS)})
{
return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
}
my $def = $globaldefs[$ofs];
+ return $def;
};
# functions
# what do we want to do?
my $checkfunc = \&find_uninitialized_locals;
+ #my $checkfunc = \&disassemble_function;
for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
{
$checkfunc->(\%p, $_);
projects / xonotic / xonotic.git / blobdiff