cvsuser 01/09/19 21:08:16
Modified: . assemble.pl
Log:
macro expansion. Here's the test macro I was using:
# this uses I32,I31 as temporaries.
# macro must be preceeded by a label.
testi macro num,got,want
print "Test #"
print num
print "..."
set I32,want
set I31,got
eq I32,I31,$ok
print "NG\n"
branch $end
$ok: print "OK\n"
$end:
endm
It is invoked as:
Test1: testi 1,I3,I2
Revision Changes Path
1.32 +114 -59 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- assemble.pl 2001/09/20 01:49:55 1.31
+++ assemble.pl 2001/09/20 04:08:16 1.32
@@ -18,7 +18,7 @@
'listing=s'));
if($options{'version'}) {
- print $0,'Version $Id: assemble.pl,v 1.31 2001/09/20 01:49:55 bdwheele Exp $
',"\n";
+ print $0,'Version $Id: assemble.pl,v 1.32 2001/09/20 04:08:16 bdwheele Exp $
',"\n";
exit;
}
@@ -81,21 +81,29 @@
# assemble
my $pc=0; my $op_pc=0;
my ($bytecode,%label,%fixup,%constants,@constants);
-my (%local_label, %local_fixup, $last_label);
+my (%local_label, %local_fixup, $last_label, %macros);
my $line=0;
my %equate=('*'=>sub { return $pc },
'__DATE__'=>'"'.scalar(localtime).'"',
- '__VERSION__'=>'" $Revision: 1.31 $ "',
+ '__VERSION__'=>'" $Revision: 1.32 $ "',
'__LINE__' => sub { return $line });
-foreach my $l (@program) {
+my($code,$in_macro,$cur_macro);
+while(my $l=shift(@program)) {
my($file,$line,$pline,$sline)=@$l;
- if($pline=~m/^\#/ || $pline eq "") {
- if($options{'listing'}) {
- $listing.=sprintf("%4d %08x %-44s %s\n", $line, $op_pc, '',$sline);
+ if($in_macro) {
+ if($pline=~m/^endm$/i) {
+ # end of the macro
+ $in_macro=0;
+ } else {
+ push(@{$macros{$cur_macro}[1]},$l);
}
- next;
+ $pline="";
}
- my($label,$code);
+ if($pline=~m/^\#/ || $pline eq "") {
+ # its a comment, do nothing
+ $code=undef;
+ } else {
+ my($label);
if($pline=~m/^(\S+):\s*(.+)?/) {
($label,$code)=($1,$2);
if(defined($label) && $label ne "") {
@@ -145,14 +153,61 @@
if($pline=~m/^([_a-zA-Z]\w*)\s+equ\s+(.+)$/i) {
my($name,$data)=($1,$2);
$equate{$name}=$data;
+ } elsif($pline=~m/^([_a-zA-Z]\w*)\s+macro\s+(.+)$/i) {
+ # a macro definition
+ my($name,$args)=($1,$2);
+ $cur_macro=$name;
+ $macros{$name}=[[split(/,\s*/,$args)],[]];
+ $in_macro=1;
} else {
$code=$pline;
}
+ }
+ }
+ if(!defined($code)) {
+ $listing.=sprintf("%4d %08x %-44s %s\n", $line, $op_pc, '',$sline)
+ if($options{'listing'});
+ next;
}
- next if(!defined($code));
+
1 while $code=~s/\"([^\\\"]*(?:\\.[^\\\"]*)*)\"/constantize($1)/eg;
$code=~s/,/ /g;
my($opcode,@args)=split(/\s+/,$code);
+ if(exists($macros{$opcode})) {
+ # found a macro
+ my(@margs)=@{$macros{$opcode}[0]};
+ my(@macro);
+ # we have to make sure to copy the macro, to avoid mangling the
+ # original macro definition.
+ foreach (@{$macros{$opcode}[1]}) {
+ push(@macro,[@$_]);
+ }
+ if(scalar(@margs) != scalar(@args)) {
+ error("Wrong number of arguments to macro '$opcode'",$file,$line);
+ }
+ # fixup parameters.
+ while(my $marg=shift(@margs)) {
+ my $param=shift(@args);
+ foreach (@macro) {
+ $_->[2]=~s/([\s,])$marg\b/$1$param/g;
+ $_->[3]=~s/([\s,])$marg\b/$1$param/g;
+ }
+ }
+
+ # fixup file, line number, listing
+ foreach (@macro) {
+ $_->[0]=$file;
+ $_->[1]=$line;
+ $_->[3]="> ".$_->[3];
+ }
+ unshift(@program,@macro);
+
+ # make it come out correctly on the listing.
+ $l->[2]='';
+ unshift(@program,$l);
+ next;
+ }
+
$opcode=lc($opcode);
if (!exists $opcodes{$opcode}) {
# try to determine _real_ opcode.
@@ -311,7 +366,7 @@
# FIXUP (also, dump listing symbols)
if($options{'listing'}) {
- $listing.="DEFINED SYMBOLS:\n";
+ $listing.="\nDEFINED SYMBOLS:\n";
foreach (sort(keys(%label))) {
$listing.=sprintf("\t%08x %s\n",$label{$_},$_);
}
