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.
11 use B::Asmdata qw(%insn_data @insn_name);
12 use Config qw(%Config);
13 require ByteLoader; # we just need its $VERSION
18 @EXPORT_OK = qw(assemble_fh newasm endasm assemble asm);
24 for ($i = 0; defined($opname = ppname($i)); $i++) {
25 $opnumber{$opname} = $i;
28 my($linenum, $errors, $out); # global state, set up by newasm
32 warn "$linenum: $str\n";
37 sub debug { $debug = shift }
40 my( $val, $lo, $hi, $loc ) = @_;
41 if( $val < $lo || $hi < $val ){
42 error "argument for $loc outside [$lo, $hi]: $val";
49 # First define all the data conversion subs to which Asmdata will refer
52 sub B::Asmdata::PUT_U8 {
54 my $c = uncstring($arg);
56 if (length($c) != 1) {
57 error "argument for U8 is too long: $c";
58 $c = substr($c, 0, 1);
61 $arg = limcheck( $arg, 0, 0xff, 'U8' );
67 sub B::Asmdata::PUT_U16 {
68 my $arg = limcheck( $_[0], 0, 0xffff, 'U16' );
71 sub B::Asmdata::PUT_U32 {
72 my $arg = limcheck( $_[0], 0, 0xffffffff, 'U32' );
75 sub B::Asmdata::PUT_I32 {
76 my $arg = limcheck( $_[0], -0x80000000, 0x7fffffff, 'I32' );
79 sub B::Asmdata::PUT_NV { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
80 # may not even be portable between compilers
81 sub B::Asmdata::PUT_objindex { # could allow names here
82 my $arg = limcheck( $_[0], 0, 0xffffffff, '*index' );
85 sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex }
86 sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex }
87 sub B::Asmdata::PUT_pvindex { &B::Asmdata::PUT_objindex }
89 sub B::Asmdata::PUT_strconst {
91 my $str = uncstring($arg);
93 error "bad string constant: $arg";
96 if ($str =~ s/\0//g) {
97 error "string constant argument contains NUL: $arg";
103 sub B::Asmdata::PUT_pvcontents {
105 error "extraneous argument: $arg" if defined $arg;
108 sub B::Asmdata::PUT_PV {
110 my $str = uncstring($arg);
111 if( ! defined($str) ){
112 error "bad string argument: $arg";
115 return pack("L", length($str)) . $str;
117 sub B::Asmdata::PUT_comment_t {
119 $arg = uncstring($arg);
120 error "bad string argument: $arg" unless defined($arg);
121 if ($arg =~ s/\n//g) {
122 error "comment argument contains linefeed: $arg";
126 sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } # see PUT_NV above
127 sub B::Asmdata::PUT_none {
129 error "extraneous argument: $arg" if defined $arg;
132 sub B::Asmdata::PUT_op_tr_array {
133 my @ary = split /\s*,\s*/, shift;
134 return pack "S*", @ary;
137 sub B::Asmdata::PUT_IV64 {
138 return pack "Q", shift;
141 sub B::Asmdata::PUT_IV {
142 $Config{ivsize} == 4 ? &B::Asmdata::PUT_I32 : &B::Asmdata::PUT_IV64;
145 sub B::Asmdata::PUT_PADOFFSET {
146 $Config{ptrsize} == 8 ? &B::Asmdata::PUT_IV64 : &B::Asmdata::PUT_U32;
149 sub B::Asmdata::PUT_long {
150 $Config{longsize} == 8 ? &B::Asmdata::PUT_IV64 : &B::Asmdata::PUT_U32;
153 sub B::Asmdata::PUT_svtype { # svtype is an enum, so an int.
154 $Config{intsize} == 4 ? &B::Asmdata::PUT_U32 : &B::Asmdata::PUT_IV64;
157 my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
158 b => "\b", f => "\f", v => "\013");
162 $s =~ s/^"// and $s =~ s/"$// or return undef;
163 $s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
169 # Comments only allowed in instructions which don't take string arguments
170 # Treat string as a single line so .* eats \n characters.
172 ^\s* # Ignore leading whitespace
174 [^"]* # A double quote '"' indicates a string argument. If we
175 # find a double quote, the match fails and we strip nothing.
177 \s*\# # Any amount of whitespace plus the comment marker...
178 .*$ # ...which carries on to end-of-string.
179 }{$1}sx; # Keep only the instruction and optional argument.
183 # create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
185 # nvtype is irrelevant (floats are stored as strings)
186 # byteorder is strconst not U32 because of varying size issues
191 $header .= B::Asmdata::PUT_U32(0x43424c50); # 'PLBC'
192 $header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"');
193 $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
194 $header .= B::Asmdata::PUT_U32($Config{ivsize});
195 $header .= B::Asmdata::PUT_U32($Config{ptrsize});
199 sub parse_statement {
201 my ($insn, $arg) = $stmt =~ m{
202 ^\s* # allow (but ignore) leading whitespace
203 (.*?) # Instruction continues up until...
204 (?: # ...an optional whitespace+argument group
205 \s+ # first whitespace.
206 (.*) # The argument is all the rest (newlines included).
207 )?$ # anchor at end-of-line
210 if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
212 } elsif ($arg =~ s/^0(?=[0-7]+$)//) {
214 } elsif ($arg =~ /^pp_/) {
215 $arg =~ s/\s*$//; # strip trailing whitespace
216 my $opnum = $opnumber{$arg};
217 if (defined($opnum)) {
220 error qq(No such op type "$arg");
225 return ($insn, $arg);
229 my ($insn, $arg) = @_;
230 my $data = $insn_data{$insn};
231 if (defined($data)) {
232 my ($bytecode, $putsub) = @{$data}[0, 1];
233 my $argcode = &$putsub($arg);
234 return chr($bytecode).$argcode;
236 error qq(no such instruction "$insn");
244 my $asm = newasm($out);
245 while ($line = <$fh>) {
254 die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE';
255 die <<EOD if ref $out;
256 Can't have multiple byteassembly sessions at once!
257 (perhaps you forgot an endasm()?)
260 $linenum = $errors = 0;
263 $out->(gen_header());
268 die "There were $errors assembly errors\n";
270 $linenum = $errors = $out = 0;
279 my $quotedline = $line;
280 $quotedline =~ s/\\/\\\\/g;
281 $quotedline =~ s/"/\\"/g;
282 $out->(assemble_insn("comment", qq("$quotedline")));
284 if( $line = strip_comments($line) ){
285 ($insn, $arg) = parse_statement($line);
286 $out->(assemble_insn($insn, $arg));
288 $out->(assemble_insn("nop", undef));
293 ### temporary workaround
296 return if $_[0] =~ /\s*\W/;
298 return if $_[1] eq "0" and
299 $_[0] !~ /^(?:newsvx?|av_pushx?|av_extend|xav_flags)$/;
300 return if $_[1] eq "1" and $_[0] =~ /^(?:sv_refcnt)$/;
311 B::Assembler - Assemble Perl bytecode
315 use B::Assembler qw(newasm endasm assemble);
316 newasm(\&printsub); # sets up for assembly
317 assemble($buf); # assembles one line
318 endasm(); # closes down
320 use B::Assembler qw(assemble_fh);
321 assemble_fh($fh, \&printsub); # assemble everything in $fh
325 See F<ext/B/B/Assembler.pm>.
329 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
330 Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>