[svn:parrot] r44591 - branches/ops_pct/compilers/opsc/src/Ops/Compiler

[bacek at svn.parrot.org]

Author: bacek
Date: Tue Mar  2 11:13:43 2010
New Revision: 44591
URL: https://trac.parrot.org/parrot/changeset/44591

Log:
Add stub for munching body in ops2c style.

Modified:
   branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Tue Mar  2 11:13:18 2010	(r44590)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Tue Mar  2 11:13:43 2010	(r44591)
@@ -6,6 +6,7 @@
 our $CODE;
 
 INIT {
+    pir::load_bytecode("nqp-settings.pbc");
     $CODE := 0;
 }
 
@@ -216,10 +217,120 @@
     make PAST::Op.new(
         :node($/),
         :pasttype('inline'),
-        :inline(~$/)
+        :inline(munch_body(~$/))
     );
 }
 
+sub munch_body($body) {
+    #
+    # Macro substitutions:
+    #
+    # We convert the following notations:
+    #
+    #   .ops file          Op body  Meaning       Comment
+    #   -----------------  -------  ------------  ----------------------------------
+    #   goto OFFSET(X)     {{+=X}}  PC' = PC + X  Used for branches
+    #   goto NEXT()        {{+=S}}  PC' = PC + S  Where S is op size
+    #   goto ADDRESS(X)    {{=X}}   PC' = X       Used for absolute jumps
+    #   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
+    #
+    #   $X                 {{@X}}   Argument X    $0 is opcode, $1 is first arg
+    #
+    # For ease of parsing, if the argument to one of the above
+    # notations in a .ops file contains parentheses, then double the
+    # enclosing parentheses and add a space around the argument,
+    # like so:
+    #
+    #    goto OFFSET(( (void*)interp->happy_place ))
+    #
+    # Later transformations turn the Op body notations into C code, based
+    # on the mode of operation (function calls, switch statements, gotos
+    # with labels, etc.).
+    #
+
+    #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;
+=begin
+
+    $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;
+    }
+
+
+    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
+
+}
+
 # Local Variables:
 #   mode: perl6
 #   fill-column: 100