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 run_nfa($$$$$$)
 375 {
 376         my ($progs, $ip, $state, $copy_handler, $state_hasher, $instruction_handler) = @_;
 377         my %seen = ();
 378
 379         my $statements = $progs->{statements};
 380
 381         my $nfa;
 382         $nfa = sub
 383         {
 384                 no warnings 'recursion';
 385
 386                 my ($ip, $state) = @_;
 387
 388                 for(;;)
 389                 {
 390                         my $statestr = $state_hasher->($state);
 391                         return
 392                                 if $seen{"$ip:$statestr"}++;
 393
 394                         my $s = $statements->[$ip];
 395                         my $c = checkop $s->{op};
 396
 397                         $instruction_handler->($ip, $state, $s, $c);
 398
 399                         if($c->{isreturn})
 400                         {
 401                                 last;
 402                         }
 403                         elsif($c->{isjump})
 404                         {
 405                                 if($c->{isconditional})
 406                                 {
 407                                         $nfa->($ip+1, $copy_handler->($state));
 408                                         $ip += $s->{$c->{isjump}};
 409                                 }
 410                                 else
 411                                 {
 412                                         $ip += $s->{$c->{isjump}};
 413                                 }
 414                         }
 415                         else
 416                         {
 417                                 $ip += 1;
 418                         }
 419                 }
 420         };
 421
 422         $nfa->($ip, $copy_handler->($state));
 423 }
 424
 425 sub find_uninitialized_locals($$)
 426 {
 427         my ($progs, $func) = @_;
 428
 429         return
 430                 if $func->{first_statement} < 0; # builtin
 431
 432         print STDERR "Checking $func->{debugname}...\n";
 433
 434         my $p = $func->{parm_start};
 435         for(0..($func->{numparms}-1))
 436         {
 437                 $p += $func->{parm_size}[$_];
 438         }
 439
 440         use constant WATCHME_R => 1;
 441         use constant WATCHME_W => 2;
 442         use constant WATCHME_X => 4;
 443         use constant WATCHME_T => 8;
 444         my %watchme = map { $_ => WATCHME_X } ($p .. ($func->{parm_start} + $func->{locals} - 1));
 445
 446         # TODO mark temp globals as WATCHME_T
 447
 448         run_nfa $progs, $func->{first_statement}, "", sub { $_[0] }, sub { $_[0] },
 449                 sub
 450                 {
 451                         my ($ip, $state, $s, $c) = @_;
 452                         for(qw(a b c))
 453                         {
 454                                 my $type = $c->{$_};
 455                                 next
 456                                         unless defined $type;
 457
 458                                 my $ofs = $s->{$_};
 459                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
 460                                 {
 461                                         $watchme{$ofs} |= WATCHME_R;
 462                                 }
 463                                 elsif($type eq 'inglobalvec')
 464                                 {
 465                                         $watchme{$ofs} |= WATCHME_R;
 466                                         $watchme{$ofs+1} |= WATCHME_R;
 467                                         $watchme{$ofs+2} |= WATCHME_R;
 468                                 }
 469                                 elsif($type eq 'outglobal')
 470                                 {
 471                                         $watchme{$ofs} |= WATCHME_W;
 472                                 }
 473                                 elsif($type eq 'outglobalvec')
 474                                 {
 475                                         $watchme{$ofs} |= WATCHME_W;
 476                                         $watchme{$ofs+1} |= WATCHME_W;
 477                                         $watchme{$ofs+2} |= WATCHME_W;
 478                                 }
 479                         }
 480                 };
 481
 482         for(keys %watchme)
 483         {
 484                 delete $watchme{$_}
 485                         if
 486                                 ($watchme{$_} & (WATCHME_T | WATCHME_X)) == 0
 487                                         or
 488                                 ($watchme{$_} & (WATCHME_R | WATCHME_W)) != (WATCHME_R | WATCHME_W);
 489         }
 490
 491         return
 492                 if not keys %watchme;
 493
 494         for(keys %watchme)
 495         {
 496                 $watchme{$_} = { flags => $watchme{$_}, valid => 0 };
 497         }
 498
 499         my %warned = ();
 500         run_nfa $progs, $func->{first_statement}, \%watchme,
 501                 sub {
 502                         my ($h) = @_;
 503                         return { map { $_ => { %{$h->{$_}} } } keys %$h };
 504                 },
 505                 sub {
 506                         my ($h) = @_;
 507                         return join ' ', map { $h->{$_}->{valid}; } sort keys %$h;
 508                 },
 509                 sub {
 510                         my ($ip, $state, $s, $c) = @_;
 511                         my $op = $s->{op};
 512                         for(qw(a b c))
 513                         {
 514                                 my $type = $c->{$_};
 515                                 next
 516                                         unless defined $type;
 517
 518                                 my $ofs = $s->{$_};
 519
 520                                 if($type eq 'inglobal' || $type eq 'inglobalfunc')
 521                                 {
 522                                         if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
 523                                         {
 524                                                 if($state->{$ofs} && !$state->{$ofs}{valid})
 525                                                 {
 526                                                         print "; Use of uninitialized local $ofs in $func->{debugname} at $ip.$_\n";
 527                                                         ++$warned{$ip}{$_};
 528                                                 }
 529                                         }
 530                                 }
 531                                 elsif($type eq 'inglobalvec')
 532                                 {
 533                                         if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
 534                                         {
 535                                                 if(
 536                                                    $state->{$ofs} && !$state->{$ofs}{valid}
 537                                                                 ||
 538                                                    $state->{$ofs+1} && !$state->{$ofs+1}{valid}
 539                                                                 ||
 540                                                    $state->{$ofs+2} && !$state->{$ofs+2}{valid}
 541                                                 )
 542                                                 {
 543                                                         print "; Use of uninitialized local $ofs in $func->{debugname} at $ip.$_\n";
 544                                                         ++$warned{$ip}{$_};
 545                                                 }
 546                                         }
 547                                 }
 548                                 elsif($type eq 'outglobal')
 549                                 {
 550                                         $state->{$ofs}{valid} = 1
 551                                                 if $state->{$ofs};
 552                                 }
 553                                 elsif($type eq 'outglobalvec')
 554                                 {
 555                                         $state->{$ofs}{valid} = 1
 556                                                 if $state->{$ofs};
 557                                         $state->{$ofs+1}{valid} = 1
 558                                                 if $state->{$ofs+1};
 559                                         $state->{$ofs+2}{valid} = 1
 560                                                 if $state->{$ofs+2};
 561                                 }
 562                         }
 563                 };
 564
 565         disassemble_function($progs, $func, \%warned)
 566                 if keys %warned;
 567 }
 568
 569 use constant DEFAULTGLOBALS => [
 570         "<OFS_NULL>",
 571         "<OFS_RETURN>",
 572         "<OFS_RETURN>[1]",
 573         "<OFS_RETURN>[2]",
 574         "<OFS_PARM0>",
 575         "<OFS_PARM0>[1]",
 576         "<OFS_PARM0>[2]",
 577         "<OFS_PARM1>",
 578         "<OFS_PARM1>[1]",
 579         "<OFS_PARM1>[2]",
 580         "<OFS_PARM2>",
 581         "<OFS_PARM2>[1]",
 582         "<OFS_PARM2>[2]",
 583         "<OFS_PARM3>",
 584         "<OFS_PARM3>[1]",
 585         "<OFS_PARM3>[2]",
 586         "<OFS_PARM4>",
 587         "<OFS_PARM4>[1]",
 588         "<OFS_PARM4>[2]",
 589         "<OFS_PARM5>",
 590         "<OFS_PARM5>[1]",
 591         "<OFS_PARM5>[2]",
 592         "<OFS_PARM6>",
 593         "<OFS_PARM6>[1]",
 594         "<OFS_PARM6>[2]",
 595         "<OFS_PARM7>",
 596         "<OFS_PARM7>[1]",
 597         "<OFS_PARM7>[2]"
 598 ];
 599
 600 sub defaultglobal($)
 601 {
 602         my ($ofs) = @_;
 603         if($ofs < @{(DEFAULTGLOBALS)})
 604         {
 605                 return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
 606         }
 607         return { ofs => $ofs, s_name => undef, debugname => "<undefined>\@$ofs", type => undef };
 608 }
 609
 610 sub parse_progs($)
 611 {
 612         my ($fh) = @_;
 613
 614         my %p = ();
 615
 616         print STDERR "Parsing header...\n";
 617         $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1;
 618
 619         print STDERR "Parsing strings...\n";
 620         $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
 621
 622         print STDERR "Parsing statements...\n";
 623         $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
 624
 625         print STDERR "Parsing globaldefs...\n";
 626         $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}];
 627
 628         print STDERR "Parsing fielddefs...\n";
 629         $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}];
 630
 631         print STDERR "Parsing globals...\n";
 632         $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}];
 633
 634         print STDERR "Parsing functions...\n";
 635         $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
 636
 637         print STDERR "Providing helpers...\n";
 638         $p{getstring} = sub
 639         {
 640                 my ($startpos) = @_;
 641                 my $endpos = index $p{strings}, "\0", $startpos;
 642                 return substr $p{strings}, $startpos, $endpos - $startpos;
 643         };
 644
 645         print STDERR "Naming...\n";
 646
 647         # globaldefs
 648         my @globaldefs = ();
 649         for(@{$p{globaldefs}})
 650         {
 651                 $_->{debugname} = $p{getstring}->($_->{s_name});
 652         }
 653         for(@{$p{globaldefs}})
 654         {
 655                 next
 656                         unless $_->{debugname};
 657                 if(!defined $globaldefs[$_->{ofs}] || length $globaldefs[$_->{ofs}]->{debugname} < length $_->{debugname})
 658                 {
 659                         $globaldefs[$_->{ofs}] = $_;
 660                 }
 661         }
 662         my %globaldefs = ();
 663         for(@{$p{globaldefs}})
 664         {
 665                 $_->{debugname} = "<anon>\@$_->{ofs}"
 666                         if $_->{debugname} eq "";
 667                 ++$globaldefs{$_->{debugname}};
 668         }
 669         for(@{$p{globaldefs}})
 670         {
 671                 next
 672                         if $globaldefs{$_->{debugname}} <= 1;
 673                 $_->{debugname} .= "\@$_->{ofs}";
 674         }
 675         $p{globaldef_byoffset} = sub
 676         {
 677                 my ($ofs) = @_;
 678                 my $def = $globaldefs[$ofs]
 679                         or return defaultglobal $_[0];
 680         };
 681
 682         # functions
 683         my %functions = ();
 684         for(@{$p{functions}})
 685         {
 686                 my $file = $p{getstring}->($_->{s_file});
 687                 my $name = $p{getstring}->($_->{s_name});
 688                 $name = "$file:$name"
 689                         if length $file;
 690                 $_->{debugname} = $name;
 691                 $functions{$_->{first_statement}} = $_;
 692         }
 693         $p{function_byoffset} = sub
 694         {
 695                 my ($ofs) = @_;
 696                 return $functions{$ofs};
 697         };
 698
 699         # what do we want to do?
 700         my $checkfunc = \&find_uninitialized_locals;
 701         for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
 702         {
 703                 $checkfunc->(\%p, $_);
 704         }
 705 }
 706
 707 open my $fh, '<', $ARGV[0];
 708 parse_progs $fh;