3 # Copyright (c) 1996 Malcolm Beattie
5 # You may distribute under the terms of either the GNU General Public
6 # License or the Artistic License, as specified in the README file.
8 $B::Disassembler::VERSION = '1.05';
10 package B::Disassembler::BytecodeStream;
14 use Config qw(%Config);
15 use B qw(cstring cast_I32);
16 @ISA = qw(FileHandle);
20 read($fh, $data, $len);
21 croak "reached EOF while reading $len bytes" unless length($data) == $len;
28 croak "reached EOF while reading U8" unless defined($c);
34 my $str = $fh->readn(2);
35 croak "reached EOF while reading U16" unless length($str) == 2;
36 return unpack("S", $str);
42 while (defined($c = $fh->getc) && $c ne "\0") {
45 croak "reached EOF while reading double" unless defined($c);
51 my $str = $fh->readn(4);
52 croak "reached EOF while reading U32" unless length($str) == 4;
53 return unpack("L", $str);
58 my $str = $fh->readn(4);
59 croak "reached EOF while reading I32" unless length($str) == 4;
60 return unpack("l", $str);
65 my $str = $fh->readn(4);
66 croak "reached EOF while reading objindex" unless length($str) == 4;
67 return unpack("L", $str);
72 my $str = $fh->readn(4);
73 croak "reached EOF while reading opindex" unless length($str) == 4;
74 return unpack("L", $str);
79 my $str = $fh->readn(4);
80 croak "reached EOF while reading svindex" unless length($str) == 4;
81 return unpack("L", $str);
86 my $str = $fh->readn(4);
87 croak "reached EOF while reading pvindex" unless length($str) == 4;
88 return unpack("L", $str);
95 while (defined($c = $fh->getc) && $c ne "\0") {
98 croak "reached EOF while reading strconst" unless defined($c);
102 sub GET_pvcontents {}
107 my $len = $fh->GET_U32;
109 read($fh, $str, $len);
110 croak "reached EOF while reading PV" unless length($str) == $len;
111 return cstring($str);
120 while (defined($c = $fh->getc) && $c ne "\n") {
123 croak "reached EOF while reading comment" unless defined($c);
124 return cstring($str);
130 while (defined($c = $fh->getc) && $c ne "\0") {
133 croak "reached EOF while reading double" unless defined($c);
139 sub GET_op_tr_array {
141 my $len = unpack "S", $fh->readn(2);
142 my @ary = unpack "S*", $fh->readn($len*2);
143 return join(",", $len, @ary);
148 my $str = $fh->readn(8);
149 croak "reached EOF while reading I32" unless length($str) == 8;
150 return sprintf "0x%09llx", unpack("q", $str);
154 $Config{ivsize} == 4 ? &GET_I32 : &GET_IV64;
158 $Config{ptrsize} == 8 ? &GET_IV64 : &GET_U32;
162 $Config{longsize} == 8 ? &GET_IV64 : &GET_U32;
166 package B::Disassembler;
169 @EXPORT_OK = qw(disassemble_fh get_header);
173 use B::Asmdata qw(%insn_data @insn_name);
175 our( $magic, $archname, $blversion, $ivsize, $ptrsize );
179 $magic = $fh->GET_U32();
180 warn( "bad magic" ) if $magic != 0x43424c50;
181 $archname = $fh->GET_strconst();
182 $blversion = $fh->GET_strconst();
183 $ivsize = $fh->GET_U32();
184 $ptrsize = $fh->GET_U32();
188 return( $magic, $archname, $blversion, $ivsize, $ptrsize);
193 my ($c, $getmeth, $insn, $arg);
194 bless $fh, "B::Disassembler::BytecodeStream";
196 while (defined($c = $fh->getc)) {
198 $insn = $insn_name[$c];
199 if (!defined($insn) || $insn eq "unused") {
200 my $pos = $fh->tell - 1;
201 die "Illegal instruction code $c at stream offset $pos\n";
203 $getmeth = $insn_data{$insn}->[2];
204 $arg = $fh->$getmeth();
219 B::Disassembler - Disassemble Perl bytecode
227 See F<ext/B/B/Disassembler.pm>.
231 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>