X-Git-Url: https://git.xonotic.org/?p=xonotic%2Fxonotic.git;a=blobdiff_plain;f=misc%2Ftools%2Fprogs-analyzer.pl;h=026d6af4fcd414458aebea8c4e115998cda1be2e;hp=9f45e52a560795362bd533a8de99972a92d4d10e;hb=091f87902933e2030d8ef045cfcb45c91aed2cd1;hpb=b6f053a53151df4b19e35522a73772e0e55a5b70 diff --git a/misc/tools/progs-analyzer.pl b/misc/tools/progs-analyzer.pl old mode 100644 new mode 100755 index 9f45e52a..026d6af4 --- a/misc/tools/progs-analyzer.pl +++ b/misc/tools/progs-analyzer.pl @@ -1,6 +1,9 @@ +#!/usr/bin/perl + use strict; use warnings; use Digest::SHA; +use Carp; sub id() { @@ -120,6 +123,14 @@ sub checkop($) { return { a => 'inglobalvec', isreturn => 1 }; } + if($op eq 'STATE') + { + return { a => 'inglobal', b => 'inglobalfunc' }; + } + if($op =~ /^INVALID#/) + { + return { isinvalid => 1 }; + } return { a => 'inglobal', b => 'inglobal', c => 'outglobal' }; } @@ -180,13 +191,26 @@ use constant DFUNCTION_T => [ [uchar8 => 'parm_size'], ]; +use constant LNOHEADER_T => [ + [int => 'lnotype'], + [int => 'version'], + [int => 'numglobaldefs'], + [int => 'numglobals'], + [int => 'numfielddefs'], + [int => 'numstatements'], +]; + +use constant LNO_T => [ + [int => 'v'], +]; + sub get_section($$$) { my ($fh, $start, $len) = @_; seek $fh, $start, 0 or die "seek: $!"; $len == read $fh, my $buf, $len - or die "short read"; + or die "short read from $start length $len (malformed progs header)"; return $buf; } @@ -214,7 +238,7 @@ sub parse_section($$$$$) my @out = map { $itemlen == read $fh, my $buf, $itemlen - or die "short read"; + or die "short read from $start length $cnt * $itemlen $(malformed progs header)"; my %h = (); @h{@packnames} = unpack $packspec, $buf; $h{$_->[1]} = TYPES->{$_->[0]}->[2]->($h{$_->[1]}) @@ -353,12 +377,34 @@ sub str($) return "\"$str\""; } +sub debugpos($$$) { + my ($progs, $func, $ip) = @_; + my $s = $func->{debugname}; + if ($progs->{cno}) { + my $column = $progs->{cno}[$ip]{v}; + $s =~ s/:/:$column:/; + } + if ($progs->{lno}) { + my $line = $progs->{lno}[$ip]{v}; + $s =~ s/:/:$line:/; + } + return $s; +} + sub disassemble_function($$;$) { my ($progs, $func, $highlight) = @_; print "$func->{debugname}:\n"; + if($func->{first_statement} < 0) # builtin + { + printf INSTRUCTION_FORMAT, '', '', '.BUILTIN'; + printf OPERAND_FORMAT, -$func->{first_statement}; + print INSTRUCTION_SEPARATOR; + return; + } + my $initializer = sub { my ($ofs) = @_; @@ -488,11 +534,12 @@ sub disassemble_function($$;$) { for(values %{$highlight->{$ip}}) { - for(@$_) + for(sort keys %$_) { print PRE_MARK_STATEMENT; - printf INSTRUCTION_FORMAT, '', '', '.WARN'; - printf OPERAND_FORMAT, "$_ (in $func->{debugname})"; + printf INSTRUCTION_FORMAT, '', '', '.WARN'; + my $pos = debugpos $progs, $func, $ip; + printf OPERAND_FORMAT, "$_ (in $pos)"; print INSTRUCTION_SEPARATOR; } } @@ -502,7 +549,7 @@ sub disassemble_function($$;$) if $highlight and $highlight->{$ip}; my $showip = $opprop->{isjump}; - printf INSTRUCTION_FORMAT, $showip ? $ip : '', $highlight->{$ip} ? "" : "", $op; + printf INSTRUCTION_FORMAT, $showip ? $ip : '', $highlight->{$ip} ? '' : '', $op; my $cnt = 0; for my $o(qw(a b c)) @@ -529,7 +576,6 @@ sub find_uninitialized_locals($$) { my ($progs, $func) = @_; - return if $func->{first_statement} < 0; # builtin @@ -605,32 +651,6 @@ sub find_uninitialized_locals($$) $watchme{$_}{valid} = [1, undef, undef] if defined $watchme{$_}; } - # an initial run of STORE instruction is for receiving extra parameters - # (beyond 8). Only possible if the function is declared as having 8 params. - # Extra parameters behave otherwise like temps, but are initialized at - # startup. - for($func->{first_statement} .. (@{$progs->{statements}}-1)) - { - my $s = $progs->{statements}[$_]; - if($s->{op} eq 'STORE_V') - { - $watchme{$s->{a}}{valid} = [1, undef, undef] - if defined $watchme{$s->{a}}; - $watchme{$s->{a}+1}{valid} = [1, undef, undef] - if defined $watchme{$s->{a}+1}; - $watchme{$s->{a}+2}{valid} = [1, undef, undef] - if defined $watchme{$s->{a}+2}; - } - elsif($s->{op} =~ /^STORE_/) - { - $watchme{$s->{a}}{valid} = [1, undef, undef] - if defined $watchme{$s->{a}}; - } - else - { - last; - } - } my %warned = (); my %ip_seen = (); @@ -687,6 +707,10 @@ sub find_uninitialized_locals($$) } } + if($c->{isinvalid}) + { + ++$warned{$ip}{''}{"Invalid opcode"}; + } for(qw(a b c)) { my $type = $c->{$_}; @@ -708,7 +732,7 @@ sub find_uninitialized_locals($$) # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops) if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) { - push @{$warned{$ip}{$_}}, "Use of uninitialized value"; + ++$warned{$ip}{$_}{"Use of uninitialized value"}; } } elsif($valid->[0] < 0) @@ -716,7 +740,7 @@ sub find_uninitialized_locals($$) # COMPILER BUG of FTEQCC: AND and OR may take uninitialized as second argument (logicops) if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) { - push @{$warned{$ip}{$_}}, "Use of temporary across CALL"; + ++$warned{$ip}{$_}{"Use of temporary across CALL"}; } } else @@ -755,6 +779,13 @@ sub find_uninitialized_locals($$) $write->($ofs+1); $write->($ofs+2); } + elsif($type eq 'ipoffset') + { + ++$warned{$ip}{$_}{"Endless loop"} + if $ofs == 0; + ++$warned{$ip}{$_}{"No-operation jump"} + if $ofs == 1; + } } if($c->{iscall}) { @@ -843,7 +874,7 @@ sub find_uninitialized_locals($$) if(!$isread) { - push @{$warned{$ip}{$operand}}, "Value is never used"; + ++$warned{$ip}{$operand}{"Value is never used"}; } } } @@ -903,7 +934,9 @@ sub detect_constants($) use constant GLOBALFLAG_N => 16; # named use constant GLOBALFLAG_Q => 32; # unique to function use constant GLOBALFLAG_U => 64; # unused - my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x @{$progs->{globals}}; + use constant GLOBALFLAG_P => 128; # possibly parameter passing + use constant GLOBALFLAG_D => 256; # has a def + my @globalflags = (GLOBALFLAG_Q | GLOBALFLAG_U) x (@{$progs->{globals}} + 2); for(@{$progs->{functions}}) { @@ -922,6 +955,58 @@ sub detect_constants($) for keys %{$_->{globals_read}}; $globalflags[$_] |= GLOBALFLAG_W for keys %{$_->{globals_written}}; + next + if $_->{first_statement} < 0; + for my $ip($_->{first_statement} .. (@{$progs->{statements}}-1)) + { + my $s = $progs->{statements}[$ip]; + if($s->{op} eq 'STORE_V') + { + $globalflags[$s->{a}] |= GLOBALFLAG_P + if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals}; + $globalflags[$s->{a}+1] |= GLOBALFLAG_P + if $s->{b}+1 >= $_->{parm_start} and $s->{b}+1 < $_->{parm_start} + $_->{locals}; + $globalflags[$s->{a}+2] |= GLOBALFLAG_P + if $s->{b}+2 >= $_->{parm_start} and $s->{b}+2 < $_->{parm_start} + $_->{locals}; + } + elsif($s->{op} =~ /^STORE_/) + { + $globalflags[$s->{a}] |= GLOBALFLAG_P + if $s->{b} >= $_->{parm_start} and $s->{b} < $_->{parm_start} + $_->{locals}; + } + else + { + last; + } + } + } + + # parameter passing globals are only ever used in STORE_ instructions + for my $s(@{$progs->{statements}}) + { + next + if $s->{op} =~ /^STORE_/; + + my $c = checkop $s->{op}; + + for(qw(a b c)) + { + my $type = $c->{$_}; + next + unless defined $type; + + my $ofs = $s->{$_}; + if($type eq 'inglobal' || $type eq 'inglobalfunc' || $type eq 'outglobal') + { + $globalflags[$ofs] &= ~GLOBALFLAG_P; + } + if($type eq 'inglobalvec' || $type eq 'outglobalvec') + { + $globalflags[$ofs] &= ~GLOBALFLAG_P; + $globalflags[$ofs+1] &= ~GLOBALFLAG_P; + $globalflags[$ofs+2] &= ~GLOBALFLAG_P; + } + } } my %offsets_saved = (); @@ -929,21 +1014,46 @@ sub detect_constants($) { my $type = $_->{type}; my $name = $progs->{getstring}->($_->{s_name}); + $name = '' + if $name eq 'IMMEDIATE' or $name =~ /^\./; + $_->{debugname} = $name + if $name ne ''; + $globalflags[$_->{ofs}] |= GLOBALFLAG_D; if($type->{save}) { - for my $i(0..(typesize($_->{type}{type})-1)) - { - $globalflags[$_->{ofs}] |= GLOBALFLAG_S; - } + $globalflags[$_->{ofs}] |= GLOBALFLAG_S; + } + if(defined $_->{debugname}) + { + $globalflags[$_->{ofs}] |= GLOBALFLAG_N; } - if($name ne "") + } + # fix up vectors + my @extradefs = (); + for(@{$progs->{globaldefs}}) + { + my $type = $_->{type}; + for my $i(1..(typesize($type->{type})-1)) { - for my $i(0..(typesize($_->{type}{type})-1)) + # add missing def + if(!($globalflags[$_->{ofs}+$i] & GLOBALFLAG_D)) { - $globalflags[$_->{ofs}] |= GLOBALFLAG_N; + print "Missing globaldef for a component@{[defined $_->{debugname} ? ' of ' . $_->{debugname} : '']} at $_->{ofs}+$i\n"; + push @extradefs, { + type => { + saved => 0, + type => 'float' + }, + ofs => $_->{ofs} + $i, + debugname => defined $_->{debugname} ? $_->{debugname} . "[$i]" : undef + }; } + # "saved" and "named" states hit adjacent globals too + $globalflags[$_->{ofs}+$i] |= $globalflags[$_->{ofs}] & (GLOBALFLAG_S | GLOBALFLAG_N | GLOBALFLAG_D); } } + push @{$progs->{globaldefs}}, @extradefs; + my %offsets_initialized = (); for(0..(@{$progs->{globals}}-1)) { @@ -991,15 +1101,22 @@ sub detect_constants($) { $globaltypes[$_] = "global"; } - elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I | GLOBALFLAG_Q)) == GLOBALFLAG_Q) - { - $globaltypes[$_] = "uniquetemp"; - $istemp{$_} = 0; - } - elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I | GLOBALFLAG_Q)) == 0) + elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == 0) { - $globaltypes[$_] = "temp"; - $istemp{$_} = 1; + if($globalflags[$_] & GLOBALFLAG_P) + { + $globaltypes[$_] = "OFS_PARM"; + } + elsif($globalflags[$_] & GLOBALFLAG_Q) + { + $globaltypes[$_] = "uniquetemp"; + $istemp{$_} = 0; + } + else + { + $globaltypes[$_] = "temp"; + $istemp{$_} = 1; + } } elsif(($globalflags[$_] & (GLOBALFLAG_S | GLOBALFLAG_I)) == GLOBALFLAG_I) { @@ -1014,13 +1131,7 @@ sub detect_constants($) $progs->{temps} = \%istemp; # globaldefs - my @globaldefs = (undef) x @{$progs->{globaldefs}}; - for(@{$progs->{globaldefs}}) - { - my $s = $progs->{getstring}->($_->{s_name}); - $_->{debugname} //= "\$" . "$s" - if length $s; - } + my @globaldefs = (undef) x @{$progs->{globals}}; for(@{$progs->{globaldefs}}) { $globaldefs[$_->{ofs}] //= $_ @@ -1035,7 +1146,8 @@ sub detect_constants($) $globaldefs[$_] //= { ofs => $_, s_name => undef, - debugname => undef + debugname => undef, + type => undef }; } for(0..(@{(DEFAULTGLOBALS)}-1)) @@ -1064,7 +1176,7 @@ sub detect_constants($) for(@globaldefs) { next - if $globaldefs_namecount{$_->{debugname}} <= 1; + if $globaldefs_namecount{$_->{debugname}} <= 1 && !$ENV{FORCE_OFFSETS}; #print "Not unique: $_->{debugname} at $_->{ofs}\n"; $_->{debugname} .= "\@$_->{ofs}"; } @@ -1076,15 +1188,40 @@ sub detect_constants($) }; } -sub parse_progs($) +sub parse_progs($$) { - my ($fh) = @_; + my ($fh, $lnofh) = @_; my %p = (); print STDERR "Parsing header...\n"; $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1; + if (defined $lnofh) { + print STDERR "Parsing LNO...\n"; + my $lnoheader = parse_section $lnofh, LNOHEADER_T, 0, undef, 1; + eval { + die "Not a LNOF" + if $lnoheader->{lnotype} != unpack 'V', 'LNOF'; + die "Not version 1" + if $lnoheader->{version} != 1; + die "Not same count of globaldefs" + if $lnoheader->{numglobaldefs} != $p{header}{numglobaldefs}; + die "Not same count of globals" + if $lnoheader->{numglobals} != $p{header}{numglobals}; + die "Not same count of fielddefs" + if $lnoheader->{numfielddefs} != $p{header}{numfielddefs}; + die "Not same count of statements" + if $lnoheader->{numstatements} != $p{header}{numstatements}; + $p{lno} = [parse_section $lnofh, LNO_T, 24, undef, $lnoheader->{numstatements}]; + eval { + $p{lno} = [parse_section $lnofh, LNO_T, 24, undef, $lnoheader->{numstatements} * 2]; + $p{cno} = [splice $p{lno}, $lnoheader->{numstatements}]; + print STDERR "Cool, this LNO even has column number info!\n"; + }; + } or warn "Skipping LNO: $@"; + } + print STDERR "Parsing strings...\n"; $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings}; $p{getstring} = sub @@ -1094,12 +1231,81 @@ sub parse_progs($) return substr $p{strings}, $startpos, $endpos - $startpos; }; + print STDERR "Parsing globals...\n"; + $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}]; + + print STDERR "Parsing globaldefs...\n"; + $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}]; + + print STDERR "Range checking globaldefs...\n"; + for(0 .. (@{$p{globaldefs}}-1)) + { + my $g = $p{globaldefs}[$_]; + die "Out of range name in globaldef $_" + if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings}; + my $name = $p{getstring}->($g->{s_name}); + die "Out of range ofs $g->{ofs} in globaldef $_ (name: \"$name\")" + if $g->{ofs} >= $p{globals}; + } + + print STDERR "Parsing fielddefs...\n"; + $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}]; + + print STDERR "Range checking fielddefs...\n"; + for(0 .. (@{$p{fielddefs}}-1)) + { + my $g = $p{fielddefs}[$_]; + die "Out of range name in fielddef $_" + if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings}; + my $name = $p{getstring}->($g->{s_name}); + die "Out of range ofs $g->{ofs} in fielddef $_ (name: \"$name\")" + if $g->{ofs} >= $p{header}{entityfields}; + } + print STDERR "Parsing statements...\n"; $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}]; - print STDERR "Fixing statements...\n"; - for my $s(@{$p{statements}}) + print STDERR "Parsing functions...\n"; + $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}]; + + print STDERR "Range checking functions...\n"; + for(0 .. (@{$p{functions}} - 1)) + { + my $f = $p{functions}[$_]; + die "Out of range name in function $_" + if $f->{s_name} < 0 || $f->{s_name} >= length $p{strings}; + my $name = $p{getstring}->($f->{s_name}); + die "Out of range file in function $_" + if $f->{s_file} < 0 || $f->{s_file} >= length $p{strings}; + my $file = $p{getstring}->($f->{s_file}); + die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $f->{first_statement} >= @{$p{statements}}; + if($f->{first_statement} >= 0) + { + die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}}; + die "Out of range locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} > @{$p{globals}}; + die "Out of range numparms $f->{numparms} in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $f->{numparms} < 0 || $f->{numparms} > 8; + my $totalparms = 0; + for(0..($f->{numparms}-1)) + { + die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]}; + $totalparms += $f->{parm_size}[$_]; + } + die "Out of range parms in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $f->{parm_start} + $totalparms > @{$p{globals}}; + die "More parms than locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})" + if $totalparms > $f->{locals}; + } + } + + print STDERR "Range checking statements...\n"; + for my $ip(0 .. (@{$p{statements}}-1)) { + my $s = $p{statements}[$ip]; my $c = checkop $s->{op}; for(qw(a b c)) @@ -1111,35 +1317,45 @@ sub parse_progs($) if($type eq 'inglobal' || $type eq 'inglobalfunc') { $s->{$_} &= 0xFFFF; + die "Out of range global offset in statement $ip - cannot continue" + if $s->{$_} >= @{$p{globals}}; } elsif($type eq 'inglobalvec') { $s->{$_} &= 0xFFFF; + if($c->{isreturn}) + { + die "Out of range global offset in statement $ip - cannot continue" + if $s->{$_} >= @{$p{globals}}; + print "Potentially out of range global offset in statement $ip - may crash engines" + if $s->{$_} >= @{$p{globals}}-2; + } + else + { + die "Out of range global offset in statement $ip - cannot continue" + if $s->{$_} >= @{$p{globals}}-2; + } } elsif($type eq 'outglobal') { $s->{$_} &= 0xFFFF; + die "Out of range global offset in statement $ip - cannot continue" + if $s->{$_} >= @{$p{globals}}; } elsif($type eq 'outglobalvec') { $s->{$_} &= 0xFFFF; + die "Out of range global offset in statement $ip - cannot continue" + if $s->{$_} >= @{$p{globals}}-2; + } + elsif($type eq 'ipoffset') + { + die "Out of range GOTO/IF/IFNOT in statement $ip - cannot continue" + if $ip + $s->{$_} < 0 || $ip + $s->{$_} >= @{$p{statements}}; } } - } - print STDERR "Parsing globaldefs...\n"; - $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}]; - - print STDERR "Parsing fielddefs...\n"; - $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}]; - - print STDERR "Parsing globals...\n"; - $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}]; - - print STDERR "Parsing functions...\n"; - $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}]; - print STDERR "Looking for error()...\n"; $p{error_func} = {}; for(@{$p{globaldefs}}) @@ -1175,62 +1391,65 @@ sub parse_progs($) my %globals_written = (); my %globals_used = (); - run_nfa \%p, $_->{first_statement}, "", id, nfa_default_state_checker, - sub - { - my ($ip, $state, $s, $c) = @_; - ++$statements{$ip}; - - if(my $j = $c->{isjump}) - { - my $t = $ip + $s->{$j}; - $come_from{$t}{$ip} = $c->{isconditional}; - $go_to{$ip}{$t} = $c->{isconditional}; - } - - for my $o(qw(a b c)) + if($_->{first_statement} >= 0) + { + run_nfa \%p, $_->{first_statement}, "", id, nfa_default_state_checker, + sub { - my $type = $c->{$o} - or next; - my $ofs = $s->{$o}; - - my $read = sub - { - my ($ofs) = @_; - $globals_read{$ofs}{$ip}{$o} = 1; - $globals_used{$ofs} = 1; - }; - my $write = sub - { - my ($ofs) = @_; - $globals_written{$ofs}{$ip}{$o} = 1; - $globals_used{$ofs} = 1; - }; + my ($ip, $state, $s, $c) = @_; + ++$statements{$ip}; - if($type eq 'inglobal' || $type eq 'inglobalfunc') - { - $read->($ofs); - } - elsif($type eq 'inglobalvec') + if(my $j = $c->{isjump}) { - $read->($ofs); - $read->($ofs+1); - $read->($ofs+2); + my $t = $ip + $s->{$j}; + $come_from{$t}{$ip} = $c->{isconditional}; + $go_to{$ip}{$t} = $c->{isconditional}; } - elsif($type eq 'outglobal') - { - $write->($ofs); - } - elsif($type eq 'outglobalvec') + + for my $o(qw(a b c)) { - $write->($ofs); - $write->($ofs+1); - $write->($ofs+2); + my $type = $c->{$o} + or next; + my $ofs = $s->{$o}; + + my $read = sub + { + my ($ofs) = @_; + $globals_read{$ofs}{$ip}{$o} = 1; + $globals_used{$ofs} = 1; + }; + my $write = sub + { + my ($ofs) = @_; + $globals_written{$ofs}{$ip}{$o} = 1; + $globals_used{$ofs} = 1; + }; + + if($type eq 'inglobal' || $type eq 'inglobalfunc') + { + $read->($ofs); + } + elsif($type eq 'inglobalvec') + { + $read->($ofs); + $read->($ofs+1); + $read->($ofs+2); + } + elsif($type eq 'outglobal') + { + $write->($ofs); + } + elsif($type eq 'outglobalvec') + { + $write->($ofs); + $write->($ofs+1); + $write->($ofs+2); + } } - } - return 0; - }; + return 0; + }; + } $_->{statements} = \%statements; $_->{come_from} = \%come_from; @@ -1245,14 +1464,34 @@ sub parse_progs($) print STDERR "Detecting constants and temps, and naming...\n"; detect_constants \%p; + if($ENV{DUMP}) + { + use Data::Dumper; + print Dumper \%p; + return; + } + # what do we want to do? my $checkfunc = \&find_uninitialized_locals; - #my $checkfunc = \&disassemble_function; + if($ENV{DISASSEMBLE}) + { + $checkfunc = \&disassemble_function; + } for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}}) { $checkfunc->(\%p, $_); } } -open my $fh, '<', $ARGV[0]; -parse_progs $fh; +for my $progs (@ARGV) { + my $lno = "$progs.lno"; + $lno =~ s/\.dat\.lno$/.lno/; + + open my $fh, '<', $progs + or die "$progs: $!"; + + open my $lnofh, '<', $lno + or warn "$lno: $!"; + + parse_progs $fh, $lnofh; +}