cvs commit: parrot assemble.pl

[bdwheele]

cvsuser     01/09/16 11:25:27

  Modified:    .        assemble.pl
  Log:
  parrot assembly equates
  
  Revision  Changes    Path
  1.24      +120 -107  parrot/assemble.pl
  
  Index: assemble.pl
  ===================================================================
  RCS file: /home/perlcvs/parrot/assemble.pl,v
  retrieving revision 1.23
  retrieving revision 1.24
  diff -u -w -r1.23 -r1.24
  --- assemble.pl       2001/09/16 15:19:24     1.23
  +++ assemble.pl       2001/09/16 18:25:27     1.24
  @@ -18,7 +18,7 @@
                      'listing=s'));
   
   if($options{'version'}) {
  -    print $0,'Version $Id: assemble.pl,v 1.23 2001/09/16 15:19:24 bdwheele Exp $ 
',"\n";
  +    print $0,'Version $Id: assemble.pl,v 1.24 2001/09/16 18:25:27 bdwheele Exp $ 
',"\n";
       exit;
   }
   
  @@ -70,7 +70,7 @@
   
   # read source and assemble
   my $pc=0; my $op_pc=0;
  -my ($bytecode,%label,%fixup,%constants,@constants);
  +my ($bytecode,%label,%fixup,%constants,@constants,%equate);
   my (%local_label, %local_fixup, $last_label);
   my $line=0;
   while(<>) {
  @@ -85,8 +85,9 @@
        }
        next;
       }
  -    if(m/^((\S+):)?\s*(.+)?/) {
  -        my($label,$code)=($2,$3);
  +    my($label,$code);
  +    if(m/^(\S+):\s*(.+)?/) {
  +        ($label,$code)=($1,$2);
        if(defined($label) && $label ne "") {
            if($label=~m/^\$/) {
                # a local label
  @@ -129,6 +130,15 @@
                $last_label=$label;
            }
        }
  +    } else {
  +     # here's where we can catch assembler directives!
  +     if(m/^([_a-zA-Z]\w*)\s+equ\s+(.+)$/i) {
  +         my($name,$data)=($1,$2);
  +         $equate{$name}=$data;
  +     } else {
  +         $code=$_;
  +     }
  +    }
           next if(!defined($code));
           1 while $code=~s/\"([^\\\"]*(?:\\.[^\\\"]*)*)\"/constantize($1)/eg;
           $code=~s/,/ /g;
  @@ -138,6 +148,11 @@
            # try to determine _real_ opcode.
            my @arg_t=();
            foreach (@args) {
  +         if(exists($equate{$_})) {
  +             # substitute the equate value
  +             $_=$equate{$_};
  +             s/\"([^\\\"]*(?:\\.[^\\\"]*)*)\"/constantize($1)/eg;
  +         }
                if(m/^([INPS])\d+$/) {
                    # a register.
                    push @arg_t,lc($1);
  @@ -238,7 +253,6 @@
            $listing.=sprintf("%4d %08x %-44s %s\n", $line, $op_pc, $odata,$sline);
        }
       }
  -}
   $listing.="\n" if($options{'listing'});
   
   my $output;
  @@ -258,8 +272,7 @@
   }
   
   if(keys(%fixup)) {
  -    print STDERR "SQUAWK!  These symbols were referenced but not
  -defined:\n";
  +    print STDERR "SQUAWK!  These symbols were referenced but not defined:\n";
       foreach (sort(keys(%fixup))) {
           print STDERR "\t$_ at pc: ";
           foreach my $pc (@{$fixup{$_}}) {