File Coverage

blib/lib/PJVM/Bytecode/Reader.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package PJVM::Bytecode::Reader;

use strict;
use warnings;

use List::MoreUtils qw(any);

sub _index_byte     { ${$_[1]} += 1; return (shift @{$_[0]}); }

sub _index_short    { ${$_[1]} += 2; my ($i1, $i2) = splice @{$_[0]}, 0, 2; return ($i1 << 8 | $i2); }

sub _byte           { ${$_[1]} += 1; return (shift @{$_[0]}); }

sub _short          { ${$_[1]} += 2; my ($i1, $i2) = splice @{$_[0]}, 0, 2; return ($i1 << 8 | $i2); }

sub _offset_short   { ${$_[1]} += 2; my ($o1, $o2) = splice @{$_[0]}, 0, 2; return ($o1 << 8 | $o2); }

sub _offset_long    {
    ${$_[1]} += 4;
    my ($o1, $o2, $o3, $o4) = splice @{$_[0]}, 0, 4;
    return ($o1 << 24 | $o2 << 16 | $o3 << 8 | $o4);
}

sub _index_byte_const {
    ${$_[1]} += 2;
    return splice @{$_[0]}, 0, 2;
}

sub _index_short_count_0 {
    ${$_[1]} += 4;
    my ($i1, $i2, $count, undef) = splice @{$_[0]}, 0, 4;
    return ($i1 << 8 | $i2, $count);
}

sub _index_short_count {
    ${$_[1]} += 3;
    my ($i1, $i2, $count) = splice @{$_[0]}, 0, 3;
    return ($i1 << 8 | $i2, $count);
}


