[svn:parrot] r44682 - in branches/ops_pct/compilers/opsc: gen/Ops/Trans src/Ops src/Ops/Compiler

[cotto at svn.parrot.org]

Author: cotto
Date: Sat Mar  6 09:40:11 2010
New Revision: 44682
URL: https://trac.parrot.org/parrot/changeset/44682

Log:
[opsc] add some more substitutions to munch_body, make Op.pm responsible for op-specific knowledge

Added:
   branches/ops_pct/compilers/opsc/gen/Ops/Trans/
Modified:
   branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
   branches/ops_pct/compilers/opsc/src/Ops/Op.pm

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Sat Mar  6 01:52:41 2010	(r44681)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Sat Mar  6 09:40:11 2010	(r44682)
@@ -235,10 +235,6 @@
     #   expr OFFSET(X)     {{^+X}}  PC + X        Relative address
     #   expr NEXT()        {{^+S}}  PC + S        Where S is op size
     #   expr ADDRESS(X)    {{^X}}   X             Absolute address
-    #   OP_SIZE            {{^S}}   S             op size
-    #
-    #   HALT()             {{=0}}   PC' = 0       Halts run_ops loop, no resume
-    #
     #   restart OFFSET(X)  {{=0,+=X}}   PC' = 0   Restarts at PC + X
     #   restart NEXT()     {{=0,+=S}}   PC' = 0   Restarts at PC + S
     #
@@ -258,6 +254,14 @@
 
     #subst($body, /\b/, { eval('{{$0}}') } );
     $body := subst($body,
+                /goto \s+ ADDRESS '((' $<addr>=[.*?] '))'/,
+                -> $m { '{{=' ~ $m<addr> ~ '}}' }
+            );
+    $body := subst($body,
+                /expr \s+ ADDRESS '((' $<addr>=[.*?] '))'/,
+                -> $m { '{{^' ~ $m<addr> ~ '}}' }
+            );
+    $body := subst($body,
                 /goto \s+ ADDRESS '(' $<addr>=[.*?] ')'/,
                 -> $m { '{{=' ~ $m<addr> ~ '}}' }
             );
@@ -266,68 +270,40 @@
                 -> $m { '{{^' ~ $m<addr> ~ '}}' }
             );
 
+    $body := subst($body, /expr \s+ NEXT '(' ')'/, '{{^+OP_SIZE}}');
+    $body := subst($body, /goto \s+ NEXT '(' ')'/, '{{+=OP_SIZE}}');
 
-    $body;
-=begin
+    $body := subst($body,
+                /restart \s+ OFFSET '(' $<addr>=[.*?] ')'/,
+                -> $m { '{{=0,+' ~ $m<addr> ~ '}}' }
+            );
+    $body := subst($body,
+                /restart \s+ NEXT '(' ')'/,
+                '{{=0,+=OP_SIZE}}'
+            );
+    $body := subst($body,
+                /restart \s+ ADDRESS '(' $<addr>=[.*?] ')'/,
+                -> $m { '{{=' ~ $m<addr> ~ '}}' }
+            );
+
+    $body := subst($body,
+                /'$' $<arg_num>=[\d+]/,
+                -> $m { '{{@' ~ $m<arg_num> ~ '}}' }
+            );
 
