develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33868 - trunk/compilers/pge/PGE

From:
pmichaud
Date:
December 13, 2008 15:22
Subject:
[svn:parrot] r33868 - trunk/compilers/pge/PGE
Message ID:
20081213232206.93779CBAC8@x12.develooper.com
Author: pmichaud
Date: Sat Dec 13 15:22:05 2008
New Revision: 33868

Modified:
   trunk/compilers/pge/PGE/Exp.pir

Log:
[pge]:  Switch PGE to use :subid, add 'subid' option.


Modified: trunk/compilers/pge/PGE/Exp.pir
==============================================================================
--- trunk/compilers/pge/PGE/Exp.pir	(original)
+++ trunk/compilers/pge/PGE/Exp.pir	Sat Dec 13 15:22:05 2008
@@ -128,6 +128,15 @@
     name = code.'escape'(name)
     namecorou = code.'escape'(namecorou)
 
+    .local string subid
+    subid = ''
+    $P0 = adverbs['subid']
+    if null $P0 goto have_subid
+    $S0 = code.'escape'($P0)
+    subid = concat ':subid(', $S0
+    concat subid, ')'
+  have_subid:
+
     ##   Perform reduction/optimization on the
     ##   expression tree before generating PIR.
     .local pmc exp
@@ -151,17 +160,17 @@
     ##   Generate the initial PIR code for a backtracking (uncut) rule.
     .local string returnop
     returnop = '.yield'
-    code.'emit'(<<"        CODE", name, namecorou, .INTERPINFO_CURRENT_SUB)
-      .sub %0 :method
+    code.'emit'(<<"        CODE", name, subid, namecorou, .INTERPINFO_CURRENT_SUB)
+      .sub %0 :method %1
           .param pmc adverbs   :slurpy :named
           .local pmc mob
-          .const 'Sub' corou = %1
+          .const 'Sub' corou = %2
           $P0 = corou
           $P0 = clone $P0
           mob = $P0(self, adverbs)
           .return (mob)
       .end
-      .sub %1
+      .sub '' :subid(%2)
           .param pmc mob       :unique_reg
           .param pmc adverbs   :unique_reg
           .local string target :unique_reg
@@ -169,7 +178,7 @@
           .local int cpos, iscont :unique_reg
           $P0 = get_hll_global ['PGE'], 'Match'
           (mob, cpos, target, mfrom, mpos, iscont) = $P0.'new'(mob, adverbs :flat :named)
-          $P0 = interpinfo %2
+          $P0 = interpinfo %3
           setattribute mob, '&!corou', $P0
           .local int lastpos
           lastpos = length target
@@ -180,8 +189,8 @@
   code_cutrule:
     ##   Initial code for a rule that cannot be backtracked into.
     returnop = '.return'
-    code.'emit'(<<"        CODE", name)
-      .sub %0 :method
+    code.'emit'(<<"        CODE", name, subid)
+      .sub %0 :method %1
           .param pmc adverbs      :unique_reg :slurpy :named
           .local pmc mob
           .local string target    :unique_reg



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About