misc/tools/progs-analyzer.pl

   1 use strict;
   2 use warnings;
   3 use Digest::SHA;
   4 use Carp;
   5
   6 sub id()
   7 {
   8         return sub { $_[0]; };
   9 }
  10
  11 sub signed($)
  12 {
  13         my ($bits) = @_;
  14         return sub { $_[0] >= (2**($bits-1)) ? $_[0]-(2**$bits) : $_[0]; };
  15 }
  16
  17 use constant OPCODE_E => [qw[
  18         DONE
  19         MUL_F MUL_V MUL_FV MUL_VF
  20         DIV_F
  21         ADD_F ADD_V
  22         SUB_F SUB_V
  23         EQ_F EQ_V EQ_S EQ_E EQ_FNC
  24         NE_F NE_V NE_S NE_E NE_FNC
  25         LE GE LT GT
  26         LOAD_F LOAD_V LOAD_S LOAD_ENT LOAD_FLD LOAD_FNC
  27         ADDRESS
  28         STORE_F STORE_V STORE_S STORE_ENT STORE_FLD STORE_FNC
  29         STOREP_F STOREP_V STOREP_S STOREP_ENT STOREP_FLD STOREP_FNC
  30         RETURN
  31         NOT_F NOT_V NOT_S NOT_ENT NOT_FNC
  32         IF IFNOT
  33         CALL0 CALL1 CALL2 CALL3 CALL4 CALL5 CALL6 CALL7 CALL8
  34         STATE
  35         GOTO
  36         AND OR
  37         BITAND BITOR
  38 ]];
  39 use constant ETYPE_E => [qw[
  40         void
  41         string
  42         float
  43         vector
  44         entity
  45         field
  46         function
  47         pointer
  48 ]];
  49 use constant DEF_SAVEGLOBAL => 32768;
  50 sub typesize($)
  51 {
  52         my ($type) = @_;
  53         return 3 if $type eq 'vector';
  54         return 1;
  55 }
  56
  57 sub checkop($)
  58 {
  59         my ($op) = @_;
  60         if($op =~ /^IF.*_V$/)
  61         {
  62                 return { a => 'inglobalvec', b => 'ipoffset', isjump => 'b', isconditional => 1 };
  63         }
  64         if($op =~ /^IF/)
  65         {
  66                 return { a => 'inglobal', b => 'ipoffset', isjump => 'b', isconditional => 1 };
  67         }
  68         if($op eq 'GOTO')
  69         {
  70                 return { a => 'ipoffset', isjump => 'a', isconditional => 0 };
  71         }
  72         if($op =~ /^ADD_V$|^SUB_V$/)
  73         {
  74                 return { a => 'inglobalvec', b => 'inglobalvec', c => 'outglobalvec' };
  75         }
  76         if($op =~ /^MUL_V$|^EQ_V$|^NE_V$/)
  77         {
  78                 return { a => 'inglobalvec', b => 'inglobalvec', c => 'outglobal' };
  79         }
  80         if($op eq 'MUL_FV')
  81         {
  82                 return { a => 'inglobal', b => 'inglobalvec', c => 'outglobalvec' };
  83         }
  84         if($op eq 'MUL_VF')
  85         {
  86                 return { a => 'inglobalvec', b => 'inglobal', c => 'outglobalvec' };
  87         }
  88         if($op eq 'LOAD_V')
  89         {
  90                 return { a => 'inglobal', b => 'inglobal', c => 'outglobalvec' };
  91         }
  92         if($op =~ /^NOT_V/)
  93         {
  94                 return { a => 'inglobalvec', c => 'outglobal' };
  95         }
  96         if($op =~ /^NOT_/)
  97         {
  98                 return { a => 'inglobal', c => 'outglobal' };
  99         }
 100         if($op eq 'STOREP_V')
 101         {
 102                 return { a => 'inglobalvec', b => 'inglobal' };
 103         }
 104         if($op eq 'STORE_V')
 105         {
 106                 return { a => 'inglobalvec', b => 'outglobalvec' };
 107         }
 108         if($op =~ /^STOREP_/)
 109         {
 110                 return { a => 'inglobal', b => 'inglobal' };
 111         }
 112         if($op =~ /^STORE_/)
 113         {
 114                 return { a => 'inglobal', b => 'outglobal' };
 115         }
 116         if($op =~ /^CALL/)
 117         {
 118                 return { a => 'inglobalfunc', iscall => 1 };
 119         }
 120         if($op =~ /^DONE$|^RETURN$/)
 121         {
 122                 return { a => 'inglobalvec', isreturn => 1 };
 123         }
 124         if($op eq 'STATE')
 125         {
 126                 return { a => 'inglobal', b => 'inglobalfunc' };
 127         }
 128         return { a => 'inglobal', b => 'inglobal', c => 'outglobal' };
 129 }
 130
 131 use constant TYPES => {
 132         int => ['V', 4, signed 32],
 133         ushort => ['v', 2, id],
 134         short => ['v', 2, signed 16],
 135         opcode => ['v', 2, sub { OPCODE_E->[$_[0]] or do { warn "Invalid opcode: $_[0]"; "INVALID#$_[0]"; }; }],
 136         float => ['f', 4, id],
 137         uchar8 => ['a8', 8, sub { [unpack 'C8', $_[0]] }],
 138         global => ['i', 4, sub { { int => $_[0], float => unpack "f", pack "L", $_[0] }; }],
 139         deftype => ['v', 2, sub { { type => ETYPE_E->[$_[0] & ~DEF_SAVEGLOBAL], save => !!($_[0] & DEF_SAVEGLOBAL) }; }],
 140 };
 141
 142 use constant DPROGRAMS_T => [
 143         [int => 'version'],
 144         [int => 'crc'],
 145         [int => 'ofs_statements'],
 146         [int => 'numstatements'],
 147         [int => 'ofs_globaldefs'],
 148         [int => 'numglobaldefs'],
 149         [int => 'ofs_fielddefs'],
 150         [int => 'numfielddefs'],
 151         [int => 'ofs_functions'],
 152         [int => 'numfunctions'],
 153         [int => 'ofs_strings'],
 154         [int => 'numstrings'],
 155         [int => 'ofs_globals'],
 156         [int => 'numglobals'],
 157         [int => 'entityfields']
 158 ];
 159
 160 use constant DSTATEMENT_T => [
 161         [opcode => 'op'],
 162         [short => 'a'],
 163         [short => 'b'],
 164         [short => 'c']
 165 ];
 166
 167 use constant DDEF_T => [
 168         [deftype => 'type'],
 169         [ushort => 'ofs'],
 170         [int => 's_name']
 171 ];
 172
 173 use constant DGLOBAL_T => [
 174         [global => 'v'],
 175 ];
 176
 177 use constant DFUNCTION_T => [
 178         [int => 'first_statement'],
 179         [int => 'parm_start'],
 180         [int => 'locals'],
 181         [int => 'profile'],
 182         [int => 's_name'],
 183         [int => 's_file'],
 184         [int => 'numparms'],
 185         [uchar8 => 'parm_size'],
 186 ];
 187
 188 sub get_section($$$)
 189 {
 190         my ($fh, $start, $len) = @_;
 191         seek $fh, $start, 0
 192                 or die "seek: $!";
 193         $len == read $fh, my $buf, $len
 194                 or die "short read from $start length $len (malformed progs header)";
 195         return $buf;
 196 }
 197
 198 sub parse_section($$$$$)
 199 {
 200         my ($fh, $struct, $start, $len, $cnt) = @_;
 201
 202         my $itemlen = 0;
 203         $itemlen += TYPES->{$_->[0]}->[1]
 204                 for @$struct;
 205         my $packspec = join '', map { TYPES->{$_->[0]}->[0]; } @$struct;
 206         my @packnames = map { $_->[1]; } @$struct;
 207
 208         $len = $cnt * $itemlen
 209                 if not defined $len and defined $cnt;
 210         $cnt = int($len / $itemlen)
 211                 if not defined $cnt and defined $len;
 212         die "Invalid length specification"
 213                 unless defined $len and defined $cnt and $len == $cnt * $itemlen;
 214         die "Invalid length specification in scalar context"
 215                 unless wantarray or $cnt == 1;
 216
 217         seek $fh, $start, 0
 218                 or die "seek: $!";
 219         my @out = map
 220         {
 221                 $itemlen == read $fh, my $buf, $itemlen
 222                         or die "short read from $start length $cnt * $itemlen $(malformed progs header)";
 223                 my %h = ();
 224                 @h{@packnames} = unpack $packspec, $buf;
 225                 $h{$_->[1]} = TYPES->{$_->[0]}->[2]->($h{$_->[1]})
 226                         for @$struct;
 227                 \%h;
 228         }
 229         0..($cnt-1);
 230         return @out
 231                 if wantarray;
 232         return $out[0];
 233 }
 234
 235 sub nfa_default_state_checker()
 236 {
 237         my %seen;
 238         return sub
 239         {
 240                 my ($ip, $state) = @_;
 241                 return $seen{"$ip $state"}++;
 242         };
 243 }
 244
 245 sub run_nfa($$$$$$)
 246 {
 247         my ($progs, $ip, $state, $copy_handler, $state_checker, $instruction_handler) = @_;
 248
 249         my $statements = $progs->{statements};
 250
 251         my $nfa;
 252         $nfa = sub
 253         {
 254                 no warnings 'recursion';
 255
 256                 my ($ip, $state) = @_;
 257                 my $ret = 0;
 258
 259                 for(;;)
 260                 {
 261                         return $ret
 262                                 if $state_checker->($ip, $state);
 263
 264                         my $s = $statements->[$ip];
 265                         my $c = checkop $s->{op};
 266
 267                         if(($ret = $instruction_handler->($ip, $state, $s, $c)))
 268                         {
 269                                 # abort execution
 270                                 last;
 271                         }
 272
 273                         if($c->{isreturn})
 274                         {
 275                                 last;
 276                         }
 277                         elsif($c->{iscall})
 278                         {
 279                                 my $func = $s->{a};
 280                                 my $funcid = $progs->{globals}[$func]{v}{int};
 281                                 last
 282                                         if $progs->{error_func}{$funcid};
 283                                 $ip += 1;
 284                         }
 285                         elsif($c->{isjump})
 286                         {
 287                                 if($c->{isconditional})
 288                                 {
 289                                         if(rand 2)
 290                                         {
 291                                                 if(($ret = $nfa->($ip+$s->{$c->{isjump}}, $copy_handler->($state))) < 0)
 292                                                 {
 293                                                         last;
 294                                                 }
 295                                                 $ip += 1;
 296                                         }
 297                                         else
 298                                         {
 299                                                 $nfa->($ip+1, $copy_handler->($state));
 300                                                 $ip += $s->{$c->{isjump}};
 301                                         }
 302                                 }
 303                                 else
 304                                 {
 305                                         $ip += $s->{$c->{isjump}};
 306                                 }
 307                         }
 308                         else
 309                         {
 310                                 $ip += 1;
 311                         }
 312                 }
 313
 314                 return $ret;
 315         };
 316
 317         $nfa->($ip, $copy_handler->($state));
 318 }
 319
 320 sub get_constant($$)
 321 {
 322         my ($progs, $g) = @_;
 323         if($g->{int} == 0)
 324         {
 325                 return 0;
 326         }
 327         elsif($g->{int} > 0 && $g->{int} < 8388608)
 328         {
 329                 if($g->{int} < length $progs->{strings} && $g->{int} > 0)
 330                 {
 331                         return str($progs->{getstring}->($g->{int}));
 332                 }
 333                 else
 334                 {
 335                         return $g->{int} . "i";
 336                 }
 337         }
 338         else
 339         {
 340                 return $g->{float};
 341         }
 342 }
 343
 344 use constant PRE_MARK_STATEMENT => "";
 345 use constant POST_MARK_STATEMENT => "";
 346 use constant PRE_MARK_OPERAND => "*** ";
 347 use constant POST_MARK_OPERAND => " ***";
 348
 349 use constant INSTRUCTION_FORMAT => "%8s %3s | %-12s ";
 350 use constant OPERAND_FORMAT => "%s";
 351 use constant OPERAND_SEPARATOR => ", ";
 352 use constant INSTRUCTION_SEPARATOR => "\n";
 353
 354 sub str($)
 355 {
 356         my ($str) = @_;
 357         $str =~ s/[\000-\037\\\"\177-\377]/sprintf "\\%03o", ord $&/ge;
 358         return "\"$str\"";
 359 }
 360
 361 sub disassemble_function($$;$)
 362 {
 363         my ($progs, $func, $highlight) = @_;
 364
 365         print "$func->{debugname}:\n";
 366
 367         if($func->{first_statement} < 0) # builtin
 368         {
 369                 printf INSTRUCTION_FORMAT, '', '', '.BUILTIN';
 370                 printf OPERAND_FORMAT, -$func->{first_statement};
 371                 print INSTRUCTION_SEPARATOR;
 372                 return;
 373         }
 374
 375         my $initializer = sub
 376         {
 377                 my ($ofs) = @_;
 378                 my $g = get_constant($progs, $progs->{globals}[$ofs]{v});
 379                 print " = $g"
 380                         if defined $g;
 381         };
 382
 383         printf INSTRUCTION_FORMAT, '', '', '.PARM_START';
 384         printf OPERAND_FORMAT, "$func->{parm_start}";
 385         print INSTRUCTION_SEPARATOR;
 386
 387         printf INSTRUCTION_FORMAT, '', '', '.LOCALS';
 388         printf OPERAND_FORMAT, "$func->{locals}";
 389         print INSTRUCTION_SEPARATOR;
 390
 391         my %override_locals = ();
 392         my $p = $func->{parm_start};
 393         for(0..($func->{numparms}-1))
 394         {
 395                 $override_locals{$p} //= "argv_$_";
 396                 for my $comp(0..($func->{parm_size}[$_]-1))
 397                 {
 398                         $override_locals{$p} //= "argv_$_\[$comp]";
 399                         ++$p;
 400                 }
 401                 printf INSTRUCTION_FORMAT, '', '', '.ARG';
 402                 printf OPERAND_FORMAT, "argv_$_";
 403                 print OPERAND_SEPARATOR;
 404                 printf OPERAND_FORMAT, $func->{parm_size}[$_];
 405                 print INSTRUCTION_SEPARATOR;
 406         }
 407         for($func->{parm_start}..($func->{parm_start} + $func->{locals} - 1))
 408         {
 409                 next
 410                         if exists $override_locals{$_};
 411                 $override_locals{$_} = "local_$_";
 412
 413                 printf INSTRUCTION_FORMAT, '', '', '.LOCAL';
 414                 printf OPERAND_FORMAT, "local_$_";
 415                 $initializer->($_);
 416                 print INSTRUCTION_SEPARATOR;
 417         }
 418
 419         my $getname = sub
 420         {
 421                 my ($ofs) = @_;
 422                 return $override_locals{$ofs}
 423                         if exists $override_locals{$ofs};
 424                 my $def = $progs->{globaldef_byoffset}->($ofs);
 425                 return $def->{debugname};
 426         };
 427
 428         my $operand = sub
 429         {
 430                 my ($ip, $type, $operand) = @_;
 431                 if($type eq 'inglobal')
 432                 {
 433                         my $name = $getname->($operand);
 434                         printf OPERAND_FORMAT, "$name";
 435                 }
 436                 elsif($type eq 'outglobal')
 437                 {
 438                         my $name = $getname->($operand);
 439                         printf OPERAND_FORMAT, "&$name";
 440                 }
 441                 elsif($type eq 'inglobalvec')
 442                 {
 443                         my $name = $getname->($operand);
 444                         printf OPERAND_FORMAT, "$name\[\]";
 445                 }
 446                 elsif($type eq 'outglobalvec')
 447                 {
 448                         my $name = $getname->($operand);
 449                         printf OPERAND_FORMAT, "&$name\[\]";
 450                 }
 451                 elsif($type eq 'inglobalfunc')
 452                 {
 453                         my $name = $getname->($operand);
 454                         printf OPERAND_FORMAT, "$name()";
 455                 }
 456                 elsif($type eq 'ipoffset')
 457                 {
 458                         printf OPERAND_FORMAT, "@{[$ip + $operand]}" . sprintf ' ($%+d)', $operand;
 459                 }
 460                 else
 461                 {
 462                         die "unknown type: $type";
 463                 }
 464         };
 465
 466         my $statements = $func->{statements};
 467         my $come_from = $func->{come_from};
 468
 469         my $ipprev = undef;
 470         for my $ip(sort { $a <=> $b } keys %$statements)
 471         {
 472                 if($ip == $func->{first_statement})
 473                 {
 474                         printf INSTRUCTION_FORMAT, $ip, '', '.ENTRY';
 475                         print INSTRUCTION_SEPARATOR;
 476                 }
 477                 if(defined $ipprev && $ip != $ipprev + 1)
 478                 {
 479                         printf INSTRUCTION_FORMAT, $ip, '', '.SKIP';
 480                         printf OPERAND_FORMAT, $ip - $ipprev - 1;
 481                         print INSTRUCTION_SEPARATOR;
 482                 }
 483                 if(my $cf = $come_from->{$ip})
 484                 {
 485                         printf INSTRUCTION_FORMAT, $ip, '', '.XREF';
 486                         my $cnt = 0;
 487                         for(sort { $a <=> $b } keys %$cf)
 488                         {
 489                                 print OPERAND_SEPARATOR
 490                                         if $cnt++;
 491                                 printf OPERAND_FORMAT, ($cf->{$_} ? 'c' : 'j') . $_ . sprintf ' ($%+d)', $_ - $ip;
 492                         }
 493                         print INSTRUCTION_SEPARATOR;
 494                 }
 495
 496                 my $op = $progs->{statements}[$ip]{op};
 497                 my $ipt = $progs->{statements}[$ip];
 498                 my $opprop = checkop $op;
 499
 500                 if($highlight and $highlight->{$ip})
 501                 {
 502                         for(values %{$highlight->{$ip}})
 503                         {
 504                                 for(sort keys %$_)
 505                                 {
 506                                         print PRE_MARK_STATEMENT;
 507                                         printf INSTRUCTION_FORMAT, '', '<!>', '.WARN';
 508                                         printf OPERAND_FORMAT, "$_ (in $func->{debugname})";
 509                                         print INSTRUCTION_SEPARATOR;
 510                                 }
 511                         }
 512                 }
 513
 514                 print PRE_MARK_STATEMENT
 515                         if $highlight and $highlight->{$ip};
 516
 517                 my $showip = $opprop->{isjump};
 518                 printf INSTRUCTION_FORMAT, $showip ? $ip : '', $highlight->{$ip} ? '<!>' : '', $op;
 519
 520                 my $cnt = 0;
 521                 for my $o(qw(a b c))
 522                 {
 523                         next
 524                                 if not defined $opprop->{$o};
 525                         print OPERAND_SEPARATOR
 526                                 if $cnt++;
 527                         print PRE_MARK_OPERAND
 528                                 if $highlight and $highlight->{$ip} and $highlight->{$ip}{$o};
 529                         $operand->($ip, $opprop->{$o}, $ipt->{$o});
 530                         print POST_MARK_OPERAND
 531                                 if $highlight and $highlight->{$ip} and $highlight->{$ip}{$o};
 532                 }
 533
 534                 print POST_MARK_STATEMENT
 535                         if $highlight and $highlight->{$ip};
 536
 537                 print INSTRUCTION_SEPARATOR;
 538         }
 539 }
 540
 541 sub find_uninitialized_locals($$)
 542 {
 543         my ($progs, $func) = @_;
 544
 545         return
 546                 if $func->{first_statement} < 0; # builtin
 547
 548         print STDERR "Checking $func->{debugname}...\n";
 549
 550         my $p = $func->{parm_start};
 551         for(0..($func->{numparms}-1))
 552         {
 553                 $p += $func->{parm_size}[$_];
 554         }
 555
 556         use constant WATCHME_R => 1;
 557         use constant WATCHME_W => 2;
 558         use constant WATCHME_X => 4;
 559         use constant WATCHME_T => 8;
 560         my %watchme = map { $_ => WATCHME_X } ($func->{parm_start} .. ($func->{parm_start} + $func->{locals} - 1));
 561
 562         for(keys %{$progs->{temps}})
 563         {
 564                 next
 565                         if exists $watchme{$_};
 566                 if($progs->{temps}{$_})
 567                 {
 568                         # shared temp
 569                         $watchme{$_} = WATCHME_T | WATCHME_X
 570                 }
 571                 else
 572                 {
 573                         # unique temp
 574                         $watchme{$_} = WATCHME_X
 575                 }
 576         }
 577
 578         $watchme{$_} |= WATCHME_R
 579                 for keys %{$func->{globals_read}};
 580         $watchme{$_} |= WATCHME_W
 581                 for keys %{$func->{globals_written}};
 582
 583         my %write_places = ();
 584         for my $ofs(keys %{$func->{globals_written}})
 585         {
 586                 next
 587                         unless exists $watchme{$ofs} and $watchme{$ofs} & WATCHME_X;
 588                 for my $ip(keys %{$func->{globals_written}{$ofs}})
 589                 {
 590                         for my $op(keys %{$func->{globals_written}{$ofs}{$ip}})
 591                         {
 592                                 push @{$write_places{$ip}{$op}}, $ofs;
 593                         }
 594                 }
 595         }
 596
 597         for(keys %watchme)
 598         {
 599                 delete $watchme{$_}
 600                         if ($watchme{$_} & (WATCHME_R | WATCHME_W | WATCHME_X)) != (WATCHME_R | WATCHME_W | WATCHME_X);
 601         }
 602
 603         return
 604                 if not keys %watchme;
 605
 606         for(keys %watchme)
 607         {
 608                 $watchme{$_} = {
 609                         flags => $watchme{$_},
 610                         valid => [0, undef, undef]
 611                 };
 612         }
 613
 614         # mark parameters as initialized
 615         for($func->{parm_start} .. ($p-1))
 616         {
 617                 $watchme{$_}{valid} = [1, undef, undef]
 618                         if defined $watchme{$_};
 619         }
 620
 621         my %warned = ();
 622         my %ip_seen = ();
 623         run_nfa $progs, $func->{first_statement}, \%watchme,
 624                 sub {
 625                         my ($h) = @_;
 626                         return { map { $_ => { %{$h->{$_}} } } keys %$h };
 627                 },
 628                 sub {
 629                         my ($ip, $state) = @_;
 630
 631                         my $s = $ip_seen{$ip};
 632                         if($s)
 633                         {
 634                                 # if $state is stronger or equal to $s, return 1
 635
 636                                 for(keys %$state)
 637                                 {
 638                                         if($state->{$_}{valid}[0] < $s->{$_})
 639                                         {
 640                                                 # The current state is LESS valid than the previously run one. We NEED to run this.
 641                                                 # The saved state can safely become the intersection [citation needed].
 642                                                 for(keys %$state)
 643                                                 {
 644                                                         $s->{$_} = $state->{$_}{valid}[0]
 645                                                                 if $state->{$_}{valid}[0] < $s->{$_};
 646                                                 }
 647                                                 return 0;
 648                                         }
 649                                 }
 650                                 # if we get here, $state is stronger or equal. No need to try it.
 651                                 return 1;
 652                         }
 653                         else
 654                         {
 655                                 # Never seen this IP yet.
 656                                 $ip_seen{$ip} = { map { ($_ => $state->{$_}{valid}[0]); } keys %$state };
 657                                 return 0;
 658                         }
 659                 },
 660                 sub {
 661                         my ($ip, $state, $s, $c) = @_;
 662                         my $op = $s->{op};
 663
 664                         # QCVM BUG: RETURN always takes vector, there is no float equivalent
 665                         my $return_hack = $c->{isreturn} // 0;
 666
 667                         if($op eq 'STORE_V')
 668                         {
 669                                 # COMPILER BUG of QCC: params are always copied using STORE_V
 670                                 if($s->{b} >= 4 && $s->{b} < 28) # parameter range
 671                                 {
 672                                         $return_hack = 1;
 673                                 }
 674                         }
 675
 676                         for(qw(a b c))
 677                         {
 678                                 my $type = $c->{$_};
 679                                 next
 680                                         unless defined $type;
 681
 682                                 my $ofs = $s->{$_};
 683
 684                                 my $read = sub
 685                                 {
 686                                         my ($ofs) = @_;
 687                                         ++$return_hack
 688                                                 if $return_hack;
 689                                         return
 690                                                 if not exists $state->{$ofs};
 691                                         my $valid = $state->{$ofs}{valid};
 692                                         if($valid->[0] == 0)
 693                                         {
 694                                                 # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops)
 695                                                 if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b'))
 696                                                 {
 697                                                         ++$warned{$ip}{$_}{"Use of uninitialized value"};
 698                                                 }
 699                                         }
 700                                         elsif($valid->[0] < 0)
 701                                         {
 702                                                 # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops)
 703                                                 if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b'))
 704                                                 {
 705                                                         ++$warned{$ip}{$_}{"Use of temporary across CALL"};
 706                                                 }
 707                                         }
 708                                         else
 709                                         {
 710                                                 # it's VALID
 711                                                 if(defined $valid->[1])
 712                                                 {
 713                                                         delete $write_places{$valid->[1]}{$valid->[2]};
 714                                                 }
 715                                         }
 716                                 };
 717                                 my $write = sub
 718                                 {
 719                                         my ($ofs) = @_;
 720                                         $state->{$ofs}{valid} = [1, $ip, $_]
 721                                                 if exists $state->{$ofs};
 722                                 };
 723
 724                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
 725                                 {
 726                                         $read->($ofs);
 727                                 }
 728                                 elsif($type eq 'inglobalvec')
 729                                 {
 730                                         $read->($ofs);
 731                                         $read->($ofs+1);
 732                                         $read->($ofs+2);
 733                                 }
 734                                 elsif($type eq 'outglobal')
 735                                 {
 736                                         $write->($ofs);
 737                                 }
 738                                 elsif($type eq 'outglobalvec')
 739                                 {
 740                                         $write->($ofs);
 741                                         $write->($ofs+1);
 742                                         $write->($ofs+2);
 743                                 }
 744                                 elsif($type eq 'ipoffset')
 745                                 {
 746                                         ++$warned{$ip}{$_}{"Endless loop"}
 747                                                 if $ofs == 0;
 748                                         ++$warned{$ip}{$_}{"No-operation jump"}
 749                                                 if $ofs == 1;
 750                                 }
 751                         }
 752                         if($c->{iscall})
 753                         {
 754                                 # builtin calls may clobber stuff
 755                                 my $func = $s->{a};
 756                                 my $funcid = $progs->{globals}[$func]{v}{int};
 757                                 my $funcobj = $progs->{functions}[$funcid];
 758                                 if(!$funcobj || $funcobj->{first_statement} >= 0)
 759                                 {
 760                                         # invalidate temps
 761                                         for(values %$state)
 762                                         {
 763                                                 if($_->{flags} & WATCHME_T)
 764                                                 {
 765                                                         $_->{valid} = [-1, undef, undef];
 766                                                 }
 767                                         }
 768                                 }
 769                         }
 770
 771                         return 0;
 772                 };
 773
 774         for my $ip(keys %write_places)
 775         {
 776                 for my $operand(keys %{$write_places{$ip}})
 777                 {
 778                         # TODO verify it
 779                         my %left = map { $_ => 1 } @{$write_places{$ip}{$operand}};
 780                         my $isread = 0;
 781
 782                         my %writeplace_seen = ();
 783                         run_nfa $progs, $ip+1, \%left,
 784                                 sub
 785                                 {
 786                                         return { %{$_[0]} };
 787                                 },
 788                                 sub
 789                                 {
 790                                         my ($ip, $state) = @_;
 791                                         return $writeplace_seen{"$ip " . join " ", sort keys %$state}++;
 792                                 },
 793                                 sub
 794                                 {
 795                                         my ($ip, $state, $s, $c) = @_;
 796                                         for(qw(a b c))
 797                                         {
 798                                                 my $type = $c->{$_};
 799                                                 next
 800                                                         unless defined $type;
 801
 802                                                 my $ofs = $s->{$_};
 803                                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
 804                                                 {
 805                                                         if($state->{$ofs})
 806                                                         {
 807                                                                 $isread = 1;
 808                                                                 return -1; # exit TOTALLY
 809                                                         }
 810                                                 }
 811                                                 elsif($type eq 'inglobalvec')
 812                                                 {
 813                                                         if($state->{$ofs} || $state->{$ofs+1} || $state->{$ofs+2})
 814                                                         {
 815                                                                 $isread = 1;
 816                                                                 return -1; # exit TOTALLY
 817                                                         }
 818                                                 }
 819                                                 elsif($type eq 'outglobal')
 820                                                 {
 821                                                         delete $state->{$ofs};
 822                                                         return 1
 823                                                                 if !%$state;
 824                                                 }
 825                                                 elsif($type eq 'outglobalvec')
 826                                                 {
 827                                                         delete $state->{$ofs};
 828                                                         delete $state->{$ofs+1};
 829                                                         delete $state->{$ofs+2};
 830                                                         return 1
 831                                                                 if !%$state;
 832                                                 }
 833                                         }
 834                                         return 0;
 835                                 };
 836
 837                         if(!$isread)
 838                         {
 839                                 ++$warned{$ip}{$operand}{"Value is never used"};
 840                         }
 841                 }
 842         }
 843
 844         disassemble_function($progs, $func, \%warned)
 845                 if keys %warned;
 846 }
 847
 848 use constant DEFAULTGLOBALS => [
 849         "OFS_NULL",
 850         "OFS_RETURN",
 851         "OFS_RETURN[1]",
 852         "OFS_RETURN[2]",
 853         "OFS_PARM0",
 854         "OFS_PARM0[1]",
 855         "OFS_PARM0[2]",
 856         "OFS_PARM1",
 857         "OFS_PARM1[1]",
 858         "OFS_PARM1[2]",
 859         "OFS_PARM2",
 860         "OFS_PARM2[1]",
 861         "OFS_PARM2[2]",
 862         "OFS_PARM3",
 863         "OFS_PARM3[1]",
 864         "OFS_PARM3[2]",
 865         "OFS_PARM4",
 866         "OFS_PARM4[1]",
 867         "OFS_PARM4[2]",
 868         "OFS_PARM5",
 869         "OFS_PARM5[1]",
 870         "OFS_PARM5[2]",
 871         "OFS_PARM6",
 872         "OFS_PARM6[1]",
 873         "OFS_PARM6[2]",
 874         "OFS_PARM7",
 875         "OFS_PARM7[1]",
 876         "OFS_PARM7[2]"
 877 ];
 878
 879 sub defaultglobal($)
 880 {
 881         my ($ofs) = @_;
 882         if($ofs < @{(DEFAULTGLOBALS)})
 883         {
 884                 return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
 885         }
 886         return { ofs => $ofs, s_name => undef, debugname => "<undefined>\@$ofs", type => undef };
 887 }
 888
 889 sub detect_constants($)
 890 {
 891         my ($progs) = @_;
 892         use constant GLOBALFLAG_R => 1; # read
 893         use constant GLOBALFLAG_W => 2; # written
 894         use constant GLOBALFLAG_S => 4; # saved
 895         use constant GLOBALFLAG_I => 8; # initialized
 896         use constant GLOBALFLAG_N => 16; # named
 897         use constant GLOBALFLAG_Q => 32; # unique to function
 898         use constant GLOBALFLAG_U => 64; # unused
 899         use constant GLOBALFLAG_P => 128; # possibly parameter passing
 900         use constant GLOBALFLAG_D => 256; # has a def
 901         my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x @{$progs->{globals}};
 902
 903         for(@{$progs->{functions}})
 904         {
 905                 for(keys %{$_->{globals_used}})
 906                 {
 907                         if($globalflags[$_] & GLOBALFLAG_U)
 908                         {
 909                                 $globalflags[$_] &= ~GLOBALFLAG_U;
 910                         }
 911                         elsif($globalflags[$_] & GLOBALFLAG_Q)
 912                         {
 913                                 $globalflags[$_] &= ~GLOBALFLAG_Q;
 914                         }
 915                 }
 916                 $globalflags[$_] |= GLOBALFLAG_R
 917                         for keys %{$_->{globals_read}};
 918                 $globalflags[$_] |= GLOBALFLAG_W
 919                         for keys %{$_->{globals_written}};
 920                 next
 921                         if $_->{first_statement} < 0;
 922                 for my $ip($_->{first_statement} .. (@{$progs->{statements}}-1))
 923                 {
 924                         my $s = $progs->{statements}[$ip];
 925                         if($s->{op} eq 'STORE_V')
 926                         {
 927                                 $globalflags[$s->{a}] |= GLOBALFLAG_P
 928                                         if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals};
 929                                 $globalflags[$s->{a}+1] |= GLOBALFLAG_P
 930                                         if $s->{b}+1 >= $_->{parm_start} and $s->{b}+1 < $_->{parm_start} + $_->{locals};
 931                                 $globalflags[$s->{a}+2] |= GLOBALFLAG_P
 932                                         if $s->{b}+2 >= $_->{parm_start} and $s->{b}+2 < $_->{parm_start} + $_->{locals};
 933                         }
 934                         elsif($s->{op} =~ /^STORE_/)
 935                         {
 936                                 $globalflags[$s->{a}] |= GLOBALFLAG_P
 937                                         if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals};
 938                         }
 939                         else
 940                         {
 941                                 last;
 942                         }
 943                 }
 944         }
 945
 946         # parameter passing globals are only ever used in STORE_ instructions
 947         for my $s(@{$progs->{statements}})
 948         {
 949                 next
 950                         if $s->{op} =~ /^STORE_/;
 951
 952                 my $c = checkop $s->{op};
 953
 954                 for(qw(a b c))
 955                 {
 956                         my $type = $c->{$_};
 957                         next
 958                                 unless defined $type;
 959
 960                         my $ofs = $s->{$_};
 961                         if($type eq 'inglobal' || $type eq 'inglobalfunc' || $type eq 'outglobal')
 962                         {
 963                                 $globalflags[$ofs] &= ~GLOBALFLAG_P;
 964                         }
 965                         if($type eq 'inglobalvec' || $type eq 'outglobalvec')
 966                         {
 967                                 $globalflags[$ofs] &= ~GLOBALFLAG_P;
 968                                 $globalflags[$ofs+1] &= ~GLOBALFLAG_P;
 969                                 $globalflags[$ofs+2] &= ~GLOBALFLAG_P;
 970                         }
 971                 }
 972         }
 973
 974         my %offsets_saved = ();
 975         for(@{$progs->{globaldefs}})
 976         {
 977                 my $type = $_->{type};
 978                 my $name = $progs->{getstring}->($_->{s_name});
 979                 $name = ''
 980                         if $name eq 'IMMEDIATE' or $name =~ /^\./;
 981                 $_->{debugname} = $name
 982                         if $name ne '';
 983                 $globalflags[$_->{ofs}] |= GLOBALFLAG_D;
 984                 if($type->{save})
 985                 {
 986                         $globalflags[$_->{ofs}] |= GLOBALFLAG_S;
 987                 }
 988                 if(defined $_->{debugname})
 989                 {
 990                         $globalflags[$_->{ofs}] |= GLOBALFLAG_N;
 991                 }
 992         }
 993         # fix up vectors
 994         my @extradefs = ();
 995         for(@{$progs->{globaldefs}})
 996         {
 997                 my $type = $_->{type};
 998                 for my $i(1..(typesize($type->{type})-1))
 999                 {
1000                         # add missing def
1001                         if(!($globalflags[$_->{ofs}+$i] & GLOBALFLAG_D))
1002                         {
1003                                 print "Missing globaldef for a component@{[defined $_->{debugname} ? ' of ' . $_->{debugname} : '']} at $_->{ofs}+$i\n";
1004                                 push @extradefs, {
1005                                         type => {
1006                                                 saved => 0,
1007                                                 type => 'float'
1008                                         },
1009                                         ofs => $_->{ofs} + $i,
1010                                         debugname => defined $_->{debugname} ? $_->{debugname} . "[$i]" : undef
1011                                 };
1012                         }
1013                         # "saved" and "named" states hit adjacent globals too
1014                         $globalflags[$_->{ofs}+$i] |= $globalflags[$_->{ofs}] & (GLOBALFLAG_S | GLOBALFLAG_N | GLOBALFLAG_D);
1015                 }
1016         }
1017         push @{$progs->{globaldefs}}, @extradefs;
1018
1019         my %offsets_initialized = ();
1020         for(0..(@{$progs->{globals}}-1))
1021         {
1022                 if($progs->{globals}[$_]{v}{int})
1023                 {
1024                         $globalflags[$_] |= GLOBALFLAG_I;
1025                 }
1026         }
1027
1028         my @globaltypes = (undef) x @{$progs->{globals}};
1029
1030         my %istemp = ();
1031         for(0..(@{$progs->{globals}}-1))
1032         {
1033                 next
1034                         if $_ < @{(DEFAULTGLOBALS)};
1035                 if(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == 0)
1036                 {
1037                         $globaltypes[$_] = "unused";
1038                 }
1039                 elsif(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == GLOBALFLAG_R)
1040                 {
1041                         # so it is ro
1042                         if(($globalflags[$_] & GLOBALFLAG_N) == GLOBALFLAG_N)
1043                         {
1044                                 $globaltypes[$_] = "read_only";
1045                         }
1046                         elsif(($globalflags[$_] & GLOBALFLAG_S) == 0)
1047                         {
1048                                 $globaltypes[$_] = "const";
1049                         }
1050                         else
1051                         {
1052                                 $globaltypes[$_] = "read_only";
1053                         }
1054                 }
1055                 elsif(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == GLOBALFLAG_W)
1056                 {
1057                         $globaltypes[$_] = "write_only";
1058                 }
1059                 else
1060                 {
1061                         # now we know it is rw
1062                         if(($globalflags[$_] & GLOBALFLAG_N) == GLOBALFLAG_N)
1063                         {
1064                                 $globaltypes[$_] = "global";
1065                         }
1066                         elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == 0)
1067                         {
1068                                 if($globalflags[$_] & GLOBALFLAG_P)
1069                                 {
1070                                         $globaltypes[$_] = "OFS_PARM";
1071                                 }
1072                                 elsif($globalflags[$_] & GLOBALFLAG_Q)
1073                                 {
1074                                         $globaltypes[$_] = "uniquetemp";
1075                                         $istemp{$_} = 0;
1076                                 }
1077                                 else
1078                                 {
1079                                         $globaltypes[$_] = "temp";
1080                                         $istemp{$_} = 1;
1081                                 }
1082                         }
1083                         elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == GLOBALFLAG_I)
1084                         {
1085                                 $globaltypes[$_] = "not_saved";
1086                         }
1087                         else
1088                         {
1089                                 $globaltypes[$_] = "global";
1090                         }
1091                 }
1092         }
1093         $progs->{temps} = \%istemp;
1094
1095         # globaldefs
1096         my @globaldefs = (undef) x @{$progs->{globals}};
1097         for(@{$progs->{globaldefs}})
1098         {
1099                 $globaldefs[$_->{ofs}] //= $_
1100                         if defined $_->{debugname};
1101         }
1102         for(@{$progs->{globaldefs}})
1103         {
1104                 $globaldefs[$_->{ofs}] //= $_;
1105         }
1106         for(0..(@{$progs->{globals}}-1))
1107         {
1108                 $globaldefs[$_] //= {
1109                         ofs => $_,
1110                         s_name => undef,
1111                         debugname => undef,
1112                         type => undef
1113                 };
1114         }
1115         for(0..(@{(DEFAULTGLOBALS)}-1))
1116         {
1117                 $globaldefs[$_] = { ofs => $_, s_name => undef, debugname => DEFAULTGLOBALS->[$_], type => undef };
1118                 $globaltypes[$_] = 'defglobal';
1119         }
1120         my %globaldefs_namecount = ();
1121         for(@globaldefs)
1122         {
1123                 $_->{globaltype} = $globaltypes[$_->{ofs}];
1124                 if(defined $_->{debugname})
1125                 {
1126                         # already has debugname
1127                 }
1128                 elsif($_->{globaltype} eq 'const')
1129                 {
1130                         $_->{debugname} = get_constant($progs, $progs->{globals}[$_->{ofs}]{v});
1131                 }
1132                 else
1133                 {
1134                         $_->{debugname} = "$_->{globaltype}_$_->{ofs}";
1135                 }
1136                 ++$globaldefs_namecount{$_->{debugname}};
1137         }
1138         for(@globaldefs)
1139         {
1140                 next
1141                         if $globaldefs_namecount{$_->{debugname}} <= 1 && !$ENV{FORCE_OFFSETS};
1142                 #print "Not unique: $_->{debugname} at $_->{ofs}\n";
1143                 $_->{debugname} .= "\@$_->{ofs}";
1144         }
1145         $progs->{globaldef_byoffset} = sub
1146         {
1147                 my ($ofs) = @_;
1148                 my $def = $globaldefs[$ofs];
1149                 return $def;
1150         };
1151 }
1152
1153 sub parse_progs($)
1154 {
1155         my ($fh) = @_;
1156
1157         my %p = ();
1158
1159         print STDERR "Parsing header...\n";
1160         $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1;
1161
1162         print STDERR "Parsing strings...\n";
1163         $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
1164         $p{getstring} = sub
1165         {
1166                 my ($startpos) = @_;
1167                 my $endpos = index $p{strings}, "\0", $startpos;
1168                 return substr $p{strings}, $startpos, $endpos - $startpos;
1169         };
1170
1171         print STDERR "Parsing globals...\n";
1172         $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}];
1173
1174         print STDERR "Parsing globaldefs...\n";
1175         $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}];
1176
1177         print STDERR "Range checking globaldefs...\n";
1178         for(0 .. (@{$p{globaldefs}}-1))
1179         {
1180                 my $g = $p{globaldefs}[$_];
1181                 die "Out of range name in globaldef $_"
1182                         if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
1183                 my $name = $p{getstring}->($g->{s_name});
1184                 die "Out of range ofs in globaldef $_ (name: \"$name\")"
1185                         if $g->{ofs} >= $p{globals};
1186         }
1187
1188         print STDERR "Parsing fielddefs...\n";
1189         $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}];
1190
1191         print STDERR "Range checking fielddefs...\n";
1192         for(0 .. (@{$p{fielddefs}}-1))
1193         {
1194                 my $g = $p{fielddefs}[$_];
1195                 die "Out of range name in fielddef $_"
1196                         if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
1197                 my $name = $p{getstring}->($g->{s_name});
1198                 die "Out of range ofs in globaldef $_ (name: \"$name\")"
1199                         if $g->{ofs} >= $p{header}{entityfields};
1200         }
1201
1202         print STDERR "Parsing statements...\n";
1203         $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
1204
1205         print STDERR "Parsing functions...\n";
1206         $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
1207
1208         print STDERR "Range checking functions...\n";
1209         for(0 .. (@{$p{functions}} - 1))
1210         {
1211                 my $f = $p{functions}[$_];
1212                 die "Out of range name in function $_"
1213                         if $f->{s_name} < 0 || $f->{s_name} >= length $p{strings};
1214                 my $name = $p{getstring}->($f->{s_name});
1215                 die "Out of range file in function $_"
1216                         if $f->{s_file} < 0 || $f->{s_file} >= length $p{strings};
1217                 my $file = $p{getstring}->($f->{s_file});
1218                 die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1219                         if $f->{first_statement} >= @{$p{statements}};
1220                 die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1221                         if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}};
1222                 die "Out of range locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1223                         if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} >= @{$p{globals}};
1224                 if($f->{first_statement} >= 0)
1225                 {
1226                         die "Out of range numparms $f->{numparms} in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1227                                 if $f->{numparms} < 0 || $f->{numparms} > 8;
1228                         my $totalparms = 0;
1229                         for(0..($f->{numparms}-1))
1230                         {
1231                                 die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1232                                         unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]};
1233                                 $totalparms += $f->{parm_size}[$_];
1234                         }
1235                         die "Out of range parms in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
1236                                 if $f->{locals} < 0 || $f->{parm_start} + $totalparms >= @{$p{globals}};
1237                 }
1238         }
1239
1240         print STDERR "Range checking statements...\n";
1241         for my $ip(0 .. (@{$p{statements}}-1))
1242         {
1243                 my $s = $p{statements}[$ip];
1244                 my $c = checkop $s->{op};
1245
1246                 for(qw(a b c))
1247                 {
1248                         my $type = $c->{$_};
1249                         next
1250                                 unless defined $type;
1251
1252                         if($type eq 'inglobal' || $type eq 'inglobalfunc')
1253                         {
1254                                 $s->{$_} &= 0xFFFF;
1255                                 die "Out of range global offset in statement $ip - cannot continue"
1256                                         if $s->{$_} >= @{$p{globals}};
1257                         }
1258                         elsif($type eq 'inglobalvec')
1259                         {
1260                                 $s->{$_} &= 0xFFFF;
1261                                 die "Out of range global offset in statement $ip - cannot continue"
1262                                         if $s->{$_} >= @{$p{globals}}-2;
1263                         }
1264                         elsif($type eq 'outglobal')
1265                         {
1266                                 $s->{$_} &= 0xFFFF;
1267                                 die "Out of range global offset in statement $ip - cannot continue"
1268                                         if $s->{$_} >= @{$p{globals}};
1269                         }
1270                         elsif($type eq 'outglobalvec')
1271                         {
1272                                 $s->{$_} &= 0xFFFF;
1273                                 die "Out of range global offset in statement $ip - cannot continue"
1274                                         if $s->{$_} >= @{$p{globals}}-2;
1275                         }
1276                         elsif($type eq 'ipoffset')
1277                         {
1278                                 die "Out of range GOTO/IF/IFNOT in statement $ip - cannot continue"
1279                                         if $ip + $s->{$_} < 0 || $ip + $s->{$_} >= @{$p{statements}};
1280                         }
1281                 }
1282         }
1283
1284         print STDERR "Looking for error()...\n";
1285         $p{error_func} = {};
1286         for(@{$p{globaldefs}})
1287         {
1288                 next
1289                         if $p{getstring}($_->{s_name}) ne 'error';
1290                 my $v = $p{globals}[$_->{ofs}]{v}{int};
1291                 next
1292                         if $v <= 0 || $v >= @{$p{functions}};
1293                 my $first = $p{functions}[$v]{first_statement};
1294                 next
1295                         if $first >= 0;
1296                 print STDERR "Detected error() at offset $_->{ofs} (builtin #@{[-$first]})\n";
1297                 $p{error_func}{$_->{ofs}} = 1;
1298         }
1299
1300         print STDERR "Scanning functions...\n";
1301         for(@{$p{functions}})
1302         {
1303                 my $file = $p{getstring}->($_->{s_file});
1304                 my $name = $p{getstring}->($_->{s_name});
1305                 $name = "$file:$name"
1306                         if length $file;
1307                 $_->{debugname} = $name;
1308
1309                 next
1310                         if $_->{first_statement} < 0;
1311
1312                 my %statements = ();
1313                 my %come_from = ();
1314                 my %go_to = ();
1315                 my %globals_read = ();
1316                 my %globals_written = ();
1317                 my %globals_used = ();
1318
1319                 if($_->{first_statement} >= 0)
1320                 {
1321                         run_nfa \%p, $_->{first_statement}, "", id, nfa_default_state_checker,
1322                                 sub
1323                                 {
1324                                         my ($ip, $state, $s, $c) = @_;
1325                                         ++$statements{$ip};
1326
1327                                         if(my $j = $c->{isjump})
1328                                         {
1329                                                 my $t = $ip + $s->{$j};
1330                                                 $come_from{$t}{$ip} = $c->{isconditional};
1331                                                 $go_to{$ip}{$t} = $c->{isconditional};
1332                                         }
1333
1334                                         for my $o(qw(a b c))
1335                                         {
1336                                                 my $type = $c->{$o}
1337                                                         or next;
1338                                                 my $ofs = $s->{$o};
1339
1340                                                 my $read = sub
1341                                                 {
1342                                                         my ($ofs) = @_;
1343                                                         $globals_read{$ofs}{$ip}{$o} = 1;
1344                                                         $globals_used{$ofs} = 1;
1345                                                 };
1346                                                 my $write = sub
1347                                                 {
1348                                                         my ($ofs) = @_;
1349                                                         $globals_written{$ofs}{$ip}{$o} = 1;
1350                                                         $globals_used{$ofs} = 1;
1351                                                 };
1352
1353                                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
1354                                                 {
1355                                                         $read->($ofs);
1356                                                 }
1357                                                 elsif($type eq 'inglobalvec')
1358                                                 {
1359                                                         $read->($ofs);
1360                                                         $read->($ofs+1);
1361                                                         $read->($ofs+2);
1362                                                 }
1363                                                 elsif($type eq 'outglobal')
1364                                                 {
1365                                                         $write->($ofs);
1366                                                 }
1367                                                 elsif($type eq 'outglobalvec')
1368                                                 {
1369                                                         $write->($ofs);
1370                                                         $write->($ofs+1);
1371                                                         $write->($ofs+2);
1372                                                 }
1373                                         }
1374
1375                                         return 0;
1376                                 };
1377                 }
1378
1379                 $_->{statements} = \%statements;
1380                 $_->{come_from} = \%come_from;
1381                 $_->{go_to} = \%go_to;
1382                 $_->{globals_read} = \%globals_read;
1383                 $_->{globals_written} = \%globals_written;
1384                 $_->{globals_used} = \%globals_used;
1385
1386                 # using this info, we could now identify basic blocks
1387         }
1388
1389         print STDERR "Detecting constants and temps, and naming...\n";
1390         detect_constants \%p;
1391
1392         if($ENV{DUMP})
1393         {
1394                 use Data::Dumper;
1395                 print Dumper \%p;
1396                 return;
1397         }
1398
1399         # what do we want to do?
1400         my $checkfunc = \&find_uninitialized_locals;
1401         if($ENV{DISASSEMBLE})
1402         {
1403                 $checkfunc = \&disassemble_function;
1404         }
1405         for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
1406         {
1407                 $checkfunc->(\%p, $_);
1408         }
1409 }
1410
1411 open my $fh, '<', $ARGV[0];
1412 parse_progs $fh;