]> git.xonotic.org Git - xonotic/xonotic.git/blobdiff - misc/tools/progs-analyzer.pl
start of future support to detect unused temps
[xonotic/xonotic.git] / misc / tools / progs-analyzer.pl
index 91eb67f13f7bb4d2b414fe1d9ba51504cc7e644e..2ab6271758519d7b6bf0906cad46d0999de4a267 100644 (file)
@@ -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};
 
@@ -242,9 +252,8 @@ sub run_nfa($$$$$$)
 
                for(;;)
                {
-                       my $statestr = $state_hasher->($state);
                        return
-                               if $seen{"$ip:$statestr"}++;
+                               if $state_checker->($ip, $state);
 
                        my $s = $statements->[$ip];
                        my $c = checkop $s->{op};
@@ -263,8 +272,16 @@ sub run_nfa($$$$$$)
                        {
                                if($c->{isconditional})
                                {
-                                       $nfa->($ip+1, $copy_handler->($state));
-                                       $ip += $s->{$c->{isjump}};
+                                       if(rand 2)
+                                       {
+                                               $nfa->($ip+$s->{$c->{isjump}}, $copy_handler->($state));
+                                               $ip += 1;
+                                       }
+                                       else
+                                       {
+                                               $nfa->($ip+1, $copy_handler->($state));
+                                               $ip += $s->{$c->{isjump}};
+                                       }
                                }
                                else
                                {
@@ -305,10 +322,10 @@ sub get_constant($$)
        }
 }
 
-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";
@@ -348,14 +365,14 @@ sub disassemble_function($$;$)
        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;
@@ -364,10 +381,10 @@ sub disassemble_function($$;$)
        {
                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;
        }
@@ -422,7 +439,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) = @_;
@@ -499,6 +516,15 @@ sub find_uninitialized_locals($$)
 {
        my ($progs, $func) = @_;
 
+#      TODO
+#      21:04:25      divVerent | just wondering how I can best detect "temp value is never used"
+#      21:04:33      divVerent | I know which vars are temps already
+#      21:04:59      divVerent | basically, looks like for each write, I will not just have to track that the new value is valid
+#      21:05:01      divVerent | but also its source
+#      21:05:12      divVerent | on each read, I'll remember that this source statement's value has been used
+#      21:05:21      divVerent | and will compare the list of sources in a step after "execution"
+#      21:05:27      divVerent | to the list of total write statements to the temp
+
        return
                if $func->{first_statement} < 0; # builtin
 
@@ -522,7 +548,8 @@ sub find_uninitialized_locals($$)
                        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) = @_;
@@ -546,12 +573,16 @@ sub find_uninitialized_locals($$)
                                elsif($type eq 'outglobal')
                                {
                                        $watchme{$ofs} |= WATCHME_W;
+                                       $write_places{$ip}{$_} = $_
+                                               if $watchme{$ofs} & WATCHME_X;
                                }
                                elsif($type eq 'outglobalvec')
                                {
                                        $watchme{$ofs} |= WATCHME_W;
                                        $watchme{$ofs+1} |= WATCHME_W;
                                        $watchme{$ofs+2} |= WATCHME_W;
+                                       $write_places{$ip}{$_} = 1
+                                               if ($watchme{$ofs} | $watchme{$ofs+1} | $watchme{$ofs+2}) & WATCHME_X;
                                }
                        }
 
@@ -571,14 +602,14 @@ sub find_uninitialized_locals($$)
        {
                $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
@@ -590,16 +621,16 @@ sub find_uninitialized_locals($$)
                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
@@ -609,18 +640,56 @@ sub find_uninitialized_locals($$)
        }
 
        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
+
+                               # FIXME this is wrong now
+                               # when merging states, we also must somehow merge initialization sources
+                               # to become the union, EVEN for already analyzes future instructions!
+                               # maybe can do this by abusing references
+                               # and thereby adjusting the value after the fact
+
+                               for(keys %$state)
+                               {
+                                       if($state->{$_}{valid}[0] < $s->{$_}[0])
+                                       {
+                                               # 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}
+                                                               if $state->{$_}{valid}[0] < $s->{$_}[0];
+                                               }
+                                               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}); } 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->{$_};
@@ -632,42 +701,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)
                                        {
-                                               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')
                                {
@@ -686,59 +765,70 @@ sub find_uninitialized_locals($$)
                                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(keys %{$write_places{$ip}})
+#              {
+#                      print "; Value is never used in $func->{debugname} at $ip.$_\n";
+#                      ++$warned{$ip}{$_};
+#              }
+#      }
        
        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($)
@@ -825,12 +915,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}})
        {
@@ -841,25 +933,25 @@ sub parse_progs($)
                $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}};
@@ -868,6 +960,7 @@ sub parse_progs($)
        {
                next
                        if $globaldefs{$_->{debugname}} <= 1;
+               print "Not unique: $_->{debugname} at $_->{ofs}\n";
                $_->{debugname} .= "\@$_->{ofs}";
        }
        $p{globaldef_byoffset} = sub