Take nl.git.xonotic.org out of the rotation.

[xonotic/xonotic.git] / misc / tools / progs-analyzer.pl

diff --git a/misc/tools/progs-analyzer.pl b/misc/tools/progs-analyzer.pl
old mode 100644 (file)
new mode 100755 (executable)
index 6ba7de8..d0df1c4
--- a/misc/tools/progs-analyzer.pl
+++ b/misc/tools/progs-analyzer.pl
@@ -1,3 +1,5 @@
+#!/usr/bin/perl
+
 use strict;
 use warnings;
 use Digest::SHA;
@@ -125,6 +127,10 @@ sub checkop($)
        {
                return { a => 'inglobal', b => 'inglobalfunc' };
        }
+       if($op =~ /^INVALID#/)
+       {
+               return { isinvalid => 1 };
+       }
        return { a => 'inglobal', b => 'inglobal', c => 'outglobal' };
 }
 
@@ -501,7 +507,7 @@ sub disassemble_function($$;$)
                {
                        for(values %{$highlight->{$ip}})
                        {
-                               for(@$_)
+                               for(sort keys %$_)
                                {
                                        print PRE_MARK_STATEMENT;
                                        printf INSTRUCTION_FORMAT, '', '<!>', '.WARN';
@@ -673,6 +679,10 @@ sub find_uninitialized_locals($$)
                                }
                        }
 
+                       if($c->{isinvalid})
+                       {
+                               ++$warned{$ip}{''}{"Invalid opcode"};
+                       }
                        for(qw(a b c))
                        {
                                my $type = $c->{$_};
@@ -694,7 +704,7 @@ sub find_uninitialized_locals($$)
                                                # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops)
                                                if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b'))
                                                {
-                                                       push @{$warned{$ip}{$_}}, "Use of uninitialized value";
+                                                       ++$warned{$ip}{$_}{"Use of uninitialized value"};
                                                }
                                        }
                                        elsif($valid->[0] < 0)
@@ -702,7 +712,7 @@ sub find_uninitialized_locals($$)
                                                # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops)
                                                if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b'))
                                                {
-                                                       push @{$warned{$ip}{$_}}, "Use of temporary across CALL";
+                                                       ++$warned{$ip}{$_}{"Use of temporary across CALL"};
                                                }
                                        }
                                        else
@@ -741,6 +751,13 @@ sub find_uninitialized_locals($$)
                                        $write->($ofs+1);
                                        $write->($ofs+2);
                                }
+                               elsif($type eq 'ipoffset')
+                               {
+                                       ++$warned{$ip}{$_}{"Endless loop"}
+                                               if $ofs == 0;
+                                       ++$warned{$ip}{$_}{"No-operation jump"}
+                                               if $ofs == 1;
+                               }
                        }
                        if($c->{iscall})
                        {
@@ -829,7 +846,7 @@ sub find_uninitialized_locals($$)
 
                        if(!$isread)
                        {
-                               push @{$warned{$ip}{$operand}}, "Value is never used";
+                               ++$warned{$ip}{$operand}{"Value is never used"};
                        }
                }
        }
@@ -890,7 +907,8 @@ sub detect_constants($)
        use constant GLOBALFLAG_Q => 32; # unique to function
        use constant GLOBALFLAG_U => 64; # unused
        use constant GLOBALFLAG_P => 128; # possibly parameter passing
-       my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x @{$progs->{globals}};
+       use constant GLOBALFLAG_D => 256; # has a def
+       my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x (@{$progs->{globals}} + 2);
 
        for(@{$progs->{functions}})
        {
@@ -972,21 +990,42 @@ sub detect_constants($)
                        if $name eq 'IMMEDIATE' or $name =~ /^\./;
                $_->{debugname} = $name
                        if $name ne '';
+               $globalflags[$_->{ofs}] |= GLOBALFLAG_D;
                if($type->{save})
                {
-                       for my $i(0..(typesize($_->{type}{type})-1))
-                       {
-                               $globalflags[$_->{ofs}] |= GLOBALFLAG_S;
-                       }
+                       $globalflags[$_->{ofs}] |= GLOBALFLAG_S;
                }
-               if($name ne '')
+               if(defined $_->{debugname})
                {
-                       for my $i(0..(typesize($_->{type}{type})-1))
+                       $globalflags[$_->{ofs}] |= GLOBALFLAG_N;
+               }
+       }
+       # fix up vectors
+       my @extradefs = ();
+       for(@{$progs->{globaldefs}})
+       {
+               my $type = $_->{type};
+               for my $i(1..(typesize($type->{type})-1))
+               {
+                       # add missing def
+                       if(!($globalflags[$_->{ofs}+$i] & GLOBALFLAG_D))
                        {
-                               $globalflags[$_->{ofs}] |= GLOBALFLAG_N;
+                               print "Missing globaldef for a component@{[defined $_->{debugname} ? ' of ' . $_->{debugname} : '']} at $_->{ofs}+$i\n";
+                               push @extradefs, {
+                                       type => {
+                                               saved => 0,
+                                               type => 'float'
+                                       },
+                                       ofs => $_->{ofs} + $i,
+                                       debugname => defined $_->{debugname} ? $_->{debugname} . "[$i]" : undef
+                               };
                        }
+                       # "saved" and "named" states hit adjacent globals too
+                       $globalflags[$_->{ofs}+$i] |= $globalflags[$_->{ofs}] & (GLOBALFLAG_S | GLOBALFLAG_N | GLOBALFLAG_D);
                }
        }
