misc/tools/progs-analyzer.pl

   1 use strict;
   2 use warnings;
   3
   4 sub id()
   5 {
   6         return sub { $_[0]; };
   7 }
   8
   9 sub signed($)
  10 {
  11         my ($bits) = @_;
  12         return sub { $_[0] >= (2**($bits-1)) ? $_[0]-(2**$bits) : $_[0]; };
  13 }
  14
  15 use constant OPCODE_E => [qw[
  16         DONE
  17         MUL_F MUL_V MUL_FV MUL_VF
  18         DIV_F
  19         ADD_F ADD_V
  20         SUB_F SUB_V
  21         EQ_F EQ_V EQ_S EQ_E EQ_FNC
  22         NE_F NE_V NE_S NE_E NE_FNC
  23         LE GE LT GT
  24         LOAD_F LOAD_V LOAD_S LOAD_ENT LOAD_FLD LOAD_FNC
  25         ADDRESS
  26         STORE_F STORE_V STORE_S STORE_ENT STORE_FLD STORE_FNC
  27         STOREP_F STOREP_V STOREP_S STOREP_ENT STOREP_FLD STOREP_FNC
  28         RETURN
  29         NOT_F NOT_V NOT_S NOT_ENT NOT_FNC
  30         IF IFNOT
  31         CALL0 CALL1 CALL2 CALL3 CALL4 CALL5 CALL6 CALL7 CALL8
  32         STATE
  33         GOTO
  34         AND OR
  35         BITAND BITOR
  36 ]];
  37
  38 sub checkop($)
  39 {
  40         my ($op) = @_;
  41         if($op =~ /^IF.*_V$/)
  42         {
  43                 return { a => 'inglobalvec', b => 'immediate', isjump => 'b', isconditional => 1 };
  44         }
  45         if($op =~ /^IF/)
  46         {
  47                 return { a => 'inglobal', b => 'immediate', isjump => 'b', isconditional => 1 };
  48         }
  49         if($op eq 'GOTO')
  50         {
  51                 return { a => 'immediate', isjump => 'a', isconditional => 0 };
  52         }
  53         if($op =~ /^ADD_V$|^SUB_V$/)
  54         {
  55                 return { a => 'inglobalvec', b => 'inglobalvec', c => 'outglobalvec' };
  56         }
  57         if($op =~ /^MUL_V$|^EQ_V$|^NE_V$/)
  58         {
  59                 return { a => 'inglobalvec', b => 'inglobalvec', c => 'outglobal' };
  60         }
  61         if($op eq 'MUL_FV')
  62         {
  63                 return { a => 'inglobal', b => 'inglobalvec', c => 'outglobalvec' };
  64         }
  65         if($op eq 'MUL_VF')
  66         {
  67                 return { a => 'inglobalvec', b => 'inglobal', c => 'outglobalvec' };
  68         }
  69         if($op eq 'LOAD_V')
  70         {
  71                 return { a => 'inglobal', b => 'inglobal', c => 'outglobalvec' };
  72         }
  73         if($op =~ /^NOT_V/)
  74         {
  75                 return { a => 'inglobalvec', c => 'outglobal' };
  76         }
  77         if($op =~ /^NOT_/)
  78         {
  79                 return { a => 'inglobal', c => 'outglobal' };
  80         }
  81         if($op eq 'STOREP_V')
  82         {
  83                 return { a => 'inglobalvec', b => 'inglobal' };
  84         }
  85         if($op eq 'STORE_V')
  86         {
  87                 return { a => 'inglobalvec', b => 'outglobalvec' };
  88         }
  89         if($op =~ /^STOREP_/)
  90         {
  91                 return { a => 'inglobal', b => 'inglobal' };
  92         }
  93         if($op =~ /^STORE_/)
  94         {
  95                 return { a => 'inglobal', b => 'outglobal' };
  96         }
  97         if($op =~ /^CALL/)
  98         {
  99                 return { a => 'inglobalfunc', iscall => 1 };
 100         }
 101         if($op =~ /^DONE|^RETURN/)
 102         {
 103                 return { a => 'inglobal', isreturn => 1 };
 104         }
 105         return { a => 'inglobal', b => 'inglobal', c => 'outglobal' };
 106 }
 107
 108 use constant TYPES => {
 109         int => ['V', 4, signed 32],
 110         ushort => ['v', 2, id],
 111         short => ['v', 2, signed 16],
 112         opcode => ['v', 2, sub { OPCODE_E->[$_[0]] or die "Invalid opcode: $_[0]"; }],
 113         float => ['f', 4, id],
 114         uchar8 => ['a8', 8, sub { [unpack 'C8', $_[0]] }],
 115         global => ['i', 4, sub { { int => $_[0], float => unpack "f", pack "L", $_[0] }; }],
 116 };
 117
 118 use constant DPROGRAMS_T => [
 119         [int => 'version'],
 120         [int => 'crc'],
 121         [int => 'ofs_statements'],
 122         [int => 'numstatements'],
 123         [int => 'ofs_globaldefs'],
 124         [int => 'numglobaldefs'],
 125         [int => 'ofs_fielddefs'],
 126         [int => 'numfielddefs'],
 127         [int => 'ofs_functions'],
 128         [int => 'numfunctions'],
 129         [int => 'ofs_strings'],
 130         [int => 'numstrings'],
 131         [int => 'ofs_globals'],
 132         [int => 'numglobals'],
 133         [int => 'entityfields']
 134 ];
 135
 136 use constant DSTATEMENT_T => [
 137         [opcode => 'op'],
 138         [short => 'a'],
 139         [short => 'b'],
 140         [short => 'c']
 141 ];
 142
 143 use constant DDEF_T => [
 144         [ushort => 'type'],
 145         [ushort => 'ofs'],
 146         [int => 's_name']
 147 ];
 148
 149 use constant DGLOBAL_T => [
 150         [global => 'v'],
 151 ];
 152
 153 use constant DFUNCTION_T => [
 154         [int => 'first_statement'],
 155         [int => 'parm_start'],
 156         [int => 'locals'],
 157         [int => 'profile'],
 158         [int => 's_name'],
 159         [int => 's_file'],
 160         [int => 'numparms'],
 161         [uchar8 => 'parm_size'],
 162 ];
 163
 164 sub get_section($$$)
 165 {
 166         my ($fh, $start, $len) = @_;
 167         seek $fh, $start, 0
 168                 or die "seek: $!";
 169         $len == read $fh, my $buf, $len
 170                 or die "short read";
 171         return $buf;
 172 }
 173
 174 sub parse_section($$$$$)
 175 {
 176         my ($fh, $struct, $start, $len, $cnt) = @_;
 177
 178         my $itemlen = 0;
 179         $itemlen += TYPES->{$_->[0]}->[1]
 180                 for @$struct;
 181         my $packspec = join '', map { TYPES->{$_->[0]}->[0]; } @$struct;
 182         my @packnames = map { $_->[1]; } @$struct;
 183
 184         $len = $cnt * $itemlen
 185                 if not defined $len and defined $cnt;
 186         $cnt = int($len / $itemlen)
 187                 if not defined $cnt and defined $len;
 188         die "Invalid length specification"
 189                 unless defined $len and defined $cnt and $len == $cnt * $itemlen;
 190         die "Invalid length specification in scalar context"
 191                 unless wantarray or $cnt == 1;
 192
 193         seek $fh, $start, 0
 194                 or die "seek: $!";
 195         my @out = map
 196         {
 197                 $itemlen == read $fh, my $buf, $itemlen
 198                         or die "short read";
 199                 my %h = ();
 200                 @h{@packnames} = unpack $packspec, $buf;
 201                 $h{$_->[1]} = TYPES->{$_->[0]}->[2]->($h{$_->[1]})
 202                         for @$struct;
 203                 \%h;
 204         }
 205         0..($cnt-1);
 206         return @out
 207                 if wantarray;
 208         return $out[0];
 209 }
 210
 211 use constant PRE_MARK_STATEMENT => "\e[1m";
 212 use constant POST_MARK_STATEMENT => "\e[m";
 213 use constant PRE_MARK_OPERAND => "\e[41m";
 214 use constant POST_MARK_OPERAND => "\e[49m";
 215
 216 use constant INSTRUCTION_FORMAT => "%8s %3s | %-12s ";
 217 use constant OPERAND_FORMAT => "%s";
 218 use constant OPERAND_SEPARATOR => ", ";
 219 use constant INSTRUCTION_SEPARATOR => "\n";
 220
 221 sub str($)
 222 {
 223         my ($str) = @_;
 224         $str =~ s/[\000-\037\\\"\177-\377]/sprintf "\\%03o", ord $&/ge;
 225         return "\"$str\"";
 226 }
 227
 228 sub disassemble_function($$;$)
 229 {
 230         my ($progs, $func, $highlight) = @_;
 231
 232         print "$func->{debugname}:\n";
 233
 234         my $initializer = sub
 235         {
 236                 my ($ofs) = @_;
 237                 my $g = $progs->{globals}[$ofs]{v};
 238                 if($g->{int} == 0)
 239                 {
 240                 }
 241                 elsif($g->{int} < 16777216)
 242                 {
 243                         print " = $g->{int}%";
 244                         if($g->{int} < length $progs->{strings} && $g->{int} > 0)
 245                         {
 246                                 print " " . str($progs->{getstring}->($g->{int}));
 247                         }
 248                 }
 249                 else
 250                 {
 251                         print " = $g->{float}!";
 252                 }
 253         };
 254
 255         printf INSTRUCTION_FORMAT, '', '', '.PARM_START';
 256         printf OPERAND_FORMAT, "$func->{parm_start}";
 257         print INSTRUCTION_SEPARATOR;
 258
 259         printf INSTRUCTION_FORMAT, '', '', '.LOCALS';
 260         printf OPERAND_FORMAT, "$func->{locals}";
 261         print INSTRUCTION_SEPARATOR;
 262
 263         my %override_locals = ();
 264         my $p = $func->{parm_start};
 265         for(0..($func->{numparms}-1))
 266         {
 267                 if($func->{parm_size}[$_] <= 1)
 268                 {
 269                         $override_locals{$p} //= "argv[$_]";
 270                 }
 271                 for my $comp(0..($func->{parm_size}[$_]-1))
 272                 {
 273                         $override_locals{$p} //= "argv[$_][$comp]";
 274                         ++$p;
 275                 }
 276                 printf INSTRUCTION_FORMAT, '', '', '.ARG';
 277                 printf OPERAND_FORMAT, "argv[$_]";
 278                 print OPERAND_SEPARATOR;
 279                 printf OPERAND_FORMAT, $func->{parm_size}[$_];
 280                 print INSTRUCTION_SEPARATOR;
 281         }
 282         for($func->{parm_start}..($func->{parm_start} + $func->{locals} - 1))
 283         {
 284                 next
 285                         if exists $override_locals{$_};
 286                 $override_locals{$_} = "<local>\@$_";
 287
 288                 printf INSTRUCTION_FORMAT, '', '', '.LOCAL';
 289                 printf OPERAND_FORMAT, "<local>\@$_";
 290                 $initializer->($_);
 291                 print INSTRUCTION_SEPARATOR;
 292         }
 293
 294         my $getname = sub
 295         {
 296                 my ($ofs) = @_;
 297                 return $override_locals{$ofs}
 298                         if exists $override_locals{$ofs};
 299                 return $progs->{globaldef_byoffset}->($ofs)->{debugname};
 300         };
 301
 302         my $operand = sub
 303         {
 304                 my ($type, $operand) = @_;
 305                 if($type eq 'inglobal')
 306                 {
 307                         my $name = $getname->($operand);
 308                         printf OPERAND_FORMAT, "$name";
 309                 }
 310                 elsif($type eq 'outglobal')
 311                 {
 312                         my $name = $getname->($operand);
 313                         printf OPERAND_FORMAT, "&$name";
 314                 }
 315                 elsif($type eq 'inglobalvec')
 316                 {
 317                         my $name = $getname->($operand);
 318                         printf OPERAND_FORMAT, "$name\[\]";
 319                 }
 320                 elsif($type eq 'outglobalvec')
 321                 {
 322                         my $name = $getname->($operand);
 323                         printf OPERAND_FORMAT, "&$name\[\]";
 324                 }
 325                 elsif($type eq 'inglobalfunc')
 326                 {
 327                         my $name = $getname->($operand);
 328                         printf OPERAND_FORMAT, "$name()";
 329                 }
 330                 elsif($type eq 'immediate')
 331                 {
 332                         printf OPERAND_FORMAT, "$operand";
 333                 }
 334                 else
 335                 {
 336                         die "unknown type: $type";
 337                 }
 338         };
 339
 340         for my $s($func->{first_statement}..(@{$progs->{statements}}-1))
 341         {
 342                 my $op = $progs->{statements}[$s]{op};
 343                 my $st = $progs->{statements}[$s];
 344                 my $opprop = checkop $op;
 345
 346                 print PRE_MARK_STATEMENT
 347                         if $highlight and $highlight->{$s};
 348
 349                 printf INSTRUCTION_FORMAT, $s, $highlight->{$s} ? "<!>" : "", $op;
 350
 351                 my $cnt = 0;
 352                 for my $o(qw(a b c))
 353                 {
 354                         next
 355                                 if not defined $opprop->{$o};
 356                         print OPERAND_SEPARATOR
 357                                 if $cnt++;
 358                         print PRE_MARK_OPERAND
 359                                 if $highlight and $highlight->{$s} and $highlight->{$s}{$o};
 360                         $operand->($opprop->{$o}, $st->{$o});
 361                         print POST_MARK_OPERAND
 362                                 if $highlight and $highlight->{$s} and $highlight->{$s}{$o};
 363                 }
 364
 365                 print POST_MARK_STATEMENT
 366                         if $highlight and $highlight->{$s};
 367
 368                 print INSTRUCTION_SEPARATOR;
 369
 370                 last if $progs->{function_byoffset}->($s + 1);
 371         }
 372 }
 373
 374 sub find_uninitialized_locals($$)
 375 {
 376         my ($progs, $func) = @_;
 377
 378         no warnings 'recursion';
 379
 380         my %warned = ();
 381
 382         my %instructions_seen;
 383         my $checkinstruction;
 384         $checkinstruction = sub
 385         {
 386                 my ($ip, $watchlist) = @_;
 387                 for(;;)
 388                 {
 389                         my $statestr = join ' ', map { $watchlist->{$_}->{valid}; } sort keys %$watchlist;
 390                         return
 391                                 if $instructions_seen{"$ip $statestr"}++;
 392                         my %s = %{$progs->{statements}[$ip]};
 393                         my %c = %{checkop $s{op}};
 394                         for(qw(a b c))
 395                         {
 396                                 my $x = $s{$_};
 397                                 if(!defined $c{$_})
 398                                 {
 399                                 }
 400                                 elsif($c{$_} eq 'inglobal' || $c{$_} eq 'inglobalfunc')
 401                                 {
 402                                         if($s{op} ne 'OR' && $s{op} ne 'AND') # fteqcc logicops cause this
 403                                         {
 404                                                 if($watchlist->{$x} && !$watchlist->{$x}{valid})
 405                                                 {
 406                                                         print "; Use of uninitialized local $x in $func->{debugname} at $ip.$_\n";
 407                                                         ++$warned{$ip}{$_};
 408                                                 }
 409                                         }
 410                                 }
 411                                 elsif($c{$_} eq 'inglobalvec')
 412                                 {
 413                                         if($s{op} ne 'OR' && $s{op} ne 'AND') # fteqcc logicops cause this
 414                                         {
 415                                                 if(
 416                                                    $watchlist->{$x} && !$watchlist->{$x}{valid}
 417                                                                 ||
 418                                                    $watchlist->{$x+1} && !$watchlist->{$x+1}{valid}
 419                                                                 ||
 420                                                    $watchlist->{$x+2} && !$watchlist->{$x+2}{valid}
 421                                                 )
 422                                                 {
 423                                                         print "; Use of uninitialized local $x in $func->{debugname} at $ip.$_\n";
 424                                                         ++$warned{$ip}{$_};
 425                                                 }
 426                                         }
 427                                 }
 428                                 elsif($c{$_} eq 'outglobal')
 429                                 {
 430                                         $watchlist->{$x}{valid} = 1
 431                                                 if $watchlist->{$x};
 432                                 }
 433                                 elsif($c{$_} eq 'outglobalvec')
 434                                 {
 435                                         $watchlist->{$x}{valid} = 1
 436                                                 if $watchlist->{$x};
 437                                         $watchlist->{$x+1}{valid} = 1
 438                                                 if $watchlist->{$x+1};
 439                                         $watchlist->{$x+2}{valid} = 1
 440                                                 if $watchlist->{$x+2};
 441                                 }
 442                                 elsif($c{$_} eq 'immediate')
 443                                 {
 444                                         # OK
 445                                 }
 446                         }
 447                         if($c{isreturn})
 448                         {
 449                                 last;
 450                         }
 451                         elsif($c{isjump})
 452                         {
 453                                 if($c{isconditional})
 454                                 {
 455                                         $checkinstruction->($ip+1, { map { $_ => { %{$watchlist->{$_}} } } keys %$watchlist });
 456                                         $ip += $s{$c{isjump}};
 457                                 }
 458                                 else
 459                                 {
 460                                         $ip += $s{$c{isjump}};
 461                                 }
 462                         }
 463                         else
 464                         {
 465                                 $ip += 1;
 466                         }
 467                 }
 468         };
 469
 470         return
 471                 if $func->{first_statement} < 0; # builtin
 472
 473
 474         print STDERR "Checking $func->{debugname}...\n";
 475
 476         my $p = $func->{parm_start};
 477         for(0..($func->{numparms}-1))
 478         {
 479                 $p += $func->{parm_size}[$_];
 480         }
 481
 482         use constant WATCHME_R => 1;
 483         use constant WATCHME_W => 2;
 484         use constant WATCHME_X => 4;
 485         use constant WATCHME_T => 8;
 486         my %watchme = map { $_ => WATCHME_X } ($p .. ($func->{parm_start} + $func->{locals} - 1));
 487         # TODO mark temp globals as WATCHME_T
 488
 489         my $fixinitialstate;
 490         $fixinitialstate = sub
 491         {
 492                 my ($ip) = @_;
 493                 for(;;)
 494                 {
 495                         return
 496                                 if $instructions_seen{$ip}++;
 497                         my %s = %{$progs->{statements}[$ip]};
 498                         my %c = %{checkop $s{op}};
 499                         for(qw(a b c))
 500                         {
 501                                 if(!defined $c{$_})
 502                                 {
 503                                 }
 504                                 elsif($c{$_} eq 'inglobal' || $c{$_} eq 'inglobalfunc')
 505                                 {
 506                                         $watchme{$s{$_}} |= WATCHME_R;
 507                                 }
 508                                 elsif($c{$_} eq 'inglobalvec')
 509                                 {
 510                                         $watchme{$s{$_}} |= WATCHME_R;
 511                                         $watchme{$s{$_}+1} |= WATCHME_R;
 512                                         $watchme{$s{$_}+2} |= WATCHME_R;
 513                                 }
 514                                 elsif($c{$_} eq 'outglobal')
 515                                 {
 516                                         $watchme{$s{$_}} |= WATCHME_W;
 517                                 }
 518                                 elsif($c{$_} eq 'outglobalvec')
 519                                 {
 520                                         $watchme{$s{$_}} |= WATCHME_W;
 521                                         $watchme{$s{$_}+1} |= WATCHME_W;
 522                                         $watchme{$s{$_}+2} |= WATCHME_W;
 523                                 }
 524                                 elsif($c{$_} eq 'immediate')
 525                                 {
 526                                         # OK
 527                                 }
 528                         }
 529                         if($c{isreturn})
 530                         {
 531                                 last;
 532                         }
 533                         elsif($c{isjump})
 534                         {
 535                                 if($c{isconditional})
 536                                 {
 537                                         $fixinitialstate->($ip+1);
 538                                         $ip += $s{$c{isjump}};
 539                                 }
 540                                 else
 541                                 {
 542                                         $ip += $s{$c{isjump}};
 543                                 }
 544                         }
 545                         else
 546                         {
 547                                 $ip += 1;
 548                         }
 549                 }
 550         };
 551         %instructions_seen = ();
 552         $fixinitialstate->($func->{first_statement});
 553
 554         for(keys %watchme)
 555         {
 556                 delete $watchme{$_}
 557                         if
 558                                 ($watchme{$_} & (WATCHME_T | WATCHME_X)) == 0
 559                                         or
 560                                 ($watchme{$_} & (WATCHME_R | WATCHME_W)) != (WATCHME_R | WATCHME_W);
 561         }
 562
 563         return
 564                 if not keys %watchme;
 565
 566         for(keys %watchme)
 567         {
 568                 $watchme{$_} = { flags => $watchme{$_}, valid => 0 };
 569         }
 570
 571         %instructions_seen = ();
 572         $checkinstruction->($func->{first_statement}, \%watchme);
 573         disassemble_function($progs, $func, \%warned)
 574                 if keys %warned;
 575 }
 576
 577 use constant DEFAULTGLOBALS => [
 578         "<OFS_NULL>",
 579         "<OFS_RETURN>",
 580         "<OFS_RETURN>[1]",
 581         "<OFS_RETURN>[2]",
 582         "<OFS_PARM0>",
 583         "<OFS_PARM0>[1]",
 584         "<OFS_PARM0>[2]",
 585         "<OFS_PARM1>",
 586         "<OFS_PARM1>[1]",
 587         "<OFS_PARM1>[2]",
 588         "<OFS_PARM2>",
 589         "<OFS_PARM2>[1]",
 590         "<OFS_PARM2>[2]",
 591         "<OFS_PARM3>",
 592         "<OFS_PARM3>[1]",
 593         "<OFS_PARM3>[2]",
 594         "<OFS_PARM4>",
 595         "<OFS_PARM4>[1]",
 596         "<OFS_PARM4>[2]",
 597         "<OFS_PARM5>",
 598         "<OFS_PARM5>[1]",
 599         "<OFS_PARM5>[2]",
 600         "<OFS_PARM6>",
 601         "<OFS_PARM6>[1]",
 602         "<OFS_PARM6>[2]",
 603         "<OFS_PARM7>",
 604         "<OFS_PARM7>[1]",
 605         "<OFS_PARM7>[2]"
 606 ];
 607
 608 sub defaultglobal($)
 609 {
 610         my ($ofs) = @_;
 611         if($ofs < @{(DEFAULTGLOBALS)})
 612         {
 613                 return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
 614         }
 615         return { ofs => $ofs, s_name => undef, debugname => "<undefined>\@$ofs", type => undef };
 616 }
 617
 618 sub parse_progs($)
 619 {
 620         my ($fh) = @_;
 621
 622         my %p = ();
 623
 624         print STDERR "Parsing header...\n";
 625         $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1;
 626
 627         print STDERR "Parsing strings...\n";
 628         $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
 629
 630         print STDERR "Parsing statements...\n";
 631         $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
 632
 633         print STDERR "Parsing globaldefs...\n";
 634         $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}];
 635
 636         print STDERR "Parsing fielddefs...\n";
 637         $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}];
 638
 639         print STDERR "Parsing globals...\n";
 640         $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}];
 641
 642         print STDERR "Parsing functions...\n";
 643         $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
 644
 645         print STDERR "Providing helpers...\n";
 646         $p{getstring} = sub
 647         {
 648                 my ($startpos) = @_;
 649                 my $endpos = index $p{strings}, "\0", $startpos;
 650                 return substr $p{strings}, $startpos, $endpos - $startpos;
 651         };
 652
 653         print STDERR "Naming...\n";
 654
 655         # globaldefs
 656         my @globaldefs = ();
 657         for(@{$p{globaldefs}})
 658         {
 659                 $_->{debugname} = $p{getstring}->($_->{s_name});
 660         }
 661         for(@{$p{globaldefs}})
 662         {
 663                 next
 664                         unless $_->{debugname};
 665                 if(!defined $globaldefs[$_->{ofs}] || length $globaldefs[$_->{ofs}]->{debugname} < length $_->{debugname})
 666                 {
 667                         $globaldefs[$_->{ofs}] = $_;
 668                 }
 669         }
 670         my %globaldefs = ();
 671         for(@{$p{globaldefs}})
 672         {
 673                 $_->{debugname} = "<anon>\@$_->{ofs}"
 674                         if $_->{debugname} eq "";
 675                 ++$globaldefs{$_->{debugname}};
 676         }
 677         for(@{$p{globaldefs}})
 678         {
 679                 next
 680                         if $globaldefs{$_->{debugname}} <= 1;
 681                 $_->{debugname} .= "\@$_->{ofs}";
 682         }
 683         $p{globaldef_byoffset} = sub
 684         {
 685                 my ($ofs) = @_;
 686                 my $def = $globaldefs[$ofs]
 687                         or return defaultglobal $_[0];
 688         };
 689
 690         # functions
 691         my %functions = ();
 692         for(@{$p{functions}})
 693         {
 694                 my $file = $p{getstring}->($_->{s_file});
 695                 my $name = $p{getstring}->($_->{s_name});
 696                 $name = "$file:$name"
 697                         if length $file;
 698                 $_->{debugname} = $name;
 699                 $functions{$_->{first_statement}} = $_;
 700         }
 701         $p{function_byoffset} = sub
 702         {
 703                 my ($ofs) = @_;
 704                 return $functions{$ofs};
 705         };
 706
 707         # what do we want to do?
 708         my $checkfunc = \&find_uninitialized_locals;
 709         for(sort { $a->{debugname} <=> $b->{debugname} } @{$p{functions}})
 710         {
 711                 $checkfunc->(\%p, $_);
 712         }
 713 }
 714
 715 open my $fh, '<', $ARGV[0];
 716 parse_progs $fh;