From d3a9cc242f306ebb88b5a312ea7d331ad7bb8d93 Mon Sep 17 00:00:00 2001
From: diakopter <diakopter@gmail.com>
Date: Sun, 13 May 2012 12:52:24 -0700
Subject: [PATCH] whiteknight's PackfileView patch, with whitespace and stage0
 changes removed

---
 src/HLL/Compiler.pm   | 17 +++++++++++++++--
 src/NQP/World.pm      | 16 +++++++++-------
 src/QRegex/Cursor.nqp |  4 ++--
 src/Regex/Cursor.pir  |  2 ++
 t/qregex/01-qregex.t  |  2 +-
 5 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/src/HLL/Compiler.pm b/src/HLL/Compiler.pm
index 2e7f6110e7..c2d005b6d0 100644
--- a/src/HLL/Compiler.pm
+++ b/src/HLL/Compiler.pm
@@ -217,7 +217,17 @@ class HLL::Compiler {
                 pir::set_runcore__vs("subprof_hll");
             }
             pir::trace(%adverbs<trace>);
-            $output := $output(|@args);
+                        
+            # Execute :init subs
+            if !$output.is_initialized('init') {
+                for $output.subs_by_tag('init') -> $sub { $sub(); }
+                $output.mark_initialized('init');
+            }
+            
+            # Now execute the :main sub
+            my $main_sub := $output.main_sub();
+            $output := $main_sub(|@args);
+            
             pir::trace(0);
         }
         pir::set_runcore__vs($old_runcore);
@@ -479,7 +489,10 @@ class HLL::Compiler {
 
     method evalpmc($source, *%adverbs) {
         my $compiler := pir::compreg__Ps('PIR');
-        $compiler($source)
+        my $packfile := $compiler.compile($source);
+        for $packfile.subs_by_tag('init') -> $sub { $sub(); }
+        $packfile.mark_initialized('init');
+        $packfile
     }
 
     method dumper($obj, $name, *%options) {
diff --git a/src/NQP/World.pm b/src/NQP/World.pm
index 985993ad25..1a4a7c564e 100644
--- a/src/NQP/World.pm
+++ b/src/NQP/World.pm
@@ -199,21 +199,22 @@ class NQP::World is HLL::World {
             my $compiled := $nqpcomp.evalpmc($pir);
 
             # Fix up any code objects holding stubs with the real compiled thing.
-            my $c := nqp::elems($compiled);
+            my @all_subs := $compiled.all_subs();
+            my $c := nqp::elems(@all_subs);
             my $i := 0;
             while $i < $c {
-                my $subid := $compiled[$i].get_subid();
+                my $subid := @all_subs[$i].get_subid();
                 if pir::exists(%!code_objects_to_fix_up, $subid) {
                     # First, go over the code objects. Update the $!do, and the
                     # entry in the SC. Make sure the newly compiled code is marked
                     # as a static code ref.
                     my $static := %!code_objects_to_fix_up{$subid}.shift();
-                    nqp::bindattr($static, $code_type, '$!do', $compiled[$i]);
+                    nqp::bindattr($static, $code_type, '$!do', @all_subs[$i]);
                     for %!code_objects_to_fix_up{$subid} {
-                        nqp::bindattr($_, $code_type, '$!do', pir::clone($compiled[$i]));
+                        nqp::bindattr($_, $code_type, '$!do', pir::clone(@all_subs[$i]));
                     }
-                    pir::setprop__vPsP($compiled[$i], 'STATIC_CODE_REF', $compiled[$i]);
-                    self.update_root_code_ref(%!code_stub_sc_idx{$subid}, $compiled[$i]);
+                    pir::setprop__vPsP(@all_subs[$i], 'STATIC_CODE_REF', @all_subs[$i]);
+                    self.update_root_code_ref(%!code_stub_sc_idx{$subid}, @all_subs[$i]);
                     
                     # Clear up the fixup statements.
                     my $fixup_stmts := %!code_object_fixup_list{$subid};
@@ -222,7 +223,8 @@ class NQP::World is HLL::World {
                 $i := $i + 1;
             }
             
-            $compiled(|@args, |%named);
+            my $main_sub := $compiled.main_sub();
+            $main_sub(|@args, |%named);
         };
         
         # See if we already have our compile-time dummy. If not, create it.
diff --git a/src/QRegex/Cursor.nqp b/src/QRegex/Cursor.nqp
index 5c9f0f8093..e90793d3dc 100755
--- a/src/QRegex/Cursor.nqp
+++ b/src/QRegex/Cursor.nqp
@@ -485,12 +485,12 @@ class NQPCursor does NQPCursorRole {
                 for $var {
                     my $elem := $_;
                     $elem := $rxcompiler.compile($elem) unless pir::is_invokable__IP($elem);
-                    nqp::push($res, $elem);
+                    nqp::push($res, $elem.main_sub());
                 }
                 $var := $res;
             }
             else {
-                $var := $rxcompiler.compile($var);
+                $var := $rxcompiler.compile($var).main_sub();
             }
         }
         return self.'!INTERPOLATE'($var);
diff --git a/src/Regex/Cursor.pir b/src/Regex/Cursor.pir
index cb8aeeb369..8d9c396a9e 100644
--- a/src/Regex/Cursor.pir
+++ b/src/Regex/Cursor.pir
@@ -1231,6 +1231,7 @@ are first compiled to regexes prior to being matched.
     $I0 = does var, 'array'
     if $I0 goto var_array
     var = p6regex.'compile'(var)
+    var = var.'main_sub'()
     goto done
 
   var_array:
@@ -1243,6 +1244,7 @@ are first compiled to regexes prior to being matched.
     $I0 = is_invokable elem
     if $I0 goto var_next
     elem = p6regex.'compile'(elem)
+    elem = elem.'main_sub'()
   var_next:
     push var, elem
     goto var_loop
diff --git a/t/qregex/01-qregex.t b/t/qregex/01-qregex.t
index 7af3b4b6fa..4d7e915d01 100644
--- a/t/qregex/01-qregex.t
+++ b/t/qregex/01-qregex.t
@@ -45,7 +45,7 @@ sub test_line($line) {
 
     my $rxcomp := pir::compreg__Ps('QRegex::P6Regex');
     try {
-        my $rxsub  := $rxcomp.compile($regex);
+        my $rxsub  := $rxcomp.compile($regex).main_sub();
         my $cursor := NQPCursor."!cursor_init"($target, :c(0));
         my $match  := $rxsub($cursor).MATCH;
         if $expect_substr {