# 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.
use B
::Asmdata
qw(%insn_data @insn_name);
require ByteLoader; # we just need its $VERSION
@EXPORT_OK = qw(assemble_fh newasm endasm assemble asm);
for ($i = 0; defined($opname = ppname
($i)); $i++) {
my($linenum, $errors, $out); # global state, set up by newasm
sub debug
{ $debug = shift }
my( $val, $lo, $hi, $loc ) = @_;
if( $val < $lo || $hi < $val ){
error
"argument for $loc outside [$lo, $hi]: $val";
# First define all the data conversion subs to which Asmdata will refer
error
"argument for U8 is too long: $c";
$arg = limcheck
( $arg, 0, 0xff, 'U8' );
sub B
::Asmdata
::PUT_U16
{
my $arg = limcheck
( $_[0], 0, 0xffff, 'U16' );
sub B
::Asmdata
::PUT_U32
{
my $arg = limcheck
( $_[0], 0, 0xffffffff, 'U32' );
sub B
::Asmdata
::PUT_I32
{
my $arg = limcheck
( $_[0], -0x80000000, 0x7fffffff, 'I32' );
sub B
::Asmdata
::PUT_NV
{ sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
# may not even be portable between compilers
sub B
::Asmdata
::PUT_objindex
{ # could allow names here
my $arg = limcheck
( $_[0], 0, 0xffffffff, '*index' );
sub B
::Asmdata
::PUT_svindex
{ &B
::Asmdata
::PUT_objindex
}
sub B
::Asmdata
::PUT_opindex
{ &B
::Asmdata
::PUT_objindex
}
sub B
::Asmdata
::PUT_pvindex
{ &B
::Asmdata
::PUT_objindex
}
sub B
::Asmdata
::PUT_strconst
{
my $str = uncstring
($arg);
error
"bad string constant: $arg";
error
"string constant argument contains NUL: $arg";
sub B
::Asmdata
::PUT_pvcontents
{
error
"extraneous argument: $arg" if defined $arg;
my $str = uncstring
($arg);
error
"bad string argument: $arg";
return pack("L", length($str)) . $str;
sub B
::Asmdata
::PUT_comment_t
{
error
"bad string argument: $arg" unless defined($arg);
error
"comment argument contains linefeed: $arg";
sub B
::Asmdata
::PUT_double
{ sprintf("%s\0", $_[0]) } # see PUT_NV above
sub B
::Asmdata
::PUT_none
{
error
"extraneous argument: $arg" if defined $arg;
sub B
::Asmdata
::PUT_op_tr_array
{
my @ary = split /\s*,\s*/, shift;
sub B
::Asmdata
::PUT_IV64
{
$Config{ivsize
} == 4 ?
&B
::Asmdata
::PUT_I32
: &B
::Asmdata
::PUT_IV64
;
sub B
::Asmdata
::PUT_PADOFFSET
{
$Config{ptrsize
} == 8 ?
&B
::Asmdata
::PUT_IV64
: &B
::Asmdata
::PUT_U32
;
sub B
::Asmdata
::PUT_long
{
$Config{longsize
} == 8 ?
&B
::Asmdata
::PUT_IV64
: &B
::Asmdata
::PUT_U32
;
my %unesc = (n
=> "\n", r
=> "\r", t
=> "\t", a
=> "\a",
b
=> "\b", f
=> "\f", v
=> "\013");
$s =~ s/^"// and $s =~ s/"$// or return undef;
$s =~ s/\\(\d\d\d|.)/length($1) == 3 ? chr(oct($1)) : ($unesc{$1}||$1)/eg;
# Comments only allowed in instructions which don't take string arguments
# Treat string as a single line so .* eats \n characters.
^\s
* # Ignore leading whitespace
[^"]* # A double quote '"' indicates a string argument. If we
# find a double quote, the match fails and we strip nothing.
\s*\# # Any amount of whitespace plus the comment marker...
.*$ # ...which carries on to end-of-string.
}{$1}sx; # Keep only the instruction and optional argument.
# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
# nvtype is irrelevant (floats are stored as strings)
# byteorder is strconst not U32 because of varying size issues
$header .= B::Asmdata::PUT_U32(0x43424c50); # 'PLBC
'
$header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"');
$header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
$header .= B::Asmdata::PUT_U32($Config{ivsize});
$header .= B::Asmdata::PUT_U32($Config{ptrsize});
my ($insn, $arg) = $stmt =~ m{
^\s* # allow (but ignore) leading whitespace
(.*?) # Instruction continues up until...
(?: # ...an optional whitespace+argument group
(.*) # The argument is all the rest (newlines included).
)?$ # anchor at end-of-line
if ($arg =~ s/^0x(?=[0-9a-fA-F]+$)//) {
} elsif ($arg =~ s/^0(?=[0-7]+$)//) {
} elsif ($arg =~ /^pp_/) {
$arg =~ s/\s*$//; # strip trailing whitespace
my $opnum = $opnumber{$arg};
error qq(No such op type "$arg");
my $data = $insn_data{$insn};
my ($bytecode, $putsub) = @{$data}[0, 1];
my $argcode = &$putsub($arg);
return chr($bytecode).$argcode;
error qq(no such instruction "$insn");
die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE
';
Can't have multiple byteassembly sessions at once
!
(perhaps you forgot an endasm
()?
)
die "There were $errors assembly errors\n";
$linenum = $errors = $out = 0;
$quotedline =~ s/\\/\\\\/g;
$quotedline =~ s/"/\\"/g;
$out->(assemble_insn
("comment", qq("$quotedline")));
if( $line = strip_comments
($line) ){
($insn, $arg) = parse_statement
($line);
$out->(assemble_insn
($insn, $arg));
$out->(assemble_insn
("nop", undef));
return if $_[0] =~ /\s*\W/;
return if $_[1] eq "0" and
$_[0] !~ /^(?:newsvx?|av_pushx?|av_extend|xav_flags)$/;
return if $_[1] eq "1" and $_[0] =~ /^(?:sv_refcnt)$/;
B::Assembler - Assemble Perl bytecode
use B::Assembler qw(newasm endasm assemble);
newasm(\&printsub); # sets up for assembly
assemble($buf); # assembles one line
use B::Assembler qw(assemble_fh);
assemble_fh($fh, \&printsub); # assemble everything in $fh
See F<ext/B/B/Assembler.pm>.
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>