setorigin also relinks, mention this

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

diff --git a/misc/tools/progs-analyzer.pl b/misc/tools/progs-analyzer.pl
index 73863c682c8b2da27ba03a1d6aab739061f10b6f..5701c3a8bf945b977bee6b18630b6393abc8166f 100755 (executable)
--- a/misc/tools/progs-analyzer.pl
+++ b/misc/tools/progs-analyzer.pl
@@ -296,9 +296,8 @@ sub run_nfa($$$$$$)
                        elsif($c->{iscall})
                        {
                                my $func = $s->{a};
-                               my $funcid = $progs->{globals}[$func]{v}{int};
                                last
-                                       if $progs->{builtins}{error}{$funcid};
+                                       if $progs->{builtins}{error}{$func};
                                $ip += 1;
                        }
                        elsif($c->{isjump})
@@ -356,8 +355,8 @@ sub get_constant($$$)
                if $type eq 'vector';
        return "entity $g->{int}"
                if $type eq 'entity';
-       return ".$progs->{entityfieldnames}[$g->{int}]"
-               if $type eq 'field' and defined $progs->{entityfieldnames}[$g->{int}];
+       return ".$progs->{entityfieldnames}[$g->{int}][0]"
+               if $type eq 'field' and defined $progs->{entityfieldnames}[$g->{int}][0];
        return "$g->{int}i"
                if $type eq 'int';
 
@@ -883,7 +882,59 @@ sub find_uninitialized_locals($$)
                        }
                }
        }
-       
+
+       my %solid_seen = ();
+       run_nfa $progs, $func->{first_statement}, do { my $state = -1; \$state; },
+               sub
+               {
+                       my $state = ${$_[0]};
+                       return \$state;
+               },
+               sub
+               {
+                       my ($ip, $state) = @_;
+                       return $solid_seen{"$ip $$state"}++;
+               },
+               sub
+               {
+                       my ($ip, $state, $s, $c) = @_;
+
+                       if($s->{op} eq 'ADDRESS')
+                       {
+                               my $field_ptr_ofs = $s->{b};
+                               my $def = $progs->{globaldef_byoffset}->($field_ptr_ofs);
+                               use Data::Dumper;
+                               if (($def->{globaltype} eq 'read_only' || $def->{globaltype} eq 'const') &&
+                                               grep { $_ eq 'solid' } @{$progs->{entityfieldnames}[$progs->{globals}[$field_ptr_ofs]{v}{int}]})
+                               {
+                                       # Taking address of 'solid' for subsequent write!
+                                       # TODO check if this address is then actually used in STOREP.
+                                       $$state = $ip;
+                               }
+                       }
+
+                       if($c->{iscall})
+                       {
+                               # TODO check if the entity passed is actually the one on which solid was set.
+                               my $func = $s->{a};
+                               if ($progs->{builtins}{setmodel}{$func} || $progs->{builtins}{setorigin}{$func} || $progs->{builtins}{setsize}{$func})
+                               {
+                                       # All is clean.
+                                       $$state = -1;
+                               }
+                       }
+
+                       if($c->{isreturn})
+                       {
+                               if ($$state >= 0) {
+                                       ++$warned{$$state}{''}{"Changing .solid without setmodel/setorigin/setsize breaks area grid linking in Quake [write is here]"};
+                                       ++$warned{$ip}{''}{"Changing .solid without setmodel/setorigin/setsize breaks area grid linking in Quake [return is here]"};
+                               }
+                       }
+
+                       return 0;
+               };
+
        disassemble_function($progs, $func, \%warned)
                if keys %warned;
 }
@@ -1265,9 +1316,7 @@ sub parse_progs($$)
                my $name = $p{getstring}->($g->{s_name});
                die "Out of range ofs $g->{ofs} in fielddef $_ (name: \"$name\")"
                        if $g->{ofs} >= $p{header}{entityfields};
-               #warn "Duplicate fielddef for ofs $g->{ofs} in fielddef $_ (name: \"$name\")"
-               #       if exists $p{entityfieldnames}[$g->{ofs}];
-               $p{entityfieldnames}[$g->{ofs}] = $name;
+               push @{$p{entityfieldnames}[$g->{ofs}]}, $name;
        }
 
        print STDERR "Parsing statements...\n";
@@ -1364,8 +1413,8 @@ sub parse_progs($$)
                }
        }
 
-       print STDERR "Looking for error(), setmodel(), setsize()...\n";
-       $p{builtins} = { error => {}, setmodel => {}, setsize => {} };
+       print STDERR "Looking for error(), setmodel(), setorigin(), setsize()...\n";
+       $p{builtins} = { error => {}, setmodel => {}, setorigin => {}, setsize => {} };
        for(@{$p{globaldefs}})
        {
                my $name = $p{getstring}($_->{s_name});