Mirror of the JODE repository
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 
jode/jode/doc/dasm_to_java.perl

711 lines
18 KiB

use strict;
my (@tstack, @vstack);
my $incindent = 4;
my $instr_addr;
my (%instr, %next_instr, %prev_instr);
@tstack = ();
@vstack = ();
sub print_stack {
my ($type, $value);
while (@tstack and @vstack) {
$type = shift @tstack;
$value = shift @vstack;
print STDERR "($type) $value, ";
}
if (@tstack) {
print STDERR "TSTACK to big : @tstack ";
} elsif (@vstack) {
print STDERR "VSTACK to big : @vstack ";
}
@tstack = ();
@vstack = ();
}
sub print_code {
my ($indent, $code, $addr) = @_;
#print " "x$indent, $code, (defined addr)?"/* $addr */":"", "\n";
print " "x$indent, $code, "\n";
}
sub dump_program {
my $addr;
foreach $addr (sort { $a <=> $b } keys %instr) {
print_code (0, "$addr $instr{$addr}");
}
return 1
}
sub convert_value($$$) {
my ($value, $oldtype, $newtype) = @_;
return "$value" if ($oldtype eq $newtype);
return "$value" if ($oldtype =~ /\*/ or $newtype =~ /\*/);
return "$value" if ($oldtype eq "boolean" && $newtype eq "int");
if ($oldtype eq "int" && $newtype eq "boolean") {
$value =~ s/1/true/g;
$value =~ s/0/false/g;
$value =~ s/\&/\&\&/g;
$value =~ s/\|/\|\|/g;
return $value;
}
return $value; # "/*warn: conv: $oldtype => $newtype*/ $value";
}
sub get_type ($) {
my $type;
$_ = $_[0];
SWITCH: {
/^b$/ && ($type = "byte",last);
/^c$/ && ($type = "char",last);
/^s$/ && ($type = "short",last);
/^i$/ && ($type = "int",last);
/^l$/ && ($type = "long",last);
/^f$/ && ($type = "float",last);
/^d$/ && ($type = "double",last);
/^a$/ && ($type = "*",last);
die "internal error in get_type";
}
return $type;
}
sub pop_value_type ($) {
if (not @tstack || not @vstack) {
die "Stack is empty??";
}
my $result = "";
my $want_type = $_[0];
my $act_type = pop @tstack;
my $value = pop @vstack;
warn "want_type not defined"
if (not defined $want_type);
warn "act_type not defined"
if (not defined $act_type);
$result = convert_value($value, $act_type, $want_type);
return ($result, $act_type);
}
sub pop_value($) {
@_ = pop_value_type($_[0]);
return $_[0];
}
sub parse_type($) {
$_[0] =~ /^\#\d+\s+ <Class
\s+(\S+) # type
>\s*$/x or die "Wrong field parameter `$_[0]'";
return $1;
}
sub parse_field($) {
$_[0] =~ /^\#\d+\s+ <Field
\s+(\S+) # type
\s+([^\[>]+) # name
((?:\[\])*) # [][]... belongs to type
>\s*$/x or die "Wrong field parameter `$_[0]'";
return $1.$3, $2;
}
sub parse_special($) {
$_[0] =~ /\#\d+\s+<Method
\s+([^\(\s]+) # method
\s*\(([^\)]*)\) # params
>\s*$/x or die "Wrong method parameter `$_[0]'";
my ($method, $params) = ($1,$2);
my @params = split /,\s*/, $params;
return $method, @params;
}
sub parse_method($) {
$_[0] =~ /\#\d+\s+<Method
\s+(\S+) # type
\s+([^\(\s]+) # method
\s*\(([^\)]*)\) # params
>\s*$/x or die "Wrong method parameter `$_[0]'";
my ($type, $method, $params) = ($1, $2,$3);
my @params = split /,\s*/, $params;
return $type, $method, @params;
}
sub classify($$) {
my $class = $_[0] . ".";
$class = "" if $class eq "this.";
return $class.$_[1];
}
sub new_instr($) {
if (defined ($instr{$instr_addr})) {
$instr{$instr_addr} .= "\n/*warn: multiple*/\n".$_[0];
} else {
$instr{$instr_addr} = $_[0];
}
# print STDERR "$instr_addr: $instr{$instr_addr}\n";
}
sub new_assign($$) {
my ($var, $value) = @_;
if (@vstack) {
if (("$value" eq "($var + 1)") &&
($vstack[-1] eq "$var")) {
$vstack[-1] = "$var++";
} else {
warn("`$var = $value' in expression, while vstack");
}
} else {
new_instr("$var = $value;");
}
}
sub combine_if_block {
my ($addr, $end) = @_;
$instr{$addr} =~ /if (\(.*\)) goto (\d+);/ or return;
my ($cond, $dest) = ($1, $2);
COMBINE:
while (1) {
my $if;
# First combine ifs with the same dest addr, that is ors.
my @conds = ($cond);
for ($if = $next_instr{$addr}; $if < $end; $if = $next_instr{$addr}) {
$instr{$if} =~ /if (\(.*\)) goto ($dest);/ or last;
push @conds, $1;
#remove unnecessary ifs (hope there are no goto's)
$next_instr{$addr} = $next_instr{$if};
$prev_instr{$next_instr{$if}}= $addr;
delete $instr{$if};
delete $prev_instr{$if};
delete $next_instr{$if};
}
if (@conds > 1) {
# combine conditions with or and reset the list
$cond = join " || ", @conds;
$cond = "($cond)";
}
last COMBINE if ($if >= $end || $instr{$if} !~ /^if/);
# Now try if we can combine all further ifs until the destination (that is and)
combine_if_block($if, $dest)
unless ($next_instr{$if} == $dest);
last COMBINE if ($next_instr{$if} != $dest);
# This is an and
$instr{$if} =~ /if (\(.*\)) goto (\d+);/;
$cond = "(!$cond && $1)";
$dest = $2;
$next_instr{$addr} = $next_instr{$if};
$prev_instr{$next_instr{$if}}= $addr;
delete $instr{$if};
delete $prev_instr{$if};
delete $next_instr{$if};
}
# Okay, we are stuck here, build the combined if.
$instr{$addr} = "if $cond goto $dest;";
}
sub simplify_instructions {
my ($addr, $end) = @_;
ADDR:
for (; $addr < $end; $addr = $next_instr{$addr}) {
combine_if_block($addr, $end)
if $instr{$addr} =~ /^if /;
while ( $instr{$addr} =~
/^(.*)new (java\.lang\.)?StringBuffer\((\).append\(.*)+\).toString\(\)(.*)$/ ) {
my ($first, $middle, $last) = ($1,$3,$4);
$middle =~ s/\).append\(/\+/g;
$middle =~ s/^\+//;
$instr{$addr} = $first.$middle.$last;
}
while ( $instr{$addr} =~ s/([A-Za-z_\$][A-Za-z_\$0-9]*) = \(\1 \+ 1\)/$1++/) {
}
}
}
# The parameters:
# start first instruction to decode
# end last instruction to decode + 1
# next instruction where control flows after this block
# (usually end but may be bigger)
# break instruction where a break would bring us to
# indent The indentation of this block
sub print_stmtlist ($$$$$) {
my ($start, $end, $next, $break, $indent) = @_;
my $addr;
$addr = $start;
ADDR:
while ($addr < $end) {
(dump_program && die "Addresses out of range: $addr") if (not defined $next_instr{$addr});
$_ = $instr{$addr};
/^goto (\d+);$/ && do {
my $dest = $1;
if ($dest == $break) {
print_code($indent, "break $dest;", $addr);
$addr = $next_instr{$addr};
next ADDR;
}
my $begin = $next_instr{$addr};
if ($instr{$dest} =~ /^if\s\((.*)\)\sgoto\s$begin/) {
# This is a while-loop
print_code($indent, "while ($1) {", $addr);
print_stmtlist($begin, $dest, $dest, $dest, $indent+$incindent);
print_code($indent, "}");
$addr = $next_instr{$dest};
next ADDR;
}
};
/^if \((.*)\) goto (\d+);/ && do {
my $cond = $1;
my $next_after_if = $2;
if ($next_after_if > $addr &&
($next_after_if <= $end || $next_after_if == $next)) {
# This seems to be an if.
print_code($indent, "if (!($cond)) {", $addr);
# endthen is the last instruction in then block + 1
my $endthen = ($next_after_if > $end) ? $end : $next_after_if;
my $prev = $prev_instr{$endthen};
if ($instr{$prev} =~ /^goto\s(.*);/ &&
$1 > $endthen && ($1 <= $end || $1 == $next)) {
$next_after_if = $1;
my $endelse = $1;
if ($endelse > $end) {
$endelse = $end;
}
# there is an else part
print_stmtlist ($next_instr{$addr}, $prev,
$next_after_if, $break, $indent+$incindent);
print_code($indent, "} else {");
print_stmtlist ($endthen, $endelse,
$next_after_if, $break, $indent+$incindent);
$addr = $endelse;
} else {
# no else-part
print_stmtlist ($next_instr{$addr}, $endthen,
$next_after_if, $break, $indent+$incindent);
$addr = $endthen;
}
print_code($indent, "}");
next ADDR;
}
if ($next_after_if == $break) {
# This is an if () break;
print_code($indent, "if ($cond) break;", $addr);
$addr = $next_instr{$addr};
next ADDR;
}
};
/^case ((.|\n)*)$/ && do {
my $default;
my $cond = "NONE";
my @lines = split "\n", $1;
$_ = shift @lines;
/^\((.*)\)$/ and $cond = $1;
(shift @lines) =~ /^default: goto (\d+);/ and $default = $1;
my $next_after_switch = $default;
if ($instr{$prev_instr{$default}} =~ /^goto\s(\d+);/ and
$1 > $default) {
$next_after_switch = $1;
}
print_code ($indent, "switch ($cond) {", $addr);
my %cases = ($default => "default");
foreach (@lines) {
(/^(\d+): goto (\d+);$/ and $cases{$2} = "case $1")
or warn ("ILLEGAL case : `$_'");
my $casepos = $1;
if ($casepos > $next_after_switch) {
if ($instr{$prev_instr{$1}} =~ /^goto\s(\d+);/ and
$1 > $casepos) {
$next_after_switch = $1;
} else {
$next_after_switch = $casepos;
}
}
}
$next_after_switch = $end
if ($next_after_switch > $end && $next_after_switch != $next);
my $endswitch = ($next_after_switch > $end) ? $end : $next_after_switch;
#print STDERR "Addr: $addr, labels: `",
# (join ":", keys %cases ), "', default: $default, end: $next_after_switch\n";
$addr = $next_instr{$addr};
foreach $_ (sort { $a <=> $b } keys %cases) {
my $next_case = $_;
if ($instr{$prev_instr{$next_case}} eq
"goto $next_after_switch;") {
print_stmtlist($addr, $prev_instr{$next_case},
$next_after_switch, $next_after_switch,
$indent+$incindent);
print_code($indent+$incindent, "break;");
} else {
print_stmtlist($addr, $next_case,
$next_case, $next_after_switch,
$indent+$incindent);
}
print_code($indent, $cases{$next_case}.":");
$addr = $next_case;
}
print_stmtlist($addr, $endswitch,
$endswitch, $next_after_switch,
$indent+$incindent);
print_code($indent, "}");
$addr = $endswitch;
next ADDR;
};
print_code($indent, $_, $addr);
$addr = $next_instr{$addr};
}
}
my %locals = ();
my $addr;
LINE: while (<>) {
chomp;
(/^\s*(\d+)\s+(.*)$/ and $addr = $1, $_ = $2) or do {
warn "Line `$_' ist not formatted correctly\n";
next LINE;
};
if (not @vstack) {
if (defined ($instr_addr)) {
new_instr("/*warn: missing instruction!*/")
if (not defined $instr{$instr_addr});
$next_instr{$instr_addr} = $addr;
$prev_instr{$addr} = $instr_addr;
} else {
$prev_instr{$addr} = -1;
}
$instr_addr = $addr;
}
INSTR:
{
/^([ilfda])load[\s_]+(\d+)\s*$/ && do {
push @tstack, get_type($1);
my $local;
if ($2 == 0) {
$local = "this";
} else {
$local = "local_$2";
}
push @vstack, $local;
last INSTR;
};
/^([bcsilfda])aload\s*$/ && do {
my $warn = "";
my $index = pop_value("int");
my ($array, $atype) = pop_value_type(get_type($1)."[]");
my $type = $atype;
($atype =~ /(.*)\[\]/ and $type = $1) or
$warn = "/*warn: `$atype' not an array*/ ";
push @tstack, $type;
push @vstack, "$warn$array"."[$index]";
last INSTR;
};
(/^[bs](i)push\s+(-?\d+)\s*$/ ||
/^([ilfda])const[\s_]+([m\-]?[\d.Ee\+\-]+|null)\s*$/) && do {
push @tstack, get_type($1);
push @vstack, ($2 eq "m1") ? -1 : $2;
last INSTR;
};
/ldc[12]?_?w?\s+\#\d+\s+\<(\S+)\s+([^\>]+)\>/ && do {
push @tstack, $1;
push @vstack, $2;
last INSTR;
};
/^([ilfda])store[\s_]+(\d+)\s*$/ && do {
my $local;
my ($value, $type) = pop_value_type(get_type($1));
if ($2 == 0) {
$local = "this";
} else {
$local = "local_$2";
if (not defined $locals{$2}) {
$locals{$2} = $type;
$local = "$type $local";
} else {
$local = convert_value($local, $type, $locals{$2});
}
}
new_assign($local, $value);
last INSTR;
};
/^([bcsilfda])astore\s*$/ && do {
my ($value, $type) = pop_value_type(get_type($1));
my $index = pop_value("int");
my ($array, $atype) = pop_value_type(get_type($1)."[]");
($atype =~ /(.*)\[\]/ and $atype = $1) or
$atype = "`$atype' not an array*/\n\t";
new_assign("$array"."[$index]",
convert_value("$value", $type, $atype));
last INSTR;
};
/^new\s+(.*)\s*/ && do {
my ($type) = parse_type($1);
push @tstack, $type;
push @vstack, "new $type";
last INSTR;
};
/^newarray\s+(\S+)\s*$/ && do {
my $arrtype = $1;
my $value = pop_value("int");
push @tstack, $arrtype."[]";
push @vstack, "new ".$arrtype."[$value]";
last INSTR;
};
/^getfield\s+(.*)$/ && do {
my ($type, $field) = parse_field($1);
my $class = pop_value("*") . ".";
$class = "" if $class eq "this.";
push @tstack, $type;
push @vstack, "$class$field";
last INSTR;
};
/^getstatic\s+(.*)$/ && do {
my ($type, $field) = parse_field($1);
push @tstack, $type;
my $class="FIXME.";
push @vstack, "$class$field";
last INSTR;
};
/^putfield\s+(.*)$/ && do {
my ($dtype, $field) = parse_field($1);
my $value = pop_value($dtype);
$field = classify(pop_value("*"), $field);
new_assign($field, $value);
last INSTR;
};
/^goto\s+(\d+)\s*$/ && do {
new_instr("goto $1;");
last INSTR;
};
/^tableswitch\s+(\d+)\s+to\s+(\d+): default=(\d+)\s*$/ && do {
my $from = $1;
my $to = $2;
my $default = $3;
my $num;
my $casestmt = "case (" . pop_value("int") . ")\n";
$casestmt .= "default: goto $default;\n";
for $num ($from .. $to) {
$_ = <>;
if ( $_ =~ /\s+$num:\s*(\d+)/ ) {
$casestmt .= "$num: goto $1;\n";
} else {
warn "unknown case: `$_' at $.";
}
}
new_instr($casestmt);
last INSTR;
};
/^lookupswitch\s+(\d+):\s+default=(\d+)\s*$/ && do {
my $anz = $1;
my $default = $2;
my $num;
my $casestmt = "case (" . pop_value("int") . ")\n";
$casestmt .= "default: goto $default;\n";
for $num (1 .. $anz) {
$_ = <>;
if ( $_ =~ /\s+(\d+):\s*(\d+)/ ) {
$casestmt .= "$1: goto $2;\n";
} else {
$casestmt .= "error in case";
}
}
new_instr($casestmt);
last INSTR;
};
/^invokespecial\s+(.*)$/ && do {
my ($method, @paramtypes) = parse_special ($1);
my @params=();
# Constructoraufruf! Wenn alles glatt laeuft...
while (@paramtypes) {
my $ptype = pop @paramtypes;
my $value = pop_value($ptype);
unshift @params, $value;
}
my ($new_class, $class_type) = pop_value_type ("*");
$method = $new_class;
my $call = "$method(" . join (", ", @params) . ")";
if ($vstack[-1] eq $new_class) {
$vstack[-1] = "$call";
} else {
new_instr("$call;");
}
last INSTR;
};
/^invoke(virtual|static)\s+(.*)$/ && do {
my ($type, $method, @paramtypes) = parse_method ($2);
my @params=();
while (@paramtypes) {
my $ptype = pop @paramtypes;
my $value = pop_value($ptype);
unshift @params, $value;
}
my ($class, $class_type) = ($1 eq "virtual")? pop_value_type ("*") : "FIXME";
$method = classify($class, $method);
my $call = "$method(" . join (", ", @params) . ")";
if ($type eq "void") {
new_instr("$call;");
} else {
push @tstack, $type;
push @vstack, $call;
}
last INSTR;
};
/^return\s*$/ && do {
new_instr("return;");
last INSTR;
};
/^pop\s*$/ && do {
unless (@vstack) {
print STDERR "pop: Stack is empty at $addr";
}
new_instr(pop(@vstack).";");
pop @tstack;
last INSTR;
};
/^dup\s*$/ && do {
push @tstack, $tstack[-1];
push @vstack, $vstack[-1];
last INSTR;
};
/^dup2\s*$/ && do {
push @tstack, $tstack[-2];
push @vstack, $vstack[-2];
push @tstack, $tstack[-2];
push @vstack, $vstack[-2];
last INSTR;
};
/^dup_x([12])\s*$/ && do {
splice @tstack, -1-$1, 0, $tstack[-1];
splice @vstack, -1-$1, 0, $vstack[-1];
last INSTR;
};
/^([ilfd])neg\s*$/ && do {
my $type = get_type($1);
my $op1 = pop_value($type);
push @tstack, $type;
push @vstack, "-$op1";
last INSTR;
};
/^([ilfd])(add|sub|mul|div|rem|and|or|xor|shl|shr)\s*$/ && do {
my $type = get_type($1);
my $op2 = pop_value($type);
my $op1 = pop_value($type);
my $op;
for ($2) {
/add/ && ($op="+", last);
/sub/ && ($op="-", last);
/mul/ && ($op="*", last);
/div/ && ($op="/", last);
/rem/ && ($op="%", last);
/and/ && ($op="&", last);
/or/ && ($op="|", last);
/xor/ && ($op="^", last);
/shl/ && ($op="<<", last);
/shr/ && ($op=">>", last);
}
push @tstack, $type;
push @vstack, "($op1 $op $op2)";
last INSTR;
};
/^iinc\s+(\d+)\s+(-?\d+)\s*$/ && do {
my $value = $2;
my $local;
if ($1 == 0) {
$local = "this";
} else {
$local = "local_$1";
}
new_instr(convert_value("$local", "int", $locals{$1}).
(($2 == 1)? "++;" : " += $2;"));
last INSTR;
};
/^([bcifld])2([bcifld])\s*$/ && do {
my $value = pop_value(get_type($1));
my $type = get_type($2);
push @tstack, $type;
push @vstack, "($type) $value";
last INSTR;
};
/^([lfd])cmp([lg]?)\s*$/ && do {
my $type = get_type($1);
my $op2 = pop_value($type);
my $op1 = pop_value($type);
push @tstack, "int";
push @vstack, "($op1 <=>$2 $op2)";
last INSTR;
};
/^if(eq|lt|le|ne|gt|ge)\s+(\d+)\s*$/ && do {
my $op;
my $dest = $2;
for ($1) {
/eq/ && ($op="==", last);
/lt/ && ($op="<", last);
/le/ && ($op="<=", last);
/ne/ && ($op="!=", last);
/gt/ && ($op=">", last);
/ge/ && ($op=">=", last);
}
my $op1 = pop_value("int");
new_instr("if ($op1 $op 0) goto $dest;");
last INSTR;
};
/^if_icmp(eq|lt|le|ne|gt|ge)\s+(\d+)\s*$/ && do {
my $op;
my $dest = $2;
for ($1) {
/eq/ && ($op="==", last);
/lt/ && ($op="<", last);
/le/ && ($op="<=", last);
/ne/ && ($op="!=", last);
/gt/ && ($op=">", last);
/ge/ && ($op=">=", last);
}
my $op2 = pop_value("int");
my $op1 = pop_value("int");
new_instr("if ($op1 $op $op2) goto $dest;");
last INSTR;
};
/^if(null|nonnull)\s+(\d+)\s*$/ && do {
my $dest = $2;
my $op;
for ($1) {
/notnull/ && ($op="!=", last);
/null/ && ($op="==", last);
}
my $op1 = pop_value("*");
new_instr("if ($op1 $op null) goto $dest;");
last INSTR;
};
do {
print STDERR "Stack: ";
&print_stack;
print STDERR "\nUnknown Instruction: `$_'\n\t";
};
}
}
$addr++;
$next_instr{$instr_addr} = $addr;
simplify_instructions (0, $addr);
print_stmtlist(0, $addr, $addr, $addr, 2*$incindent);