# Copyright (c) 1996 Malcolm Beattie
# 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
;
use B qw(cstring cast_I32);
croak
"reached EOF while reading $len bytes" unless length($data) == $len;
croak
"reached EOF while reading U8" unless defined($c);
croak
"reached EOF while reading U16" unless length($str) == 2;
return unpack("S", $str);
while (defined($c = $fh->getc) && $c ne "\0") {
croak
"reached EOF while reading double" unless defined($c);
croak
"reached EOF while reading U32" unless length($str) == 4;
return unpack("L", $str);
croak
"reached EOF while reading I32" unless length($str) == 4;
return unpack("l", $str);
croak
"reached EOF while reading objindex" unless length($str) == 4;
return unpack("L", $str);
croak
"reached EOF while reading opindex" unless length($str) == 4;
return unpack("L", $str);
croak
"reached EOF while reading svindex" unless length($str) == 4;
return unpack("L", $str);
croak
"reached EOF while reading pvindex" unless length($str) == 4;
return unpack("L", $str);
while (defined($c = $fh->getc) && $c ne "\0") {
croak
"reached EOF while reading strconst" unless defined($c);
croak
"reached EOF while reading PV" unless length($str) == $len;
while (defined($c = $fh->getc) && $c ne "\n") {
croak
"reached EOF while reading comment" unless defined($c);
while (defined($c = $fh->getc) && $c ne "\0") {
croak
"reached EOF while reading double" unless defined($c);
my @ary = unpack("S256", $fh->readn(256 * 2));
my ($hi, $lo) = unpack("LL", $fh->readn(8));
return sprintf("0x%x%08x", $hi, $lo); # cheat
$Config{ivsize
} == 4 ?
&GET_I32
: &GET_IV64
;
@EXPORT_OK = qw(disassemble_fh get_header);
use B
::Asmdata
qw(%insn_data @insn_name);
our( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
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();
return( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
my ($c, $getmeth, $insn, $arg);
bless $fh, "B::Disassembler::BytecodeStream";
while (defined($c = $fh->getc)) {
if (!defined($insn) || $insn eq "unused") {
die "Illegal instruction code $c at stream offset $pos\n";
$getmeth = $insn_data{$insn}->[2];
B::Disassembler - Disassemble Perl bytecode
See F<ext/B/B/Disassembler.pm>.
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>