-    $absolute ||= $body =~ s/\bgoto\s+ADDRESS\(\( (.*?) \)\)/{{=$1}}/mg;
-                    $body =~ s/\bexpr\s+ADDRESS\(\( (.*?) \)\)/{{^$1}}/mg;
-    $absolute ||= $body =~ s/\bgoto\s+ADDRESS\((.*?)\)/{{=$1}}/mg;
-                    $body =~ s/\bexpr\s+ADDRESS\((.*?)\)/{{^$1}}/mg;
-
-    $branch   ||= $short_name =~ /runinterp/;
-    $branch   ||= $body =~ s/\bgoto\s+OFFSET\(\( (.*?) \)\)/{{+=$1}}/mg;
-                    $body =~ s/\bexpr\s+OFFSET\(\( (.*?) \)\)/{{^+$1}}/mg;
-    $branch   ||= $body =~ s/\bgoto\s+OFFSET\((.*?)\)/{{+=$1}}/mg;
-                    $body =~ s/\bexpr\s+OFFSET\((.*?)\)/{{^+$1}}/mg;
-
-    $next     ||= $short_name =~ /runinterp/;
-    $next     ||= $body =~ s/\bexpr\s+NEXT\(\)/{{^+$op_size}}/mg;
-                    $body =~ s/\bgoto\s+NEXT\(\)/{{+=$op_size}}/mg;
-
-    $body =~ s/\bHALT\(\)/{{=0}}/mg;
-    $body =~ s/\bOP_SIZE\b/{{^$op_size}}/mg;
-
-    if ( $body =~ s/\brestart\s+OFFSET\((.*?)\)/{{=0,+=$1}}/mg ) {
-        $branch  = 1;
-        $restart = 1;
-    }
-    elsif ( $body =~ s/\brestart\s+NEXT\(\)/{{=0,+=$op_size}}/mg ) {
-        $restart = 1;
-        $next    = 1;
-    }
-    elsif ( $body =~ s/\brestart\s+ADDRESS\((.*?)\)/{{=$1}}/mg ) {
-        $next    = 0;
-        $restart = 1;
-    }
-
-    $body =~ s/\$(\d+)/{{\@$1}}/mg;
-
-    # We can only reference as many parameters as we declare
-    my $max_arg_num = @$args;
-    my @found_args = ($body =~ m/{{@(\d+)}}/g);
-    foreach my $arg (@found_args) {
-        die "opcode '$short_name' uses '\$$arg' but only has $max_arg_num parameters.\n" if $arg > $max_arg_num;
-    }
 
+=begin COMMENT
 
     my $file_escaped = $file;
     $file_escaped =~ s|(\\)|$1$1|g;    # escape backslashes
     $op->body( $nolines ? $body : qq{#line $line "$file_escaped"\n$body} );
 
     # Constants here are defined in include/parrot/op.h
-    or_flag( \$jumps, "PARROT_JUMP_ADDRESS"  ) if $absolute;
     or_flag( \$jumps, "PARROT_JUMP_RELATIVE" ) if $branch;
-    or_flag( \$jumps, "PARROT_JUMP_ENEXT"    ) if $next;
-    or_flag( \$jumps, "PARROT_JUMP_RESTART"  ) if $restart;
 
-    # I'm assuming the op branches to the value in the last argument.
-    if ( ($jumps)
-        && ( $fixedargs[ @fixedargs - 1 ] )
-        && ( $fixedargs[ @fixedargs - 1 ] eq 'i' ) ) {
-        or_flag( \$jumps, "PARROT_JUMP_GNEXT" );
-    }
-=end
+=end COMMENT
+
+    $body;
 
 }
 

Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Sat Mar  6 01:52:41 2010	(r44681)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Sat Mar  6 09:40:11 2010	(r44682)
@@ -205,7 +205,12 @@
 # Called from rewrite_body() to perform the actual substitutions.
 method _substitute($str, $trans) {
     $str;
-=begin
+=begin 
+
+    #also needed:
+    s/OP_SIZE/ self.size /g;
+    check that {{@1}}, {{@2}}, ... are defined
+
     my $rewrote_access =
         s/{{\@([^{]*?)}}/   $trans->access_arg($self->arg_type($1 - 1), $1, $self); /me;
 
@@ -269,14 +274,11 @@
 Returns the op's number of arguments. Note that this also includes
 the op itself as one argument.
 
-=cut
-
-sub size {
-    my $self = shift;
+=end
 
-    return scalar( $self->arg_types + 1 );
+method size() {
+    return +self.arg_types + 1;
 }
-=end
 
 =begin