# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
package B::Disassembler::BytecodeStream;
+
+our $VERSION = '1.01';
+
use FileHandle;
use Carp;
+use Config qw(%Config);
use B qw(cstring cast_I32);
@ISA = qw(FileHandle);
sub readn {
my $fh = shift;
my $str = $fh->readn(2);
croak "reached EOF while reading U16" unless length($str) == 2;
- return unpack("n", $str);
+ return unpack("S", $str);
}
sub GET_NV {
my $fh = shift;
- my $str = $fh->readn(8);
- croak "reached EOF while reading NV" unless length($str) == 8;
- return unpack("N", $str);
+ my ($str, $c);
+ while (defined($c = $fh->getc) && $c ne "\0") {
+ $str .= $c;
+ }
+ croak "reached EOF while reading double" unless defined($c);
+ return $str;
}
sub GET_U32 {
my $fh = shift;
my $str = $fh->readn(4);
croak "reached EOF while reading U32" unless length($str) == 4;
- return unpack("N", $str);
+ return unpack("L", $str);
}
sub GET_I32 {
my $fh = shift;
my $str = $fh->readn(4);
croak "reached EOF while reading I32" unless length($str) == 4;
- return cast_I32(unpack("N", $str));
+ return unpack("l", $str);
}
sub GET_objindex {
my $fh = shift;
my $str = $fh->readn(4);
croak "reached EOF while reading objindex" unless length($str) == 4;
- return unpack("N", $str);
+ return unpack("L", $str);
}
sub GET_opindex {
my $fh = shift;
my $str = $fh->readn(4);
croak "reached EOF while reading opindex" unless length($str) == 4;
- return unpack("N", $str);
+ return unpack("L", $str);
}
sub GET_svindex {
my $fh = shift;
my $str = $fh->readn(4);
croak "reached EOF while reading svindex" unless length($str) == 4;
- return unpack("N", $str);
+ return unpack("L", $str);
+}
+
+sub GET_pvindex {
+ my $fh = shift;
+ my $str = $fh->readn(4);
+ croak "reached EOF while reading pvindex" unless length($str) == 4;
+ return unpack("L", $str);
}
sub GET_strconst {
my $fh = shift;
my ($str, $c);
+ $str = '';
while (defined($c = $fh->getc) && $c ne "\0") {
$str .= $c;
}
sub GET_op_tr_array {
my $fh = shift;
- my @ary = unpack("n256", $fh->readn(256 * 2));
+ my $len = unpack "S", $fh->readn(2);
+ my @ary = unpack "S*", $fh->readn($len*2);
return join(",", @ary);
}
sub GET_IV64 {
my $fh = shift;
- my ($hi, $lo) = unpack("NN", $fh->readn(8));
- return sprintf("0x%4x%04x", $hi, $lo); # cheat
+ my ($hi, $lo) = unpack("LL", $fh->readn(8));
+ return sprintf("0x%x%08x", $hi, $lo); # cheat
+}
+
+sub GET_IV {
+ $Config{ivsize} == 4 ? &GET_I32 : &GET_IV64;
}
package B::Disassembler;
use Exporter;
@ISA = qw(Exporter);
-@EXPORT_OK = qw(disassemble_fh);
+@EXPORT_OK = qw(disassemble_fh get_header);
use Carp;
use strict;
use B::Asmdata qw(%insn_data @insn_name);
+our( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
+
+sub dis_header($){
+ my( $fh ) = @_;
+ $magic = $fh->GET_U32();
+ warn( "bad magic" ) if $magic != 0x43424c50;
+ $archname = $fh->GET_strconst();
+ $blversion = $fh->GET_strconst();
+ $ivsize = $fh->GET_U32();
+ $ptrsize = $fh->GET_U32();
+ $byteorder = $fh->GET_strconst();
+}
+
+sub get_header(){
+ return( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
+}
+
sub disassemble_fh {
my ($fh, $out) = @_;
my ($c, $getmeth, $insn, $arg);
bless $fh, "B::Disassembler::BytecodeStream";
+ dis_header( $fh );
while (defined($c = $fh->getc)) {
$c = ord($c);
$insn = $insn_name[$c];