X-Git-Url: https://git.xonotic.org/?a=blobdiff_plain;f=misc%2Ftools%2Fprogs-analyzer.pl;h=0a0593b6c0d8c6e7977602cf24a404321dc27dd3;hb=b437b2272b1f3f1fe038974b12d7e538f573567f;hp=c46e98e567f89bba0ecee35dce5d62d1740a7849;hpb=a92d60dfe1308112ce664cc4c8da48a4fc30edff;p=xonotic%2Fxonotic.git diff --git a/misc/tools/progs-analyzer.pl b/misc/tools/progs-analyzer.pl index c46e98e5..0a0593b6 100644 --- a/misc/tools/progs-analyzer.pl +++ b/misc/tools/progs-analyzer.pl @@ -1,5 +1,6 @@ use strict; use warnings; +use Digest::SHA; sub id() { @@ -117,7 +118,7 @@ sub checkop($) } if($op =~ /^DONE$|^RETURN$/) { - return { a => 'inglobal', isreturn => 1 }; + return { a => 'inglobalvec', isreturn => 1 }; } return { a => 'inglobal', b => 'inglobal', c => 'outglobal' }; } @@ -226,10 +227,19 @@ sub parse_section($$$$$) 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}; @@ -239,17 +249,21 @@ sub run_nfa($$$$$$) 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}) { @@ -259,8 +273,19 @@ sub run_nfa($$$$$$) { 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 { @@ -272,15 +297,41 @@ sub run_nfa($$$$$$) $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"; @@ -303,22 +354,9 @@ sub disassemble_function($$;$) 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'; @@ -333,17 +371,14 @@ sub disassemble_function($$;$) 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; @@ -352,10 +387,10 @@ sub disassemble_function($$;$) { next if exists $override_locals{$_}; - $override_locals{$_} = "\@$_"; + $override_locals{$_} = "local_$_"; printf INSTRUCTION_FORMAT, '', '', '.LOCAL'; - printf OPERAND_FORMAT, "\@$_"; + printf OPERAND_FORMAT, "local_$_"; $initializer->($_); print INSTRUCTION_SEPARATOR; } @@ -363,9 +398,11 @@ sub disassemble_function($$;$) 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 @@ -408,7 +445,7 @@ sub disassemble_function($$;$) 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) = @_; @@ -419,6 +456,8 @@ sub disassemble_function($$;$) my $t = $ip + $s->{$j}; $come_from{$t}{$ip} = $c->{isconditional}; } + + return 0; }; my $ipprev = undef; @@ -483,6 +522,7 @@ sub find_uninitialized_locals($$) { my ($progs, $func) = @_; + return if $func->{first_statement} < 0; # builtin @@ -498,15 +538,16 @@ sub find_uninitialized_locals($$) 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) = @_; @@ -530,14 +571,21 @@ sub find_uninitialized_locals($$) 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) @@ -551,22 +599,90 @@ sub find_uninitialized_locals($$) 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->{$_}; @@ -578,42 +694,52 @@ sub find_uninitialized_locals($$) 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') { @@ -628,50 +754,136 @@ sub find_uninitialized_locals($$) } 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 => [ - "", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[2]", - "", - "[1]", - "[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($) @@ -721,23 +933,36 @@ sub parse_progs($) 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"; @@ -745,12 +970,14 @@ sub parse_progs($) 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}}) { @@ -758,29 +985,49 @@ sub parse_progs($) } for(0..(@{$p{globals}}-1)) { - $globaldefs[$_] //= { ofs => $_, s_name => undef, debugname => ($istemp{$_} ? "" : "") . "\@$_" }, + $globaldefs[$_] //= { + ofs => $_, + s_name => undef, + debugname => undef + }; } my %globaldefs = (); - for(@{$p{globaldefs}}) + for(@globaldefs) { - $_->{debugname} = "\@$_->{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 @@ -802,6 +1049,7 @@ sub parse_progs($) # 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, $_);