cvs commit: parrot assemble.pl

[simon]

simon       01/09/13 09:29:25

  Modified:    .        assemble.pl
  Log:
  Better opcode guessing, from Brian Wheeler. (Again!)
  
  Revision  Changes    Path
  1.14      +23 -9     parrot/assemble.pl
  
  Index: assemble.pl
  ===================================================================
  RCS file: /home/perlcvs/parrot/assemble.pl,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -w -r1.13 -r1.14
  --- assemble.pl       2001/09/13 16:16:38     1.13
  +++ assemble.pl       2001/09/13 16:29:24     1.14
  @@ -92,14 +92,23 @@
                if(m/^([INPS])\d+$/) {
                    # a register.
                    push @arg_t,lc($1);
  -             } elsif(m/^\d+$/) {
  -                 # a constant of some sort
  -                 push @arg_t,'(ic|nc|sc)';
                } else {
  -                 # a label
  +                 # a constant of some sort
  +                 if(m/^\[(\d+)\]$/) {
  +                     # string
  +                     push @arg_t,'sc';
  +                 } elsif(m/^((-?\d+)|(0b[01]+)|(0x[0-9a-f]+))$/i) {
  +                     # integer
                    push @arg_t,'ic';
  +                 } elsif(m/^[a-z][\w]*$/i) {
  +                     # label
  +                     push @arg_t,'ic';
  +                 } else {
  +                     # numeric
  +                     push @arg_t,'nc';
                }
            }
  +         }
            my $test;
            my($first,$last)=($arg_t[0],$arg_t[-1]);
            if($first ne $last) {
  @@ -109,7 +118,7 @@
            }
            my($found_op)=0;
            foreach my $op (grep($_=~/^$opcode/,keys(%opcodes))) {
  -             if($op=~/^$test$/) {
  +             if($op eq $test) {
                    $opcode=$op;
                    $found_op=1;
                    last;
  @@ -141,6 +150,9 @@
                       $args[$_]=($label{$args[$_]}-$op_pc)/4;
                   }
                   $pc+=$sizeof{$rtype};
  +         } elsif($rtype eq 's') {
  +             $args[$_]=~s/[\[\]]//g;
  +             $pc+=$sizeof{$rtype};           
               } else {
                   $args[$_]=oct($args[$_]) if($args[$_]=~/^0/);
                   $pc+=$sizeof{$rtype};           
  @@ -218,8 +230,10 @@
       # handle \ characters in the constant
       my %escape = ('a'=>"\a",'n'=>"\n",'r'=>"\r",'t'=>"\t",'\\'=>'\\',);
       $s=~s/\\([anrt\\])/$escape{$1}/g;
  -    return $constants{$s} if exists $constants{$s};
  -    push @constants, $s;
  -    return $constants{$s} = $#constants;
  +    if(!exists($constants{$s})) {
  +     push(@constants,$s);
  +     $constants{$s}=$#constants;
  +    }
  +    return "[".$constants{$s}."]";
   }