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.
7 package B::Disassembler::BytecodeStream;
13 use Config qw(%Config);
14 use B qw(cstring cast_I32);
15 @ISA = qw(FileHandle);
19 read($fh, $data, $len);
20 croak "reached EOF while reading $len bytes" unless length($data) == $len;
27 croak "reached EOF while reading U8" unless defined($c);
33 my $str = $fh->readn(2);
34 croak "reached EOF while reading U16" unless length($str) == 2;
35 return unpack("S", $str);
41 while (defined($c = $fh->getc) && $c ne "\0") {
44 croak "reached EOF while reading double" unless defined($c);
50 my $str = $fh->readn(4);
51 croak "reached EOF while reading U32" unless length($str) == 4;
52 return unpack("L", $str);
57 my $str = $fh->readn(4);
58 croak "reached EOF while reading I32" unless length($str) == 4;
59 return unpack("l", $str);
64 my $str = $fh->readn(4);
65 croak "reached EOF while reading objindex" unless length($str) == 4;
66 return unpack("L", $str);
71 my $str = $fh->readn(4);
72 croak "reached EOF while reading opindex" unless length($str) == 4;
73 return unpack("L", $str);
78 my $str = $fh->readn(4);
79 croak "reached EOF while reading svindex" unless length($str) == 4;
80 return unpack("L", $str);
85 my $str = $fh->readn(4);
86 croak "reached EOF while reading pvindex" unless length($str) == 4;
87 return unpack("L", $str);
94 while (defined($c = $fh->getc) && $c ne "\0") {
97 croak "reached EOF while reading strconst" unless defined($c);
101 sub GET_pvcontents {}
106 my $len = $fh->GET_U32;
108 read($fh, $str, $len);
109 croak "reached EOF while reading PV" unless length($str) == $len;
110 return cstring($str);
119 while (defined($c = $fh->getc) && $c ne "\n") {
122 croak "reached EOF while reading comment" unless defined($c);
123 return cstring($str);
129 while (defined($c = $fh->getc) && $c ne "\0") {
132 croak "reached EOF while reading double" unless defined($c);
138 sub GET_op_tr_array {
140 my @ary = unpack("S256", $fh->readn(256 * 2));
141 return join(",", @ary);
146 my ($hi, $lo) = unpack("LL", $fh->readn(8));
147 return sprintf("0x%x%08x", $hi, $lo); # cheat
151 $Config{ivsize} == 4 ? &GET_I32 : &GET_IV64;
154 package B::Disassembler;
157 @EXPORT_OK = qw(disassemble_fh get_header);
161 use B::Asmdata qw(%insn_data @insn_name);
163 our( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
167 $magic = $fh->GET_U32();
168 warn( "bad magic" ) if $magic != 0x43424c50;
169 $archname = $fh->GET_strconst();
170 $blversion = $fh->GET_strconst();
171 $ivsize = $fh->GET_U32();
172 $ptrsize = $fh->GET_U32();
173 $byteorder = $fh->GET_strconst();
177 return( $magic, $archname, $blversion, $ivsize, $ptrsize, $byteorder );
182 my ($c, $getmeth, $insn, $arg);
183 bless $fh, "B::Disassembler::BytecodeStream";
185 while (defined($c = $fh->getc)) {
187 $insn = $insn_name[$c];
188 if (!defined($insn) || $insn eq "unused") {
189 my $pos = $fh->tell - 1;
190 die "Illegal instruction code $c at stream offset $pos\n";
192 $getmeth = $insn_data{$insn}->[2];
193 $arg = $fh->$getmeth();
208 B::Disassembler - Disassemble Perl bytecode
216 See F<ext/B/B/Disassembler.pm>.
220 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>