1N/A# Copyright (c) 1996 Malcolm Beattie 1N/A# You may distribute under the terms of either the GNU General Public 1N/A# License or the Artistic License, as specified in the README file. 1N/A warn "$linenum: $str\n";
1N/A error "argument for $loc outside [$lo, $hi]: $val";
1N/A# First define all the data conversion subs to which Asmdata will refer 1N/A if (
length($c) !=
1) {
1N/A error "argument for U8 is too long: $c";
1N/A $c =
substr($c,
0,
1);
1N/Asub B::
Asmdata::
PUT_NV {
sprintf(
"%s\0", $_[
0]) }
# "%lf" looses precision and pack('d',...) 1N/A # may not even be portable between compilers 1N/A error "string constant argument contains NUL: $arg";
1N/A error "bad string argument: $arg" unless defined($
arg);
1N/A error "comment argument contains linefeed: $arg";
1N/A my @
ary =
split /\s*,\s*/,
shift;
1N/A return pack "Q",
shift;
1N/Amy %
unesc = (n =>
"\n", r =>
"\r", t =>
"\t", a =>
"\a",
1N/A b =>
"\b", f =>
"\f", v =>
"\013");
1N/A $s =~ s/^
"// and $s =~ s/"$//
or return undef;
1N/A $s =~ s/\\(\d\d\d|.)/
length($
1) ==
3 ?
chr(
oct($
1)) : ($
unesc{$
1}||$
1)/
eg;
1N/A # Comments only allowed in instructions which don't take string arguments 1N/A # Treat string as a single line so .* eats \n characters. 1N/A ^\s*
# Ignore leading whitespace 1N/A [^
"]* # A double quote '"' indicates a string argument. If we 1N/A # find a double quote, the match fails and we strip nothing. 1N/A \s*\
# # Any amount of whitespace plus the comment marker... 1N/A .*$
# ...which carries on to end-of-string. 1N/A }{$
1}
sx;
# Keep only the instruction and optional argument. 1N/A# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize, 1N/A# nvtype is irrelevant (floats are stored as strings) 1N/A# byteorder is strconst not U32 because of varying size issues 1N/A ^\s*
# allow (but ignore) leading whitespace 1N/A (.*?)
# Instruction continues up until... 1N/A (?:
# ...an optional whitespace+argument group 1N/A \s+
# first whitespace. 1N/A (.*)
# The argument is all the rest (newlines included). 1N/A )?$
# anchor at end-of-line 1N/A }
elsif ($
arg =~ s/^
0(?=[
0-
7]+$)//) {
1N/A $
arg =~ s/\s*$//;
# strip trailing whitespace 1N/A die "Invalid printing routine for B::Assembler\n" unless ref $
outsub eq 'CODE';
1N/ACan't have multiple byteassembly sessions at once! 1N/A die "There were $errors assembly errors\n";
1N/A### temporary workaround 1N/A return if $_[
0] =~ /\s*\W/;
1N/A if (
defined $_[
1]) {
1N/A return if $_[
1]
eq "0" and 1N/AB::Assembler - Assemble Perl bytecode 1N/A use B::Assembler qw(newasm endasm assemble); 1N/A newasm(\&printsub); # sets up for assembly 1N/A assemble($buf); # assembles one line 1N/A endasm(); # closes down 1N/A use B::Assembler qw(assemble_fh); 1N/A assemble_fh($fh, \&printsub); # assemble everything in $fh 1N/AMalcolm Beattie, C<mbeattie@sable.ox.ac.uk> 1N/APer-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>