my %Op_transformation = (
    0x19 => \&_index_byte, # aload
    0xbd => \&_index_short, # anewarray
    0x3a => \&_index_byte, # astore

    0x10 => \&_byte, # bipush

    0xc0 => \&_index_short, # checkcast

    0x18 => \&_index_byte, # dload
    0x39 => \&_index_byte, # dstore

    0x17 => \&_index_byte, # fload
    0x38 => \&_index_byte, # fstore

    0xb4 => \&_index_short, # getfield
    0xb2 => \&_index_short, # getstatic
    0xa7 => \&_offset_short, # goto
    0xc8 => \&_offset_long, # goto_w

    0xa5 => \&_offset_short, # if_acmpeq
    0xa6 => \&_offset_short, # if_acmpne
    0x9f => \&_offset_short, # if_icmpeq
    0xa0 => \&_offset_short, # if_icmpne
    0xa1 => \&_offset_short, # if_icmplt
    0xa2 => \&_offset_short, # if_icmpge
    0xa3 => \&_offset_short, # if_icmpgt
    0xa4 => \&_offset_short, # if_icmple
    0x99 => \&_offset_short, # ifeq
    0x9a => \&_offset_short, # ifne
    0x9b => \&_offset_short, # iflt
    0x9c => \&_offset_short, # ifge
    0x9d => \&_offset_short, # ifgt
    0x9e => \&_offset_short, # ifle
    0xc7 => \&_offset_short, # ifnotnull
    0xc6 => \&_offset_short, # ifnull
    0x84 => \&_index_byte_const, # iinc
    0x15 => \&_index_byte, # iload
    0xc1 => \&_index_short, # instanceof
    0xb9 => \&_index_short_count_0, # invokeinterface
    0xb7 => \&_index_short, # invokespecial
    0xb8 => \&_index_short, # invokestatic
    0xb6 => \&_index_short, # invokevirtual
    0x36 => \&_index_byte, # istore

    0xa8 => \&_offset_short, # jsr
    0xc9 => \&_offset_long, # jsr_w

    0x12 => \&_index_byte, # ldc
    0x13 => \&_index_short, # ldc_w
    0x14 => \&_index_short, # ldc2_w
    0x16 => \&_index_short, # lload
    0xab => sub { # lookupswitch
        my ($ops, $ix) = @_;
        my $pad = 3 - ($$ix - 1) % 4;
        if ($pad) {
            splice @$ops, 0, $pad;
            $$ix += $pad;
        };

        # default offset
        my ($d1, $d2, $d3, $d4) = splice @$ops, 0, 4;
        $$ix += 4;
        my $default = ($d1 << 24 | $d2 << 16 | $d3 << 8 | $d4);

        # number of case :
        my ($n1, $n2, $n3, $n4) = splice @$ops, 0, 4;
        $$ix += 4;
        my $case_no = ($d1 << 24 | $d2 << 16 | $d3 << 8 | $d4);

        my @pairs;
        if ($case_no) {
            my ($i1, $i2, $i3, $i4, $o1, $o2, $o3, $o4) = splice @$ops, 0, 8;
            $$ix += 8;
            push @pairs, ($i1 << 24 | $i2 << 16 | $i3 << 8 | $i4), ($o1 << 24 | $o2 << 16 | $o3 << 8 | $o4);
        }

        return ($default, @pairs);
    },
    0x37 => \&_index_byte, # lstore

    0xc5 => \&_index_short_count, # multianewarray

    0xbb => \&_index_short, # new
    0xbc => \&_byte, # newarray

    0xb5 => \&_index_short, # putfield
    0xb3 => \&_index_short, # putstatic

    0xa9 => \&_index_byte, # ret

    0x11 => \&_short, # sipush

    0xaa => sub { # tableswitch
        my ($ops, $ix) = @_;
        my $pad = 3 - ($$ix - 1) % 4;
        if ($pad) {
            splice @$ops, 0, $pad;
            $$ix += $pad;
        };

        # default offset
        my ($d1, $d2, $d3, $d4) = splice @$ops, 0, 4;
        $$ix += 4;
        my $default = ($d1 << 24 | $d2 << 16 | $d3 << 8 | $d4);

        # low :
        my ($l1, $l2, $l3, $l4) = splice @$ops, 0, 4;
        $$ix += 4;
        my $low = ($l1 << 24 | $l2 << 16 | $l3 << 8 | $l4);

        my ($h1, $h2, $h3, $h4) = splice @$ops, 0, 4;
        $$ix += 4;
        my $high = ($h1 << 24 | $h2 << 16 | $h3 << 8 | $h4);

        my $jump_offsets = $high - $low + 1;
        my @jump_offsets;
        if ($jump_offsets) {
            my ($o1, $o2, $o3, $o4) = splice @$ops, 0, 4;
            $$ix += 4;
            push @jump_offsets, ($o1 << 24 | $o2 << 16 | $o3 << 8 | $o4);
        }

        return ($default, $low, $high, @jump_offsets);
    },

    0xc4 => sub { # wide
        my ($ops, $ix) = @_;

        my $op = shift @$ops;
        $$ix++;

        if ($op == 0x84) {
            my ($i1, $i2, $c1, $c2) = splice @$ops, 0, 4;
            $$ix += 4;
            return ($op, $i1 << 8 | $i2, $c1 << 8 | $c2);
        }
        elsif (any { $_ == $op } (0x15, 0x36, 0x17, 0x38, 0x19, 0x3a, 0x16, 0x37, 0x18, 0x39, 0xa9)) {
            my ($i1, $i2) = splice @$ops, 0, 2;
            $$ix += 2;
            return ($op, $i1 << 8 | $i2);
        }
        else {
            die "Bytecode stream error"
        }
    }
);

sub read {
    my ($pkg, $bytecode) = @_;

    my @bytecode = unpack("C*", $bytecode);
    my @ops;
    my $ix = 0;
    while (@bytecode) {
        my $opcode = shift @bytecode;
        my $pc = $ix++;
        my $transformer = $Op_transformation{$opcode};
        my @args = defined $transformer ? $transformer->(\@bytecode, \$ix) : ();
        push @ops, [$opcode, @args], (undef) x ($ix - 1 - $pc);
    }

    return \@ops;
}

1;
__END__