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 };
}
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];
}
+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));
+}
+
use constant PRE_MARK_STATEMENT => "\e[1m";
use constant POST_MARK_STATEMENT => "\e[m";
use constant PRE_MARK_OPERAND => "\e[41m";
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]";
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, id,
+ sub
+ {
+ my ($ip, $state, $s, $c) = @_;
+ ++$statements{$ip};
+
+ if(my $j = $c->{isjump})
+ {
+ my $t = $ip + $s->{$j};
+ $come_from{$t}{$ip} = $c->{isconditional};
+ }
+ };
+
+ 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);
}
}
{
my ($progs, $func) = @_;
- no warnings 'recursion';
-
- my %warned = ();
-
- my %instructions_seen;
- my $checkinstruction;
- $checkinstruction = sub
- {
- my ($ip, $watchlist) = @_;
- for(;;)
- {
- my $statestr = join ' ', map { $watchlist->{$_}->{valid}; } sort keys %$watchlist;
- return
- if $instructions_seen{"$ip $statestr"}++;
- my %s = %{$progs->{statements}[$ip]};
- my %c = %{checkop $s{op}};
- for(qw(a b c))
- {
- my $x = $s{$_};
- if(!defined $c{$_})
- {
- }
- elsif($c{$_} eq 'inglobal' || $c{$_} eq 'inglobalfunc')
- {
- if($s{op} ne 'OR' && $s{op} ne 'AND') # fteqcc logicops cause this
- {
- if($watchlist->{$x} && !$watchlist->{$x}{valid})
- {
- print "; Use of uninitialized local $x in $func->{debugname} at $ip.$_\n";
- ++$warned{$ip}{$_};
- }
- }
- }
- elsif($c{$_} eq 'inglobalvec')
- {
- if($s{op} ne 'OR' && $s{op} ne 'AND') # fteqcc logicops cause this
- {
- if(
- $watchlist->{$x} && !$watchlist->{$x}{valid}
- ||
- $watchlist->{$x+1} && !$watchlist->{$x+1}{valid}
- ||
- $watchlist->{$x+2} && !$watchlist->{$x+2}{valid}
- )
- {
- print "; Use of uninitialized local $x in $func->{debugname} at $ip.$_\n";
- ++$warned{$ip}{$_};
- }
- }
- }
- elsif($c{$_} eq 'outglobal')
- {
- $watchlist->{$x}{valid} = 1
- if $watchlist->{$x};
- }
- elsif($c{$_} eq 'outglobalvec')
- {
- $watchlist->{$x}{valid} = 1
- if $watchlist->{$x};
- $watchlist->{$x+1}{valid} = 1
- if $watchlist->{$x+1};
- $watchlist->{$x+2}{valid} = 1
- if $watchlist->{$x+2};
- }
- elsif($c{$_} eq 'immediate')
- {
- # OK
- }
- }
- if($c{isreturn})
- {
- last;
- }
- elsif($c{isjump})
- {
- if($c{isconditional})
- {
- $checkinstruction->($ip+1, { map { $_ => { %{$watchlist->{$_}} } } keys %$watchlist });
- $ip += $s{$c{isjump}};
- }
- else
- {
- $ip += $s{$c{isjump}};
- }
- }
- else
- {
- $ip += 1;
- }
- }
- };
-
return
if $func->{first_statement} < 0; # builtin
-
print STDERR "Checking $func->{debugname}...\n";
my $p = $func->{parm_start};
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));
- # TODO mark temp globals as WATCHME_T
+ my %watchme = map { $_ => WATCHME_X } ($func->{parm_start} .. ($func->{parm_start} + $func->{locals} - 1));
- my $fixinitialstate;
- $fixinitialstate = sub
+ for(keys %{$progs->{temps}})
{
- my ($ip) = @_;
- for(;;)
+ $watchme{$_} = WATCHME_T | WATCHME_X
+ if not exists $watchme{$_};
+ }
+
+ run_nfa $progs, $func->{first_statement}, "", id, id,
+ sub
{
- return
- if $instructions_seen{$ip}++;
- my %s = %{$progs->{statements}[$ip]};
- my %c = %{checkop $s{op}};
+ my ($ip, $state, $s, $c) = @_;
for(qw(a b c))
{
- if(!defined $c{$_})
- {
- }
- elsif($c{$_} eq 'inglobal' || $c{$_} eq 'inglobalfunc')
- {
- $watchme{$s{$_}} |= WATCHME_R;
- }
- elsif($c{$_} eq 'inglobalvec')
- {
- $watchme{$s{$_}} |= WATCHME_R;
- $watchme{$s{$_}+1} |= WATCHME_R;
- $watchme{$s{$_}+2} |= WATCHME_R;
- }
- elsif($c{$_} eq 'outglobal')
- {
- $watchme{$s{$_}} |= WATCHME_W;
- }
- elsif($c{$_} eq 'outglobalvec')
+ my $type = $c->{$_};
+ next
+ unless defined $type;
+
+ my $ofs = $s->{$_};
+ if($type eq 'inglobal' || $type eq 'inglobalfunc')
{
- $watchme{$s{$_}} |= WATCHME_W;
- $watchme{$s{$_}+1} |= WATCHME_W;
- $watchme{$s{$_}+2} |= WATCHME_W;
+ $watchme{$ofs} |= WATCHME_R;
}
- elsif($c{$_} eq 'immediate')
+ elsif($type eq 'inglobalvec')
{
- # OK
+ $watchme{$ofs} |= WATCHME_R;
+ $watchme{$ofs+1} |= WATCHME_R;
+ $watchme{$ofs+2} |= WATCHME_R;
}
- }
- if($c{isreturn})
- {
- last;
- }
- elsif($c{isjump})
- {
- if($c{isconditional})
+ elsif($type eq 'outglobal')
{
- $fixinitialstate->($ip+1);
- $ip += $s{$c{isjump}};
+ $watchme{$ofs} |= WATCHME_W;
}
- else
+ elsif($type eq 'outglobalvec')
{
- $ip += $s{$c{isjump}};
+ $watchme{$ofs} |= WATCHME_W;
+ $watchme{$ofs+1} |= WATCHME_W;
+ $watchme{$ofs+2} |= WATCHME_W;
}
}
- else
- {
- $ip += 1;
- }
- }
- };
- %instructions_seen = ();
- $fixinitialstate->($func->{first_statement});
+ };
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 => ($_ >= $func->{parm_start} && $_ < $p) # preinitialize parameters
+ };
}
- %instructions_seen = ();
- $checkinstruction->($func->{first_statement}, \%watchme);
+ my %warned = ();
+ 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;
+ },
+ sub {
+ my ($ip, $state, $s, $c) = @_;
+ my $op = $s->{op};
+ for(qw(a b c))
+ {
+ my $type = $c->{$_};
+ next
+ unless defined $type;
+
+ my $ofs = $s->{$_};
+
+ my $read = sub
+ {
+ my ($ofs) = @_;
+ return
+ if not exists $state->{$ofs};
+ my $valid = $state->{$ofs}{valid};
+ if($valid == 0)
+ {
+ print "; Use of uninitialized value $ofs in $func->{debugname} at $ip.$_\n";
+ ++$warned{$ip}{$_};
+ }
+ elsif($valid < 0)
+ {
+ print "; Use of temporary $ofs across CALL in $func->{debugname} at $ip.$_\n";
+ ++$warned{$ip}{$_};
+ }
+ };
+ my $write = sub
+ {
+ my ($ofs) = @_;
+ $state->{$ofs}{valid} = 1
+ if exists $state->{$ofs};
+ };
+
+ if($type eq 'inglobal' || $type eq 'inglobalfunc')
+ {
+ if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
+ {
+ $read->($ofs);
+ }
+ }
+ elsif($type eq 'inglobalvec')
+ {
+ if($op ne 'OR' && $op ne 'AND') # fteqcc logicops cause this
+ {
+ $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);
+ }
+ }
+ if($c->{iscall})
+ {
+ # builtin calls may clobber stuff
+ my $func = $s->{a};
+ my $funcid = $progs->{globals}[$func]{v}{int};
+ my $first_statement = $progs->{functions}[$funcid]{first_statement};
+ if($first_statement >= 0)
+ {
+ # invalidate temps
+ for(values %$state)
+ {
+ if($_->{flags} & WATCHME_T)
+ {
+ $_->{valid} = -1;
+ }
+ }
+ }
+ }
+ };
+
disassemble_function($progs, $func, \%warned)
if keys %warned;
}
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;
+ # TODO rather detect consts by only reading instructions
print STDERR "Naming...\n";
}
for(@{$p{globaldefs}})
{
- next
- unless $_->{debugname};
- if(!defined $globaldefs[$_->{ofs}] || length $globaldefs[$_->{ofs}]->{debugname} < length $_->{debugname})
- {
- $globaldefs[$_->{ofs}] = $_;
- }
+ $globaldefs[$_->{ofs}] //= $_
+ if $_->{debugname} ne "";
+ }
+ for(@{$p{globaldefs}})
+ {
+ $globaldefs[$_->{ofs}] //= $_;
+ }
+ for(0..(@{$p{globals}}-1))
+ {
+ $globaldefs[$_] //= { ofs => $_, s_name => undef, debugname => ($istemp{$_} ? "<temp>" : $isconst{$_} ? "<const>" : "<nodef>") . "\@$_" },
}
my %globaldefs = ();
for(@{$p{globaldefs}})
$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;
- for(sort { $a->{debugname} <=> $b->{debugname} } @{$p{functions}})
+ #my $checkfunc = \&disassemble_function;
+ for(sort { $a->{debugname} cmp $b->{debugname} } @{$p{functions}})
{
$checkfunc->(\%p, $_);
}
projects / xonotic / xonotic.git / blobdiff