Dispatcher changes for portability improvements.

Gets rid of the remaining pir:: in the Metamodel code. Also uses a new
op made available since the dispatcher code was written to avoid loads
of copy arguments around, meaning that deferral becomes cheaper on
Rakudo on Parrot also.

src/Perl6/Actions.nqp

@@ -722,7 +722,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
 
             # Add a slot for a $*DISPATCHER, and a call to take one.
             add_implicit_var($block, '$*DISPATCHER');
-            $block[0].unshift(QAST::Op.new(:op('p6takedisp')));
+            $block[0].unshift(QAST::Op.new(
+                :op('takedispatcher'),
+                QAST::SVal.new( :value('$*DISPATCHER') )
+            ));
 
             # We'll install PAST in current block so it gets capture_lex'd.
             # Then evaluate to a reference to the block (non-closure - higher
@@ -2024,7 +2027,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
         else {
             add_implicit_var($block, '$*DISPATCHER');
         }
-        $block[0].unshift(QAST::Op.new(:op('p6takedisp')));
+        $block[0].unshift(QAST::Op.new(
+            :op('takedispatcher'),
+            QAST::SVal.new( :value('$*DISPATCHER') )
+        ));
 
         # Set name.
         if $<deflongname> {
@@ -2575,7 +2581,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
         # Needs a slot to hold a multi or method dispatcher.
         $*W.install_lexical_symbol($past, '$*DISPATCHER',
             $*W.find_symbol([$*MULTINESS eq 'multi' ?? 'MultiDispatcher' !! 'MethodDispatcher']));
-        $past[0].unshift(QAST::Op.new(:op('p6takedisp')));
+        $past[0].unshift(QAST::Op.new(
+            :op('takedispatcher'),
+            QAST::SVal.new( :value('$*DISPATCHER') )
+        ));
 
         # Finish up code object.
         $*W.attach_signature($code, $signature);

src/Perl6/Metamodel/Dispatchers.nqp

@@ -13,36 +13,20 @@ class Perl6::Metamodel::BaseDispatcher {
         $!idx := $!idx + 1;
         if self.has_invocant {
             my $inv := self.invocant;
-            pir::perl6_set_dispatcher_for_callee__vP(self);
+            nqp::setdispatcher(self);
             $call($inv, |@pos, |%named);
         }
         else {
-            pir::perl6_set_dispatcher_for_callee__vP(self);
+            nqp::setdispatcher(self);
             $call(|@pos, |%named);
         }
     }
 
     method call_with_capture($capture) {
-        # Extract parts of the capture.
-        my @pos;
-        my %named;
-        my $i := 0;
-        while $i < nqp::elems($capture) {
-            @pos[$i] := $capture[$i];
-            $i := $i + 1;
-        }
-        my @nameds := pir::getattribute__PPs($capture, 'named');
-        unless nqp::isnull(@nameds) {
-            for @nameds {
-                %named{$_} := $capture{$_};
-            }
-        }
-
-        # Call.
         my $call := @!candidates[$!idx];
         $!idx := $!idx + 1;
-        pir::perl6_set_dispatcher_for_callee__vP(self);
-        $call(|@pos, |%named);
+        nqp::setdispatcher(self);
+        nqp::invokewithcapture($call, $capture)
     }
 }
 
@@ -114,7 +98,7 @@ class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher {
     method enter(*@pos, *%named) {
         my $fresh := nqp::clone(self);
         my $first := self.candidates[0];
-        pir::perl6_set_dispatcher_for_callee__vP($fresh);
+        nqp::setdispatcher($fresh);
         $first(|@pos, |%named)
     }
 }

src/vm/jvm/Perl6/Ops.nqp

@@ -23,7 +23,6 @@ $ops.map_classlib_hll_op('perl6', 'p6listitems', $TYPE_P6OPS, 'p6listitems', [$R
 $ops.map_classlib_hll_op('perl6', 'p6decont', $TYPE_P6OPS, 'decont', [$RT_OBJ], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6recont_ro', $TYPE_P6OPS, 'p6recont_ro', [$RT_OBJ], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6store', $TYPE_P6OPS, 'p6store', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6takedisp', $TYPE_P6OPS, 'p6takedisp', [], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6var', $TYPE_P6OPS, 'p6var', [$RT_OBJ], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6reprname', $TYPE_P6OPS, 'p6reprname', [$RT_OBJ], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6definite', $TYPE_P6OPS, 'p6definite', [$RT_OBJ], $RT_OBJ, :tc);

src/vm/parrot/Perl6/Ops.nqp

@@ -12,7 +12,6 @@ $ops.add_hll_pirop_mapping('perl6', 'p6listitems', 'perl6_listitems', 'PP', :inl
 $ops.add_hll_pirop_mapping('perl6', 'p6decont', 'perl6_decontainerize', 'PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6recont_ro', 'perl6_recontainerize_to_ro', 'PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6store', 'perl6_container_store', '0PP', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'p6takedisp', 'perl6_take_dispatcher', 'v');
 $ops.add_hll_pirop_mapping('perl6', 'p6var', 'perl6_var', 'PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6reprname', 'perl6_repr_name', 'PP', :inlinable(1));
 $ops.add_hll_pirop_mapping('perl6', 'p6definite', 'perl6_definite', 'PP', :inlinable(1));

src/vm/parrot/ops/perl6.ops

@@ -28,9 +28,6 @@ BEGIN_OPS_PREAMBLE
 static INTVAL smo_id = 0;
 static INTVAL qrpa_id = 0;
 
-/* The current dispatcher, for the next thing that wants one to take. */
-static PMC *current_dispatcher = NULL;
-
 static PMC *build_sig_object(PARROT_INTERP, ARGIN_NULLOK(PMC *signature), ARGIN(const char *sig), ...)
 {
     PMC *sig_obj;
@@ -1153,40 +1150,6 @@ inline op perl6_get_package_through_who(out PMC, in PMC, in STR) :base_core {
     }
 }
 
-/*
-
-=item perl6_set_dispatcher_for_callee(in PMC)
-
-Sets the dispatcher that the next thing we call that is interested
-in one will take.
-
-=cut
-
-*/
-inline op perl6_set_dispatcher_for_callee(in PMC) :base_core {
-    current_dispatcher = $1;
-}
-
-/*
-
-=item perl6_take_dispatcher()
-
-Takes the dispatcher that was set, if any, and store it in the current
-lexpad's $*DISPATCHER. Also clears the current set dispatcher so that
-nothing else can take it by accident. If there's no current set dispatcher
-then this is a no-op.
-
-=cut
-
-*/
-inline op perl6_take_dispatcher() :base_core {
-    if (current_dispatcher) {
-        PMC *lexpad = Parrot_pcc_get_lex_pad(interp, CURRENT_CONTEXT(interp));
-        VTABLE_set_pmc_keyed_str(interp, lexpad, Parrot_str_new_constant(interp, "$*DISPATCHER"),
-            current_dispatcher);
-        current_dispatcher = NULL;
-    }
-}
 
 /*
 

tools/build/NQP_REVISION

@@ -1 +1 @@
-2013.04-69-g9c79d1f
+2013.04-101-ge610165