+       push @{$progs->{globaldefs}}, @extradefs;
+
        my %offsets_initialized = ();
        for(0..(@{$progs->{globals}}-1))
        {
@@ -1079,7 +1118,8 @@ sub detect_constants($)
                $globaldefs[$_] //= {
                        ofs => $_,
                        s_name => undef,
-                       debugname => undef
+                       debugname => undef,
+                       type => undef
                };
        }
        for(0..(@{(DEFAULTGLOBALS)}-1))
@@ -1151,7 +1191,7 @@ sub parse_progs($)
                die "Out of range name in globaldef $_"
                        if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
                my $name = $p{getstring}->($g->{s_name});
-               die "Out of range ofs in globaldef $_ (name: \"$name\")"
+               die "Out of range ofs $g->{ofs} in globaldef $_ (name: \"$name\")"
                        if $g->{ofs} >= $p{globals};
        }
 
@@ -1165,7 +1205,7 @@ sub parse_progs($)
                die "Out of range name in fielddef $_"
                        if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
                my $name = $p{getstring}->($g->{s_name});
-               die "Out of range ofs in globaldef $_ (name: \"$name\")"
+               die "Out of range ofs $g->{ofs} in fielddef $_ (name: \"$name\")"
                        if $g->{ofs} >= $p{header}{entityfields};
        }
 
@@ -1185,23 +1225,28 @@ sub parse_progs($)
                die "Out of range file in function $_"
                        if $f->{s_file} < 0 || $f->{s_file} >= length $p{strings};
                my $file = $p{getstring}->($f->{s_file});
-               die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\")"
+               die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
                        if $f->{first_statement} >= @{$p{statements}};
-               die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\")"
-                       if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}};
-               die "Out of range locals in function $_ (name: \"$name\", file: \"$file\")"
-                       if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} >= @{$p{globals}};
-               die "Out of range numparms in function $_ (name: \"$name\", file: \"$file\")"
-                       if $f->{numparms} < 0 || $f->{numparms} > 8;
-               my $totalparms = 0;
-               for(0..($f->{numparms}-1))
+               if($f->{first_statement} >= 0)
                {
-                       die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\")"
-                               unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]};
-                       $totalparms += $f->{parm_size}[$_];
+                       die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                               if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}};
+                       die "Out of range locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                               if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} > @{$p{globals}};
+                       die "Out of range numparms $f->{numparms} in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                               if $f->{numparms} < 0 || $f->{numparms} > 8;
+                       my $totalparms = 0;
+                       for(0..($f->{numparms}-1))
+                       {
+                               die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                                       unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]};
+                               $totalparms += $f->{parm_size}[$_];
+                       }
+                       die "Out of range parms in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                               if $f->{parm_start} + $totalparms > @{$p{globals}};
+                       die "More parms than locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+                               if $totalparms > $f->{locals};
                }
-               die "Out of range parms in function $_ (name: \"$name\", file: \"$file\")"
-                       if $f->{locals} < 0 || $f->{parm_start} + $totalparms >= @{$p{globals}};
        }
 
        print STDERR "Range checking statements...\n";
@@ -1225,8 +1270,18 @@ sub parse_progs($)
                        elsif($type eq 'inglobalvec')
                        {
                                $s->{$_} &= 0xFFFF;
-                               die "Out of range global offset in statement $ip - cannot continue"
-                                       if $s->{$_} >= @{$p{globals}}-2;
+                               if($c->{isreturn})
+                               {
+                                       die "Out of range global offset in statement $ip - cannot continue"
+                                               if $s->{$_} >= @{$p{globals}};
+                                       print "Potentially out of range global offset in statement $ip - may crash engines"
+                                               if $s->{$_} >= @{$p{globals}}-2;
+                               }
+                               else
+                               {
+                                       die "Out of range global offset in statement $ip - cannot continue"
+                                               if $s->{$_} >= @{$p{globals}}-2;
+                               }
                        }
                        elsif($type eq 'outglobal')
                        {