use strict;
use warnings;
+use Digest::SHA;
sub id()
{
AND OR
BITAND BITOR
]];
+use constant ETYPE_E => [qw[
+ void
+ string
+ float
+ vector
+ entity
+ field
+ function
+ pointer
+]];
+use constant DEF_SAVEGLOBAL => 32768;
+sub typesize($)
+{
+ my ($type) = @_;
+ return 3 if $type eq 'vector';
+ return 1;
+}
sub checkop($)
{
my ($op) = @_;
if($op =~ /^IF.*_V$/)
{
- return { a => 'inglobalvec', b => 'immediate', isjump => 'b', isconditional => 1 };
+ return { a => 'inglobalvec', b => 'ipoffset', isjump => 'b', isconditional => 1 };
}
if($op =~ /^IF/)
{
- return { a => 'inglobal', b => 'immediate', isjump => 'b', isconditional => 1 };
+ return { a => 'inglobal', b => 'ipoffset', isjump => 'b', isconditional => 1 };
}
if($op eq 'GOTO')
{
- return { a => 'immediate', isjump => 'a', isconditional => 0 };
+ return { a => 'ipoffset', isjump => 'a', isconditional => 0 };
}
if($op =~ /^ADD_V$|^SUB_V$/)
{
{
return { a => 'inglobalfunc', iscall => 1 };
}
- if($op =~ /^DONE|^RETURN/)
+ if($op =~ /^DONE$|^RETURN$/)
{
- return { a => 'inglobal', isreturn => 1 };
+ return { a => 'inglobalvec', isreturn => 1 };
}
return { a => 'inglobal', b => 'inglobal', c => 'outglobal' };
}
float => ['f', 4, id],
uchar8 => ['a8', 8, sub { [unpack 'C8', $_[0]] }],
global => ['i', 4, sub { { int => $_[0], float => unpack "f", pack "L", $_[0] }; }],
+ deftype => ['v', 2, sub { { type => ETYPE_E->[$_[0] & ~DEF_SAVEGLOBAL], save => !!($_[0] & DEF_SAVEGLOBAL) }; }],
};
use constant DPROGRAMS_T => [
];
use constant DDEF_T => [
- [ushort => 'type'],
+ [deftype => 'type'],
[ushort => 'ofs'],
[int => 's_name']
];
return $out[0];
}
-use constant PRE_MARK_STATEMENT => "\e[1m";
-use constant POST_MARK_STATEMENT => "\e[m";
-use constant PRE_MARK_OPERAND => "\e[41m";
-use constant POST_MARK_OPERAND => "\e[49m";
+sub nfa_default_state_checker()
+{
+ my %seen;
+ return sub
+ {
+ my ($ip, $state) = @_;
+ return $seen{"$ip $state"}++;
+ };
+}
+
+sub run_nfa($$$$$$)
+{
+ my ($progs, $ip, $state, $copy_handler, $state_checker, $instruction_handler) = @_;
+
+ my $statements = $progs->{statements};
+
+ my $nfa;
+ $nfa = sub
+ {
+ no warnings 'recursion';
+
+ my ($ip, $state) = @_;
+ my $ret = 0;
+
+ for(;;)
+ {
+ return $ret
+ if $state_checker->($ip, $state);
+
+ my $s = $statements->[$ip];
+ my $c = checkop $s->{op};
+
+ if(($ret = $instruction_handler->($ip, $state, $s, $c)))
+ {
+ # abort execution
+ last;
+ }
+
+ if($c->{isreturn})
+ {
+ last;
+ }
+ elsif($c->{isjump})
+ {
+ if($c->{isconditional})
+ {
+ if(rand 2)
+ {
+ if(($ret = $nfa->($ip+$s->{$c->{isjump}}, $copy_handler->($state))) < 0)
+ {
+ last;
+ }
+ $ip += 1;
+ }
+ else
+ {
+ $nfa->($ip+1, $copy_handler->($state));
+ $ip += $s->{$c->{isjump}};
+ }
+ }
+ else
+ {
+ $ip += $s->{$c->{isjump}};
+ }
+ }
+ else
+ {
+ $ip += 1;
+ }
+ }
+
+ return $ret;
+ };
+
+ $nfa->($ip, $copy_handler->($state));
+}
+
+sub get_constant($$)
+{
+ my ($progs, $g) = @_;
+ if($g->{int} == 0)
+ {
+ return undef;
+ }
+ elsif($g->{int} > 0 && $g->{int} < 16777216)
+ {
+ if($g->{int} < length $progs->{strings} && $g->{int} > 0)
+ {
+ return str($progs->{getstring}->($g->{int}));
+ }
+ else
+ {
+ return $g->{int} . "i";
+ }
+ }
+ else
+ {
+ return $g->{float};
+ }
+}
+
+use constant PRE_MARK_STATEMENT => "";
+use constant POST_MARK_STATEMENT => "";
+use constant PRE_MARK_OPERAND => "*** ";
+use constant POST_MARK_OPERAND => " ***";
use constant INSTRUCTION_FORMAT => "%8s %3s | %-12s ";
use constant OPERAND_FORMAT => "%s";
my $initializer = sub
{
my ($ofs) = @_;
- my $g = $progs->{globals}[$ofs]{v};
- if($g->{int} == 0)
- {
- }
- elsif($g->{int} < 16777216)
- {
- print " = $g->{int}%";
- if($g->{int} < length $progs->{strings} && $g->{int} > 0)
- {
- print " " . str($progs->{getstring}->($g->{int}));
- }
- }
- else
- {
- print " = $g->{float}!";
- }
+ my $g = get_constant($progs, $progs->{globals}[$ofs]{v});
+ print " = $g"
+ if defined $g;
};
printf INSTRUCTION_FORMAT, '', '', '.PARM_START';
my $p = $func->{parm_start};
for(0..($func->{numparms}-1))
{
- if($func->{parm_size}[$_] <= 1)
- {
- $override_locals{$p} //= "argv[$_]";
- }
+ $override_locals{$p} //= "argv_$_";
for my $comp(0..($func->{parm_size}[$_]-1))
{
- $override_locals{$p} //= "argv[$_][$comp]";
+ $override_locals{$p} //= "argv_$_\[$comp]";
++$p;
}
printf INSTRUCTION_FORMAT, '', '', '.ARG';
- printf OPERAND_FORMAT, "argv[$_]";
+ printf OPERAND_FORMAT, "argv_$_";
print OPERAND_SEPARATOR;
printf OPERAND_FORMAT, $func->{parm_size}[$_];
print INSTRUCTION_SEPARATOR;
{
next
if exists $override_locals{$_};
- $override_locals{$_} = "<local>\@$_";
+ $override_locals{$_} = "local_$_";
printf INSTRUCTION_FORMAT, '', '', '.LOCAL';
- printf OPERAND_FORMAT, "<local>\@$_";
+ printf OPERAND_FORMAT, "local_$_";
$initializer->($_);
print INSTRUCTION_SEPARATOR;
}
my $getname = sub
{
my ($ofs) = @_;
+ $ofs &= 0xFFFF;
return $override_locals{$ofs}
if exists $override_locals{$ofs};
- return $progs->{globaldef_byoffset}->($ofs)->{debugname};
+ my $def = $progs->{globaldef_byoffset}->($ofs);
+ return $def->{debugname};
};
my $operand = sub
{
- my ($type, $operand) = @_;
+ my ($ip, $type, $operand) = @_;
if($type eq 'inglobal')
{
my $name = $getname->($operand);
my $name = $getname->($operand);
printf OPERAND_FORMAT, "$name()";
}
- elsif($type eq 'immediate')
+ elsif($type eq 'ipoffset')
{
- printf OPERAND_FORMAT, "$operand";
+ printf OPERAND_FORMAT, "@{[$ip + $operand]}" . sprintf ' ($%+d)', $operand;
}
else
{
}
};
- for my $s($func->{first_statement}..(@{$progs->{statements}}-1))
+ my %statements = ();
+ my %come_from = ();
+ run_nfa $progs, $func->{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};
+ }
+
+ return 0;
+ };
+
+ my $ipprev = undef;
+ for my $ip(sort { $a <=> $b } keys %statements)
{
- my $op = $progs->{statements}[$s]{op};
- my $st = $progs->{statements}[$s];
+ if($ip == $func->{first_statement})
+ {
+ printf INSTRUCTION_FORMAT, $ip, '', '.ENTRY';
+ print INSTRUCTION_SEPARATOR;
+ }
+ if(defined $ipprev && $ip != $ipprev + 1)
+ {
+ printf INSTRUCTION_FORMAT, $ip, '', '.SKIP';
+ printf OPERAND_FORMAT, $ip - $ipprev - 1;
+ print INSTRUCTION_SEPARATOR;
+ }
+ if(my $cf = $come_from{$ip})
+ {
+ printf INSTRUCTION_FORMAT, $ip, '', '.XREF';
+ my $cnt = 0;
+ for(sort { $a <=> $b } keys %$cf)
+ {
+ print OPERAND_SEPARATOR
+ if $cnt++;
+ printf OPERAND_FORMAT, ($cf->{$_} ? 'c' : 'j') . $_ . sprintf ' ($%+d)', $_ - $ip;
+ }
+ print INSTRUCTION_SEPARATOR;
+ }
+
+ my $op = $progs->{statements}[$ip]{op};
+ my $ipt = $progs->{statements}[$ip];
my $opprop = checkop $op;
print PRE_MARK_STATEMENT
- if $highlight and $highlight->{$s};
+ if $highlight and $highlight->{$ip};
- printf INSTRUCTION_FORMAT, $s, $highlight->{$s} ? "<!>" : "", $op;
+ my $showip = $opprop->{isjump};
+ printf INSTRUCTION_FORMAT, $showip ? $ip : '', $highlight->{$ip} ? "<!>" : "", $op;
my $cnt = 0;
for my $o(qw(a b c))
print OPERAND_SEPARATOR
if $cnt++;
print PRE_MARK_OPERAND
- if $highlight and $highlight->{$s} and $highlight->{$s}{$o};
- $operand->($opprop->{$o}, $st->{$o});
+ if $highlight and $highlight->{$ip} and $highlight->{$ip}{$o};
+ $operand->($ip, $opprop->{$o}, $ipt->{$o});
print POST_MARK_OPERAND
- if $highlight and $highlight->{$s} and $highlight->{$s}{$o};
+ if $highlight and $highlight->{$ip} and $highlight->{$ip}{$o};
}
print POST_MARK_STATEMENT
- if $highlight and $highlight->{$s};
+ if $highlight and $highlight->{$ip};
print INSTRUCTION_SEPARATOR;
-
- last if $progs->{function_byoffset}->($s + 1);
}
}
-sub run_nfa($$$$$$)
-{
- my ($progs, $ip, $state, $copy_handler, $state_hasher, $instruction_handler) = @_;
- my %seen = ();
-
- my $statements = $progs->{statements};
-
- my $nfa;
- $nfa = sub
- {
- no warnings 'recursion';
-
- my ($ip, $state) = @_;
-
- for(;;)
- {
- my $statestr = $state_hasher->($state);
- return
- if $seen{"$ip:$statestr"}++;
-
- my $s = $statements->[$ip];
- my $c = checkop $s->{op};
-
- $instruction_handler->($ip, $state, $s, $c);
-
- if($c->{isreturn})
- {
- last;
- }
- elsif($c->{isjump})
- {
- if($c->{isconditional})
- {
- $nfa->($ip+1, $copy_handler->($state));
- $ip += $s->{$c->{isjump}};
- }
- else
- {
- $ip += $s->{$c->{isjump}};
- }
- }
- else
- {
- $ip += 1;
- }
- }
- };
-
- $nfa->($ip, $copy_handler->($state));
-}
-
sub find_uninitialized_locals($$)
{
my ($progs, $func) = @_;
+
return
if $func->{first_statement} < 0; # builtin
use constant WATCHME_W => 2;
use constant WATCHME_X => 4;
use constant WATCHME_T => 8;
- my %watchme = map { $_ => WATCHME_X } ($p .. ($func->{parm_start} + $func->{locals} - 1));
+ my %watchme = map { $_ => WATCHME_X } ($func->{parm_start} .. ($func->{parm_start} + $func->{locals} - 1));
- # TODO mark temp globals as WATCHME_T
+ for(keys %{$progs->{temps}})
+ {
+ $watchme{$_} = WATCHME_T | WATCHME_X
+ if not exists $watchme{$_};
+ }
- run_nfa $progs, $func->{first_statement}, "", sub { $_[0] }, sub { $_[0] },
+ my %write_places = ();
+ run_nfa $progs, $func->{first_statement}, "", id, nfa_default_state_checker,
sub
{
my ($ip, $state, $s, $c) = @_;
elsif($type eq 'outglobal')
{
$watchme{$ofs} |= WATCHME_W;
+ $write_places{$ip}{$_} = [$ofs]
+ if $watchme{$ofs} & WATCHME_X;
}
elsif($type eq 'outglobalvec')
{
$watchme{$ofs} |= WATCHME_W;
$watchme{$ofs+1} |= WATCHME_W;
$watchme{$ofs+2} |= WATCHME_W;
+ my @l = grep { $watchme{$_} & WATCHME_X } $ofs .. ($ofs+2);
+ $write_places{$ip}{$_} = \@l
+ if @l;
}
}
+
+ return 0;
};
for(keys %watchme)
{
delete $watchme{$_}
- if
- ($watchme{$_} & (WATCHME_T | WATCHME_X)) == 0
- or
- ($watchme{$_} & (WATCHME_R | WATCHME_W)) != (WATCHME_R | WATCHME_W);
+ if ($watchme{$_} & (WATCHME_R | WATCHME_W | WATCHME_X)) != (WATCHME_R | WATCHME_W | WATCHME_X);
}
return
for(keys %watchme)
{
- $watchme{$_} = { flags => $watchme{$_}, valid => 0 };
+ $watchme{$_} = {
+ flags => $watchme{$_},
+ valid => [0, undef, undef]
+ };
+ }
+
+ # mark parameters as initialized
+ for($func->{parm_start} .. ($p-1))
+ {
+ $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 = ();
run_nfa $progs, $func->{first_statement}, \%watchme,
sub {
my ($h) = @_;
return { map { $_ => { %{$h->{$_}} } } keys %$h };
},
sub {
- my ($h) = @_;
- return join ' ', map { $h->{$_}->{valid}; } sort keys %$h;
+ my ($ip, $state) = @_;
+
+ my $s = $ip_seen{$ip};
+ if($s)
+ {
+ # if $state is stronger or equal to $s, return 1
+
+ for(keys %$state)
+ {
+ if($state->{$_}{valid}[0] < $s->{$_})
+ {
+ # The current state is LESS valid than the previously run one. We NEED to run this.
+ # The saved state can safely become the intersection [citation needed].
+ for(keys %$state)
+ {
+ $s->{$_} = $state->{$_}{valid}[0]
+ if $state->{$_}{valid}[0] < $s->{$_};
+ }
+ return 0;
+ }
+ }
+ # if we get here, $state is stronger or equal. No need to try it.
+ return 1;
+ }
+ else
+ {
+ # Never seen this IP yet.
+ $ip_seen{$ip} = { map { ($_ => $state->{$_}{valid}[0]); } keys %$state };
+ return 0;
+ }
},
sub {
my ($ip, $state, $s, $c) = @_;
my $op = $s->{op};
+
+ my $return_hack = $c->{isreturn} // 0;
+
for(qw(a b c))
{
my $type = $c->{$_};
my $ofs = $s->{$_};
- if($type eq 'inglobal' || $type eq 'inglobalfunc')
+ my $read = sub
{
- if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
+ my ($ofs) = @_;
+ ++$return_hack
+ if $return_hack;
+ return
+ if not exists $state->{$ofs};
+ my $valid = $state->{$ofs}{valid};
+ if($valid->[0] == 0)
{
- if($state->{$ofs} && !$state->{$ofs}{valid})
+ if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) # fteqcc logicops cause this
{
- print "; Use of uninitialized local $ofs in $func->{debugname} at $ip.$_\n";
+ print "; Use of uninitialized value $ofs in $func->{debugname} at $ip.$_\n";
++$warned{$ip}{$_};
}
}
- }
- elsif($type eq 'inglobalvec')
- {
- if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
+ elsif($valid->[0] < 0)
{
- if(
- $state->{$ofs} && !$state->{$ofs}{valid}
- ||
- $state->{$ofs+1} && !$state->{$ofs+1}{valid}
- ||
- $state->{$ofs+2} && !$state->{$ofs+2}{valid}
- )
+ if($return_hack <= 2 and ($op ne 'OR' && $op ne 'AND' || $_ ne 'b')) # fteqcc logicops cause this
{
- print "; Use of uninitialized local $ofs in $func->{debugname} at $ip.$_\n";
+ print "; Use of temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
++$warned{$ip}{$_};
}
}
+ else
+ {
+ # it's VALID
+ if(defined $valid->[1])
+ {
+ delete $write_places{$valid->[1]}{$valid->[2]};
+ }
+ }
+ };
+ my $write = sub
+ {
+ my ($ofs) = @_;
+ $state->{$ofs}{valid} = [1, $ip, $_]
+ if exists $state->{$ofs};
+ };
+
+ 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')
{
- $state->{$ofs}{valid} = 1
- if $state->{$ofs};
+ $write->($ofs);
}
elsif($type eq 'outglobalvec')
{
- $state->{$ofs}{valid} = 1
- if $state->{$ofs};
- $state->{$ofs+1}{valid} = 1
- if $state->{$ofs+1};
- $state->{$ofs+2}{valid} = 1
- if $state->{$ofs+2};
+ $write->($ofs);
+ $write->($ofs+1);
+ $write->($ofs+2);
}
}
+ if($c->{iscall})
+ {
+ # builtin calls may clobber stuff
+ my $func = $s->{a};
+ my $funcid = $progs->{globals}[$func]{v}{int};
+ my $funcobj = $progs->{functions}[$funcid];
+ if(!$funcobj || $funcobj->{first_statement} >= 0)
+ {
+ # invalidate temps
+ for(values %$state)
+ {
+ if($_->{flags} & WATCHME_T)
+ {
+ $_->{valid} = [-1, undef, undef];
+ }
+ }
+ }
+ else # builtin
+ {
+ my $def = $progs->{globaldef_byoffset}->($func);
+ return 1
+ if $def->{debugname} eq 'error';
+ }
+ }
+
+ return 0;
};
+
+ for my $ip(keys %write_places)
+ {
+ for my $operand(keys %{$write_places{$ip}})
+ {
+ # TODO verify it
+ my %left = map { $_ => 1 } @{$write_places{$ip}{$operand}};
+ my $isread = 0;
+
+ my %writeplace_seen = ();
+ run_nfa $progs, $ip+1, \%left,
+ sub
+ {
+ return { %{$_[0]} };
+ },
+ sub
+ {
+ my ($ip, $state) = @_;
+ return $writeplace_seen{"$ip " . join " ", sort keys %$state}++;
+ },
+ sub
+ {
+ my ($ip, $state, $s, $c) = @_;
+ for(qw(a b c))
+ {
+ my $type = $c->{$_};
+ next
+ unless defined $type;
+
+ my $ofs = $s->{$_};
+ if($type eq 'inglobal' || $type eq 'inglobalfunc')
+ {
+ if($state->{$ofs})
+ {
+ $isread = 1;
+ return -1; # exit TOTALLY
+ }
+ }
+ elsif($type eq 'inglobalvec')
+ {
+ if($state->{$ofs} || $state->{$ofs+1} || $state->{$ofs+2})
+ {
+ $isread = 1;
+ return -1; # exit TOTALLY
+ }
+ }
+ elsif($type eq 'outglobal')
+ {
+ delete $state->{$ofs};
+ return 1
+ if !%$state;
+ }
+ elsif($type eq 'outglobalvec')
+ {
+ delete $state->{$ofs};
+ delete $state->{$ofs+1};
+ delete $state->{$ofs+2};
+ return 1
+ if !%$state;
+ }
+ }
+ return 0;
+ };
+
+ if(!$isread)
+ {
+ print "; Value is never used in $func->{debugname} at $ip.$operand\n";
+ ++$warned{$ip}{$operand};
+ }
+ }
+ }
disassemble_function($progs, $func, \%warned)
if keys %warned;
}
use constant DEFAULTGLOBALS => [
- "<OFS_NULL>",
- "<OFS_RETURN>",
- "<OFS_RETURN>[1]",
- "<OFS_RETURN>[2]",
- "<OFS_PARM0>",
- "<OFS_PARM0>[1]",
- "<OFS_PARM0>[2]",
- "<OFS_PARM1>",
- "<OFS_PARM1>[1]",
- "<OFS_PARM1>[2]",
- "<OFS_PARM2>",
- "<OFS_PARM2>[1]",
- "<OFS_PARM2>[2]",
- "<OFS_PARM3>",
- "<OFS_PARM3>[1]",
- "<OFS_PARM3>[2]",
- "<OFS_PARM4>",
- "<OFS_PARM4>[1]",
- "<OFS_PARM4>[2]",
- "<OFS_PARM5>",
- "<OFS_PARM5>[1]",
- "<OFS_PARM5>[2]",
- "<OFS_PARM6>",
- "<OFS_PARM6>[1]",
- "<OFS_PARM6>[2]",
- "<OFS_PARM7>",
- "<OFS_PARM7>[1]",
- "<OFS_PARM7>[2]"
+ "OFS_NULL",
+ "OFS_RETURN",
+ "OFS_RETURN[1]",
+ "OFS_RETURN[2]",
+ "OFS_PARM0",
+ "OFS_PARM0[1]",
+ "OFS_PARM0[2]",
+ "OFS_PARM1",
+ "OFS_PARM1[1]",
+ "OFS_PARM1[2]",
+ "OFS_PARM2",
+ "OFS_PARM2[1]",
+ "OFS_PARM2[2]",
+ "OFS_PARM3",
+ "OFS_PARM3[1]",
+ "OFS_PARM3[2]",
+ "OFS_PARM4",
+ "OFS_PARM4[1]",
+ "OFS_PARM4[2]",
+ "OFS_PARM5",
+ "OFS_PARM5[1]",
+ "OFS_PARM5[2]",
+ "OFS_PARM6",
+ "OFS_PARM6[1]",
+ "OFS_PARM6[2]",
+ "OFS_PARM7",
+ "OFS_PARM7[1]",
+ "OFS_PARM7[2]"
];
sub defaultglobal($)
print STDERR "Parsing strings...\n";
$p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
+ $p{getstring} = sub
+ {
+ my ($startpos) = @_;
+ my $endpos = index $p{strings}, "\0", $startpos;
+ return substr $p{strings}, $startpos, $endpos - $startpos;
+ };
print STDERR "Parsing statements...\n";
$p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
print STDERR "Parsing functions...\n";
$p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
- print STDERR "Providing helpers...\n";
- $p{getstring} = sub
+ print STDERR "Detecting temps...\n";
+ my %offsets_saved = ();
+ for(@{$p{globaldefs}})
{
- my ($startpos) = @_;
- my $endpos = index $p{strings}, "\0", $startpos;
- return substr $p{strings}, $startpos, $endpos - $startpos;
- };
+ my $type = $_->{type};
+ my $name = $p{getstring}->($_->{s_name});
+ next
+ unless $type->{save} or $name ne "";
+ for my $i(0..(typesize($_->{type}{type})-1))
+ {
+ ++$offsets_saved{$_->{ofs}+$i};
+ }
+ }
+ my %offsets_initialized = ();
+ for(0..(@{$p{globals}}-1))
+ {
+ if($p{globals}[$_]{v}{int})
+ {
+ ++$offsets_initialized{$_};
+ }
+ }
+ my %istemp = ();
+ my %isconst = ();
+ for(0..(@{$p{globals}}-1))
+ {
+ next
+ if $_ < @{(DEFAULTGLOBALS)};
+ ++$isconst{$_}
+ if !$offsets_saved{$_} and $offsets_initialized{$_};
+ ++$istemp{$_}
+ if !$offsets_saved{$_} and !$offsets_initialized{$_};
+ }
+ $p{temps} = \%istemp;
+ $p{consts} = \%isconst;
print STDERR "Naming...\n";
my @globaldefs = ();
for(@{$p{globaldefs}})
{
- $_->{debugname} = $p{getstring}->($_->{s_name});
+ my $s = $p{getstring}->($_->{s_name});
+ $_->{debugname} //= "_$s"
+ if length $s;
}
for(@{$p{globaldefs}})
{
- next
- unless $_->{debugname};
- if(!defined $globaldefs[$_->{ofs}] || length $globaldefs[$_->{ofs}]->{debugname} < length $_->{debugname})
- {
- $globaldefs[$_->{ofs}] = $_;
- }
+ $globaldefs[$_->{ofs}] //= $_
+ if defined $_->{debugname};
}
- my %globaldefs = ();
for(@{$p{globaldefs}})
{
- $_->{debugname} = "<anon>\@$_->{ofs}"
- if $_->{debugname} eq "";
+ $globaldefs[$_->{ofs}] //= $_;
+ }
+ for(0..(@{$p{globals}}-1))
+ {
+ $globaldefs[$_] //= {
+ ofs => $_,
+ s_name => undef,
+ debugname => undef
+ };
+ }
+ my %globaldefs = ();
+ for(@globaldefs)
+ {
+ if(!defined $_->{debugname})
+ {
+ if($istemp{$_->{ofs}})
+ {
+ $_->{debugname} = "temp_$_->{ofs}";
+ }
+ elsif($isconst{$_->{ofs}})
+ {
+ $_->{debugname} = "(" . get_constant(\%p, $p{globals}[$_->{ofs}]{v}) . ")";
+ }
+ else
+ {
+ $_->{debugname} = "global_$_->{ofs}";
+ }
+ }
++$globaldefs{$_->{debugname}};
}
- for(@{$p{globaldefs}})
+ for(@globaldefs)
{
next
if $globaldefs{$_->{debugname}} <= 1;
+ print "Not unique: $_->{debugname} at $_->{ofs}\n";
$_->{debugname} .= "\@$_->{ofs}";
}
$p{globaldef_byoffset} = sub
{
my ($ofs) = @_;
- my $def = $globaldefs[$ofs]
- or return defaultglobal $_[0];
+ $ofs &= 0xFFFF;
+ if($ofs >= 0 && $ofs < @{(DEFAULTGLOBALS)})
+ {
+ return { ofs => $ofs, s_name => undef, debugname => DEFAULTGLOBALS->[$ofs], type => undef };
+ }
+ my $def = $globaldefs[$ofs];
+ return $def;
};
# functions
# what do we want to do?
my $checkfunc = \&find_uninitialized_locals;
+ #my $checkfunc = \&disassemble_function;
for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
{
$checkfunc->(\%p, $_);
projects / xonotic / xonotic.git / blobdiff