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(@$_)
 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                                                         push @{$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                                                         push @{$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                         }
 745                         if($c->{iscall})
 746                         {
 747                                 # builtin calls may clobber stuff
 748                                 my $func = $s->{a};
 749                                 my $funcid = $progs->{globals}[$func]{v}{int};
 750                                 my $funcobj = $progs->{functions}[$funcid];
 751                                 if(!$funcobj || $funcobj->{first_statement} >= 0)
 752                                 {
 753                                         # invalidate temps
 754                                         for(values %$state)
 755                                         {
 756                                                 if($_->{flags} & WATCHME_T)
 757                                                 {
 758                                                         $_->{valid} = [-1, undef, undef];
 759                                                 }
 760                                         }
 761                                 }
 762                         }
 763
 764                         return 0;
 765                 };
 766
 767         for my $ip(keys %write_places)
 768         {
 769                 for my $operand(keys %{$write_places{$ip}})
 770                 {
 771                         # TODO verify it
 772                         my %left = map { $_ => 1 } @{$write_places{$ip}{$operand}};
 773                         my $isread = 0;
 774
 775                         my %writeplace_seen = ();
 776                         run_nfa $progs, $ip+1, \%left,
 777                                 sub
 778                                 {
 779                                         return { %{$_[0]} };
 780                                 },
 781                                 sub
 782                                 {
 783                                         my ($ip, $state) = @_;
 784                                         return $writeplace_seen{"$ip " . join " ", sort keys %$state}++;
 785                                 },
 786                                 sub
 787                                 {
 788                                         my ($ip, $state, $s, $c) = @_;
 789                                         for(qw(a b c))
 790                                         {
 791                                                 my $type = $c->{$_};
 792                                                 next
 793                                                         unless defined $type;
 794
 795                                                 my $ofs = $s->{$_};
 796                                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
 797                                                 {
 798                                                         if($state->{$ofs})
 799                                                         {
 800                                                                 $isread = 1;
 801                                                                 return -1; # exit TOTALLY
 802                                                         }
 803                                                 }
 804                                                 elsif($type eq 'inglobalvec')
 805                                                 {
 806                                                         if($state->{$ofs} || $state->{$ofs+1} || $state->{$ofs+2})
 807                                                         {
 808                                                                 $isread = 1;
 809                                                                 return -1; # exit TOTALLY
 810                                                         }
 811                                                 }
 812                                                 elsif($type eq 'outglobal')
 813                                                 {
 814                                                         delete $state->{$ofs};
 815                                                         return 1
 816                                                                 if !%$state;
 817                                                 }
 818                                                 elsif($type eq 'outglobalvec')
 819                                                 {
 820                                                         delete $state->{$ofs};
 821                                                         delete $state->{$ofs+1};
 822                                                         delete $state->{$ofs+2};
 823                                                         return 1
 824                                                                 if !%$state;
 825                                                 }
 826                                         }
 827                                         return 0;
 828                                 };
 829
 830                         if(!$isread)
 831                         {
 832                                 push @{$warned{$ip}{$operand}}, "Value is never used";
 833                         }
 834                 }
 835         }
 836
 837         disassemble_function($progs, $func, \%warned)
 838                 if keys %warned;
 839 }
 840
 841 use constant DEFAULTGLOBALS => [
 842         "OFS_NULL",
 843         "OFS_RETURN",
 844         "OFS_RETURN[1]",
 845         "OFS_RETURN[2]",
 846         "OFS_PARM0",
 847         "OFS_PARM0[1]",
 848         "OFS_PARM0[2]",
 849         "OFS_PARM1",
 850         "OFS_PARM1[1]",
 851         "OFS_PARM1[2]",
 852         "OFS_PARM2",
 853         "OFS_PARM2[1]",
 854         "OFS_PARM2[2]",
 855         "OFS_PARM3",
 856         "OFS_PARM3[1]",
 857         "OFS_PARM3[2]",
 858         "OFS_PARM4",
 859         "OFS_PARM4[1]",
 860         "OFS_PARM4[2]",
 861         "OFS_PARM5",
 862         "OFS_PARM5[1]",
 863         "OFS_PARM5[2]",
 864         "OFS_PARM6",
 865         "OFS_PARM6[1]",
 866         "OFS_PARM6[2]",
 867         "OFS_PARM7",
 868         "OFS_PARM7[1]",
 869         "OFS_PARM7[2]"
 870 ];
 871
 872 sub defaultglobal($)
 873 {
 874         my ($ofs) = @_;
 875         if($ofs < @{(DEFAULTGLOBALS)})
 876         {
 877                 return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
 878         }
 879         return { ofs => $ofs, s_name => undef, debugname => "<undefined>\@$ofs", type => undef };
 880 }
 881
 882 sub detect_constants($)
 883 {
 884         my ($progs) = @_;
 885         use constant GLOBALFLAG_R => 1; # read
 886         use constant GLOBALFLAG_W => 2; # written
 887         use constant GLOBALFLAG_S => 4; # saved
 888         use constant GLOBALFLAG_I => 8; # initialized
 889         use constant GLOBALFLAG_N => 16; # named
 890         use constant GLOBALFLAG_Q => 32; # unique to function
 891         use constant GLOBALFLAG_U => 64; # unused
 892         use constant GLOBALFLAG_P => 128; # possibly parameter passing
 893         my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x @{$progs->{globals}};
 894
 895         for(@{$progs->{functions}})
 896         {
 897                 for(keys %{$_->{globals_used}})
 898                 {
 899                         if($globalflags[$_] & GLOBALFLAG_U)
 900                         {
 901                                 $globalflags[$_] &= ~GLOBALFLAG_U;
 902                         }
 903                         elsif($globalflags[$_] & GLOBALFLAG_Q)
 904                         {
 905                                 $globalflags[$_] &= ~GLOBALFLAG_Q;
 906                         }
 907                 }
 908                 $globalflags[$_] |= GLOBALFLAG_R
 909                         for keys %{$_->{globals_read}};
 910                 $globalflags[$_] |= GLOBALFLAG_W
 911                         for keys %{$_->{globals_written}};
 912                 next
 913                         if $_->{first_statement} < 0;
 914                 for my $ip($_->{first_statement} .. (@{$progs->{statements}}-1))
 915                 {
 916                         my $s = $progs->{statements}[$ip];
 917                         if($s->{op} eq 'STORE_V')
 918                         {
 919                                 $globalflags[$s->{a}] |= GLOBALFLAG_P
 920                                         if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals};
 921                                 $globalflags[$s->{a}+1] |= GLOBALFLAG_P
 922                                         if $s->{b}+1 >= $_->{parm_start} and $s->{b}+1 < $_->{parm_start} + $_->{locals};
 923                                 $globalflags[$s->{a}+2] |= GLOBALFLAG_P
 924                                         if $s->{b}+2 >= $_->{parm_start} and $s->{b}+2 < $_->{parm_start} + $_->{locals};
 925                         }
 926                         elsif($s->{op} =~ /^STORE_/)
 927                         {
 928                                 $globalflags[$s->{a}] |= GLOBALFLAG_P
 929                                         if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals};
 930                         }
 931                         else
 932                         {
 933                                 last;
 934                         }
 935                 }
 936         }
 937
 938         # parameter passing globals are only ever used in STORE_ instructions
 939         for my $s(@{$progs->{statements}})
 940         {
 941                 next
 942                         if $s->{op} =~ /^STORE_/;
 943
 944                 my $c = checkop $s->{op};
 945
 946                 for(qw(a b c))
 947                 {
 948                         my $type = $c->{$_};
 949                         next
 950                                 unless defined $type;
 951
 952                         my $ofs = $s->{$_};
 953                         if($type eq 'inglobal' || $type eq 'inglobalfunc' || $type eq 'outglobal')
 954                         {
 955                                 $globalflags[$ofs] &= ~GLOBALFLAG_P;
 956                         }
 957                         if($type eq 'inglobalvec' || $type eq 'outglobalvec')
 958                         {
 959                                 $globalflags[$ofs] &= ~GLOBALFLAG_P;
 960                                 $globalflags[$ofs+1] &= ~GLOBALFLAG_P;
 961                                 $globalflags[$ofs+2] &= ~GLOBALFLAG_P;
 962                         }
 963                 }
 964         }
 965
 966         my %offsets_saved = ();
 967         for(@{$progs->{globaldefs}})
 968         {
 969                 my $type = $_->{type};
 970                 my $name = $progs->{getstring}->($_->{s_name});
 971                 $name = ''
 972                         if $name eq 'IMMEDIATE' or $name =~ /^\./;
 973                 $_->{debugname} = $name
 974                         if $name ne '';
 975                 if($type->{save})
 976                 {
 977                         for my $i(0..(typesize($_->{type}{type})-1))
 978                         {
 979                                 $globalflags[$_->{ofs}] |= GLOBALFLAG_S;
 980                         }
 981                 }
 982                 if($name ne '')
 983                 {
 984                         for my $i(0..(typesize($_->{type}{type})-1))
 985                         {
 986                                 $globalflags[$_->{ofs}] |= GLOBALFLAG_N;
 987                         }
 988                 }
 989         }
 990         my %offsets_initialized = ();
 991         for(0..(@{$progs->{globals}}-1))
 992         {
 993                 if($progs->{globals}[$_]{v}{int})
 994                 {
 995                         $globalflags[$_] |= GLOBALFLAG_I;
 996                 }
 997         }
 998
 999         my @globaltypes = (undef) x @{$progs->{globals}};
