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

bacek at svn.parrot.org bacek at svn.parrot.org
Fri Mar 12 22:46:56 UTC 2010


Author: bacek
Date: Fri Mar 12 22:46:54 2010
New Revision: 44905
URL: https://trac.parrot.org/parrot/changeset/44905

Log:
Rework handling of op_macro.

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

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Fri Mar 12 22:13:36 2010	(r44904)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Fri Mar 12 22:46:54 2010	(r44905)
@@ -104,9 +104,12 @@
     if !%flags<flow> {
         my $goto_next := PAST::Op.new(
             :pasttype('call'),
-            :name('goto_offset')
+            :name('goto_offset'),
+            PAST::Op.new(
+                :pasttype<call>,
+                :name<OPSIZE>,
+            )
         );
-        $goto_next<is_next> := 1;
 
         my $nl := "\n";
         $op.push(PAST::Op.new(
@@ -337,30 +340,78 @@
     # restart OFFSET()    -> restart_offset($addr); goto_offset($addr)
     # restart ADDRESS()   -> restart_address($addr); goto_offset($addr)
 
-    my $is_next    := ~$<macro_destination> eq 'NEXT';
-    my $macro_name := ~$<macro_type> ~ '_' ~ lc($is_next ?? 'offset' !! ~$<macro_destination>);
+    my $macro_type := ~$<macro_type>;
+    my $macro_dest := ~$<macro_destination>;
+    my $is_next    := $macro_dest eq 'NEXT';
+    my $macro_name := $macro_type ~ '_' ~ lc($is_next ?? 'offset' !! $macro_dest);
 
-    my $past := PAST::Op.new(
+    my $past  := PAST::Stmts.new;
+
+    my $macro := PAST::Op.new(
         :pasttype('call'),
         :name($macro_name),
     );
+    $past.push($macro);
 
     $past<jump> := list();
 
-    if ~$<macro_type> ne 'expr' && ~$<macro_destination> eq 'OFFSET' {
+    if $macro_type ne 'expr' && $macro_dest eq 'OFFSET' {
         $past<jump>.push('PARROT_JUMP_RELATIVE');
     }
 
+    if $macro_type eq 'expr' || $macro_type eq 'goto' {
+        if $is_next {
+            $macro.push(PAST::Op.new(
+                :pasttype<call>,
+                :name<OPSIZE>,
+            ));
+        }
+        else {
+            process_op_macro_body_word($/, $macro);
+        }
+    }
+    elsif $macro_type eq 'restart' {
+        if $is_next {
+            $macro.push(PAST::Op.new(
+                :pasttype<call>,
+                :name<OPSIZE>,
+            ));
+        }
+        else {
+            process_op_macro_body_word($/, $macro);
+        }
+
+        $macro := PAST::Op.new(
+            :pasttype<call>,
+            :name('goto_' ~ ($is_next ?? 'offset' !! lc($macro_dest))),
+        );
+        if $is_next {
+            $macro.push(PAST::Op.new(
+                :pasttype<call>,
+                :name<OPSIZE>,
+            ));
+        }
+        else {
+            process_op_macro_body_word($/, $macro);
+        }
+        $past.push($macro);
+    }
+    else {
+        pir::die("Horribly");
+    }
+
+    make $past;
+}
+
+sub process_op_macro_body_word($/, $macro) {
     #_dumper($<body_word>);
     if $<body_word> {
         for $<body_word> {
             #say(' word ' ~ $_);
             my $bit := $_.ast;
-            $past.push($_.ast) if defined($bit);
+            $macro.push($_.ast) if defined($bit);
         }
     }
-    $past<is_next> := $is_next;
-    make $past;
 }
 
 method macro_sanity_checks($/) {

Modified: branches/ops_pct/compilers/opsc/src/Ops/Op.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Fri Mar 12 22:13:36 2010	(r44904)
+++ branches/ops_pct/compilers/opsc/src/Ops/Op.pm	Fri Mar 12 22:46:54 2010	(r44905)
@@ -302,20 +302,18 @@
         }
         elsif $type eq 'call' {
             my $name     := $chunk.name;
-            my $is_next  := $chunk<is_next>;
             #say('NAME '~$name ~ ' ' ~ $is_next);
-            my $children;
-            if $is_next {
+            if $name eq 'OPSIZE' {
                 #say('is_next');
-                $children := ~self.size;
+                return ~self.size;
             }
-            else {
-                my @children := list();
-                for @($chunk) {
-                    @children.push(self.process_body_chunk($trans, $_));
-                }
-                $children := join('', |@children);
+
+            my @children := list();
+            for @($chunk) {
+                @children.push(self.process_body_chunk($trans, $_));
             }
+            my $children := join('', |@children);
+
             #pir::say('children ' ~ $children);
             my $ret := Q:PIR<
                 $P0 = find_lex '$trans'
@@ -328,6 +326,14 @@
             return $ret;
         }
     }
+    elsif $what eq 'PAST::Stmts()' {
+        my @children := list();
+        for @($chunk) {
+            @children.push(self.process_body_chunk($trans, $_));
+        }
+        my $children := join('', |@children);
+        return $children;
+    }
     else {
         pir::die('HOLEY');
     }

Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm	Fri Mar 12 22:13:36 2010	(r44904)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm	Fri Mar 12 22:46:54 2010	(r44905)
@@ -86,11 +86,11 @@
 }
 
 method restart_address($addr) {
-    "interp->resume_offset = $addr; interp->resume_flag = 1";
+    "interp->resume_offset = $addr; interp->resume_flag = 1;";
 }
 
 method restart_offset($offset) {
-    "interp->resume_offset = REL_PC + $offset; interp->resume_flag = 1";
+    "interp->resume_offset = REL_PC + $offset; interp->resume_flag = 1;";
 }
 
 method goto_address($addr) { "return (opcode_t *)$addr"; }


More information about the parrot-commits mailing list