Assembler.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
#
# 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.
package B::Assembler;
use Exporter;
use B qw(ppname);
require ByteLoader; # we just need its $VERSIOM
no warnings; # XXX
$VERSION = 0.07;
use strict;
my %opnumber;
my ($i, $opname);
}
sub error {
my $str = shift;
warn "$linenum: $str\n";
$errors++;
}
my $debug = 0;
sub limcheck($$$$){
error "argument for $loc outside [$lo, $hi]: $val";
}
return $val;
}
#
# First define all the data conversion subs to which Asmdata will refer
#
my $arg = shift;
if (defined($c)) {
if (length($c) != 1) {
error "argument for U8 is too long: $c";
$c = substr($c, 0, 1);
}
} else {
$c = chr($arg);
}
return $c;
}
pack("S", $arg);
}
pack("L", $arg);
}
pack("l", $arg);
}
# may not even be portable between compilers
pack("L", $arg);
}
sub B::Asmdata::PUT_strconst {
my $arg = shift;
if (!defined($str)) {
error "bad string constant: $arg";
$str = '';
}
if ($str =~ s/\0//g) {
error "string constant argument contains NUL: $arg";
$str = '';
}
return $str . "\0";
}
sub B::Asmdata::PUT_pvcontents {
my $arg = shift;
return "";
}
my $arg = shift;
if( ! defined($str) ){
error "bad string argument: $arg";
$str = '';
}
}
sub B::Asmdata::PUT_comment_t {
my $arg = shift;
if ($arg =~ s/\n//g) {
error "comment argument contains linefeed: $arg";
}
return $arg . "\n";
}
my $arg = shift;
return "";
}
sub B::Asmdata::PUT_op_tr_array {
my @ary = split /\s*,\s*/, shift;
return pack "S*", @ary;
}
return pack "Q", shift;
}
}
sub B::Asmdata::PUT_PADOFFSET {
}
}
b => "\b", f => "\f", v => "\013");
sub uncstring {
my $s = shift;
$s =~ s/^"// and $s =~ s/"$// or return undef;
return $s;
}
sub strip_comments {
my $stmt = shift;
# Comments only allowed in instructions which don't take string arguments
# Treat string as a single line so .* eats \n characters.
$stmt =~ s{
^\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.
return $stmt;
}
# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
# ptrsize, byteorder
# nvtype is irrelevant (floats are stored as strings)
# byteorder is strconst not U32 because of varying size issues
sub gen_header {
my $header = "";
$header;
}
sub parse_statement {
my $stmt = shift;
^\s* # allow (but ignore) leading whitespace
(.*?) # Instruction continues up until...
(?: # ...an optional whitespace+argument group
\s+ # first whitespace.
(.*) # The argument is all the rest (newlines included).
)?$ # anchor at end-of-line
}sx;
if (defined($arg)) {
$arg =~ s/\s*$//; # strip trailing whitespace
if (defined($opnum)) {
} else {
$arg = 0;
}
}
}
}
sub assemble_insn {
if (defined($data)) {
} else {
return "";
}
}
sub assemble_fh {
my $line;
}
endasm();
}
sub newasm {
my($outsub) = @_;
Can't have multiple byteassembly sessions at once!
$out->(gen_header());
}
sub endasm {
if ($errors) {
die "There were $errors assembly errors\n";
}
}
sub assemble {
my($line) = @_;
$linenum++;
chomp $line;
if ($debug) {
my $quotedline = $line;
$quotedline =~ s/\\/\\\\/g;
$quotedline =~ s/"/\\"/g;
}
if ($debug) {
}
}
}
### temporary workaround
sub asm {
return if $_[0] =~ /\s*\W/;
if (defined $_[1]) {
return if $_[1] eq "0" and
}
assemble "@_";
}
1;
=head1 NAME
B::Assembler - Assemble Perl bytecode
=head1 SYNOPSIS
use B::Assembler qw(newasm endasm assemble);
newasm(\&printsub); # sets up for assembly
assemble($buf); # assembles one line
endasm(); # closes down
use B::Assembler qw(assemble_fh);
assemble_fh($fh, \&printsub); # assemble everything in $fh
=head1 DESCRIPTION
See F<ext/B/B/Assembler.pm>.
=head1 AUTHORS
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>
=cut