1000
1001         my %istemp = ();
1002         for(0..(@{$progs->{globals}}-1))
1003         {
1004                 next
1005                         if $_ < @{(DEFAULTGLOBALS)};
1006                 if(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == 0)
1007                 {
1008                         $globaltypes[$_] = "unused";
1009                 }
1010                 elsif(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == GLOBALFLAG_R)
1011                 {
1012                         # so it is ro
1013                         if(($globalflags[$_] & GLOBALFLAG_N) == GLOBALFLAG_N)
1014                         {
1015                                 $globaltypes[$_] = "read_only";
1016                         }
1017                         elsif(($globalflags[$_] & GLOBALFLAG_S) == 0)
1018                         {
1019                                 $globaltypes[$_] = "const";
1020                         }
1021                         else
1022                         {
1023                                 $globaltypes[$_] = "read_only";
1024                         }
1025                 }
1026                 elsif(($globalflags[$_] & (GLOBALFLAG_R | GLOBALFLAG_W)) == GLOBALFLAG_W)
1027                 {
1028                         $globaltypes[$_] = "write_only";
1029                 }
1030                 else
1031                 {
1032                         # now we know it is rw
1033                         if(($globalflags[$_] & GLOBALFLAG_N) == GLOBALFLAG_N)
1034                         {
1035                                 $globaltypes[$_] = "global";
1036                         }
1037                         elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == 0)
1038                         {
1039                                 if($globalflags[$_] & GLOBALFLAG_P)
1040                                 {
1041                                         $globaltypes[$_] = "OFS_PARM";
1042                                 }
1043                                 elsif($globalflags[$_] & GLOBALFLAG_Q)
1044                                 {
1045                                         $globaltypes[$_] = "uniquetemp";
1046                                         $istemp{$_} = 0;
1047                                 }
1048                                 else
1049                                 {
1050                                         $globaltypes[$_] = "temp";
1051                                         $istemp{$_} = 1;
1052                                 }
1053                         }
1054                         elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == GLOBALFLAG_I)
1055                         {
1056                                 $globaltypes[$_] = "not_saved";
1057                         }
1058                         else
1059                         {
1060                                 $globaltypes[$_] = "global";
1061                         }
1062                 }
1063         }
1064         $progs->{temps} = \%istemp;
1065
1066         # globaldefs
1067         my @globaldefs = (undef) x @{$progs->{globals}};
1068         for(@{$progs->{globaldefs}})
1069         {
1070                 $globaldefs[$_->{ofs}] //= $_
1071                         if defined $_->{debugname};
1072         }
1073         for(@{$progs->{globaldefs}})
1074         {
1075                 $globaldefs[$_->{ofs}] //= $_;
1076         }
1077         for(0..(@{$progs->{globals}}-1))
1078         {
1079                 $globaldefs[$_] //= {
1080                         ofs => $_,
1081                         s_name => undef,
1082                         debugname => undef
1083                 };
1084         }
1085         for(0..(@{(DEFAULTGLOBALS)}-1))
1086         {
1087                 $globaldefs[$_] = { ofs => $_, s_name => undef, debugname => DEFAULTGLOBALS->[$_], type => undef };
1088                 $globaltypes[$_] = 'defglobal';
1089         }
1090         my %globaldefs_namecount = ();
1091         for(@globaldefs)
1092         {
1093                 $_->{globaltype} = $globaltypes[$_->{ofs}];
1094                 if(defined $_->{debugname})
1095                 {
1096                         # already has debugname
1097                 }
1098                 elsif($_->{globaltype} eq 'const')
1099                 {
1100                         $_->{debugname} = get_constant($progs, $progs->{globals}[$_->{ofs}]{v});
1101                 }
1102                 else
1103                 {
1104                         $_->{debugname} = "$_->{globaltype}_$_->{ofs}";
1105                 }
1106                 ++$globaldefs_namecount{$_->{debugname}};
1107         }
1108         for(@globaldefs)
1109         {
1110                 next
1111                         if $globaldefs_namecount{$_->{debugname}} <= 1 && !$ENV{FORCE_OFFSETS};
1112                 #print "Not unique: $_->{debugname} at $_->{ofs}\n";
1113                 $_->{debugname} .= "\@$_->{ofs}";
1114         }
1115         $progs->{globaldef_byoffset} = sub
1116         {
1117                 my ($ofs) = @_;
1118                 my $def = $globaldefs[$ofs];
1119                 return $def;
1120         };
1121 }
1122
1123 sub parse_progs($)
1124 {
1125         my ($fh) = @_;
1126
1127         my %p = ();
1128
1129         print STDERR "Parsing header...\n";
1130         $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1;
1131
1132         print STDERR "Parsing strings...\n";
1133         $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
1134         $p{getstring} = sub
1135         {
1136                 my ($startpos) = @_;
1137                 my $endpos = index $p{strings}, "\0", $startpos;
1138                 return substr $p{strings}, $startpos, $endpos - $startpos;
1139         };
1140
1141         print STDERR "Parsing globals...\n";
1142         $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}];
1143
1144         print STDERR "Parsing globaldefs...\n";
1145         $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}];
1146
1147         print STDERR "Range checking globaldefs...\n";
1148         for(0 .. (@{$p{globaldefs}}-1))
1149         {
1150                 my $g = $p{globaldefs}[$_];
1151                 die "Out of range name in globaldef $_"
1152                         if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
1153                 my $name = $p{getstring}->($g->{s_name});
1154                 die "Out of range ofs in globaldef $_ (name: \"$name\")"
1155                         if $g->{ofs} >= $p{globals};
1156         }
1157
1158         print STDERR "Parsing fielddefs...\n";
1159         $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}];
1160
1161         print STDERR "Range checking fielddefs...\n";
1162         for(0 .. (@{$p{fielddefs}}-1))
1163         {
1164                 my $g = $p{fielddefs}[$_];
1165                 die "Out of range name in fielddef $_"
1166                         if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
1167                 my $name = $p{getstring}->($g->{s_name});
1168                 die "Out of range ofs in globaldef $_ (name: \"$name\")"
1169                         if $g->{ofs} >= $p{header}{entityfields};
1170         }
1171
1172         print STDERR "Parsing statements...\n";
1173         $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
1174
1175         print STDERR "Parsing functions...\n";
1176         $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
1177
1178         print STDERR "Range checking functions...\n";
1179         for(0 .. (@{$p{functions}} - 1))
1180         {
1181                 my $f = $p{functions}[$_];
1182                 die "Out of range name in function $_"
1183                         if $f->{s_name} < 0 || $f->{s_name} >= length $p{strings};
1184                 my $name = $p{getstring}->($f->{s_name});
1185                 die "Out of range file in function $_"
1186                         if $f->{s_file} < 0 || $f->{s_file} >= length $p{strings};
1187                 my $file = $p{getstring}->($f->{s_file});
1188                 die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\")"
1189                         if $f->{first_statement} >= @{$p{statements}};
1190                 die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\")"
1191                         if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}};
1192                 die "Out of range locals in function $_ (name: \"$name\", file: \"$file\")"
1193                         if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} >= @{$p{globals}};
1194                 die "Out of range numparms in function $_ (name: \"$name\", file: \"$file\")"
1195                         if $f->{numparms} < 0 || $f->{numparms} > 8;
1196                 my $totalparms = 0;
1197                 for(0..($f->{numparms}-1))
1198                 {
1199                         die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\")"
1200                                 unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]};
1201                         $totalparms += $f->{parm_size}[$_];
1202                 }
1203                 die "Out of range parms in function $_ (name: \"$name\", file: \"$file\")"
1204                         if $f->{locals} < 0 || $f->{parm_start} + $totalparms >= @{$p{globals}};
1205         }
1206
1207         print STDERR "Range checking statements...\n";
1208         for my $ip(0 .. (@{$p{statements}}-1))
1209         {
1210                 my $s = $p{statements}[$ip];
1211                 my $c = checkop $s->{op};
1212
1213                 for(qw(a b c))
1214                 {
1215                         my $type = $c->{$_};
1216                         next
1217                                 unless defined $type;
1218
1219                         if($type eq 'inglobal' || $type eq 'inglobalfunc')
1220                         {
1221                                 $s->{$_} &= 0xFFFF;
1222                                 die "Out of range global offset in statement $ip - cannot continue"
1223                                         if $s->{$_} >= @{$p{globals}};
1224                         }
1225                         elsif($type eq 'inglobalvec')
1226                         {
1227                                 $s->{$_} &= 0xFFFF;
1228                                 die "Out of range global offset in statement $ip - cannot continue"
1229                                         if $s->{$_} >= @{$p{globals}}-2;
1230                         }
1231                         elsif($type eq 'outglobal')
1232                         {
1233                                 $s->{$_} &= 0xFFFF;
1234                                 die "Out of range global offset in statement $ip - cannot continue"
1235                                         if $s->{$_} >= @{$p{globals}};
1236                         }
1237                         elsif($type eq 'outglobalvec')
1238                         {
1239                                 $s->{$_} &= 0xFFFF;
1240                                 die "Out of range global offset in statement $ip - cannot continue"
1241                                         if $s->{$_} >= @{$p{globals}}-2;
1242                         }
1243                         elsif($type eq 'ipoffset')
1244                         {
1245                                 die "Out of range GOTO/IF/IFNOT in statement $ip - cannot continue"
1246                                         if $ip + $s->{$_} < 0 || $ip + $s->{$_} >= @{$p{statements}};
1247                         }
1248                 }
1249         }
1250
1251         print STDERR "Looking for error()...\n";
1252         $p{error_func} = {};
1253         for(@{$p{globaldefs}})
1254         {
1255                 next
1256                         if $p{getstring}($_->{s_name}) ne 'error';
1257                 my $v = $p{globals}[$_->{ofs}]{v}{int};
1258                 next
1259                         if $v <= 0 || $v >= @{$p{functions}};
1260                 my $first = $p{functions}[$v]{first_statement};
1261                 next
1262                         if $first >= 0;
1263                 print STDERR "Detected error() at offset $_->{ofs} (builtin #@{[-$first]})\n";
1264                 $p{error_func}{$_->{ofs}} = 1;
1265         }
1266
1267         print STDERR "Scanning functions...\n";
1268         for(@{$p{functions}})
1269         {
1270                 my $file = $p{getstring}->($_->{s_file});
1271                 my $name = $p{getstring}->($_->{s_name});
1272                 $name = "$file:$name"
1273                         if length $file;
1274                 $_->{debugname} = $name;
1275
1276                 next
1277                         if $_->{first_statement} < 0;
1278
1279                 my %statements = ();
1280                 my %come_from = ();
1281                 my %go_to = ();
1282                 my %globals_read = ();
1283                 my %globals_written = ();
1284                 my %globals_used = ();
1285
1286                 if($_->{first_statement} >= 0)
1287                 {
1288                         run_nfa \%p, $_->{first_statement}, "", id, nfa_default_state_checker,
1289                                 sub
1290                                 {
1291                                         my ($ip, $state, $s, $c) = @_;
1292                                         ++$statements{$ip};
1293
1294                                         if(my $j = $c->{isjump})
1295                                         {
1296                                                 my $t = $ip + $s->{$j};
1297                                                 $come_from{$t}{$ip} = $c->{isconditional};
1298                                                 $go_to{$ip}{$t} = $c->{isconditional};
1299                                         }
1300
1301                                         for my $o(qw(a b c))
1302                                         {
1303                                                 my $type = $c->{$o}
1304                                                         or next;
1305                                                 my $ofs = $s->{$o};
1306
1307                                                 my $read = sub
1308                                                 {
1309                                                         my ($ofs) = @_;
1310                                                         $globals_read{$ofs}{$ip}{$o} = 1;
1311                                                         $globals_used{$ofs} = 1;
1312                                                 };
1313                                                 my $write = sub
1314                                                 {
1315                                                         my ($ofs) = @_;
1316                                                         $globals_written{$ofs}{$ip}{$o} = 1;
1317                                                         $globals_used{$ofs} = 1;
1318                                                 };
1319
1320                                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
1321                                                 {
1322                                                         $read->($ofs);
1323                                                 }
1324                                                 elsif($type eq 'inglobalvec')
1325                                                 {
1326                                                         $read->($ofs);
1327                                                         $read->($ofs+1);
1328                                                         $read->($ofs+2);
1329                                                 }
1330                                                 elsif($type eq 'outglobal')
1331                                                 {
1332                                                         $write->($ofs);
1333                                                 }
1334                                                 elsif($type eq 'outglobalvec')
1335                                                 {
1336                                                         $write->($ofs);
1337                                                         $write->($ofs+1);
1338                                                         $write->($ofs+2);
1339                                                 }
1340                                         }
1341
1342                                         return 0;
1343                                 };
1344                 }
1345
1346                 $_->{statements} = \%statements;
1347                 $_->{come_from} = \%come_from;
1348                 $_->{go_to} = \%go_to;
1349                 $_->{globals_read} = \%globals_read;
1350                 $_->{globals_written} = \%globals_written;
1351                 $_->{globals_used} = \%globals_used;
1352
1353                 # using this info, we could now identify basic blocks
1354         }
1355
1356         print STDERR "Detecting constants and temps, and naming...\n";
1357         detect_constants \%p;
1358
1359         if($ENV{DUMP})
1360         {
1361                 use Data::Dumper;
1362                 print Dumper \%p;
1363                 return;
1364         }
1365
1366         # what do we want to do?
1367         my $checkfunc = \&find_uninitialized_locals;
1368         if($ENV{DISASSEMBLE})
1369         {
1370                 $checkfunc = \&disassemble_function;
1371         }
1372         for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
1373         {
1374                 $checkfunc->(\%p, $_);
1375         }
1376 }
1377
1378 open my $fh, '<', $ARGV[0];
1379 parse_progs $fh;