Introduce setdispatcherfor op on JVM backend.

So that Rakudo can start using it. Should mean we also get the same
set of bug fixes that use of the new op provides for MoarVM also.

Author: jnthn

src/vm/jvm/QAST/Compiler.nqp

@@ -2706,20 +2706,8 @@ QAST::OperationsJAST.map_classlib_core_op('freshcoderef', $TYPE_OPS, 'freshcoder
 QAST::OperationsJAST.map_classlib_core_op('markcodestatic', $TYPE_OPS, 'markcodestatic', [$RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('markcodestub', $TYPE_OPS, 'markcodestub', [$RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getstaticcode', $TYPE_OPS, 'getstaticcode', [$RT_OBJ], $RT_OBJ, :tc);
-QAST::OperationsJAST.add_core_op('setdispatcher', -> $qastcomp, $op {
-    if +@($op) != 1 {
-        nqp::die('setdispatcher requires one operand');
-    }
-    my $il := JAST::InstructionList.new();
-    my $dispres := $qastcomp.as_jast($op[0], :want($RT_OBJ));
-    $il.append($dispres.jast);
-    $*STACK.obtain($il, $dispres);
-    $il.append($DUP);
-    $il.append($ALOAD_1);
-    $il.append($SWAP);
-    $il.append(JAST::Instruction.new( :op('putfield'), $TYPE_TC, 'currentDispatcher', $TYPE_SMO ));
-    result($il, $RT_OBJ);
-});
+QAST::OperationsJAST.map_classlib_core_op('setdispatcher', $TYPE_OPS, 'setdispatcher', [$RT_OBJ], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('setdispatcherfor', $TYPE_OPS, 'setdispatcherfor', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.add_core_op('takedispatcher', -> $qastcomp, $op {
     if +@($op) != 1 || !nqp::istype($op[0], QAST::SVal) {
         nqp::die('takedispatcher requires one string literal operand');

src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java

@@ -5167,10 +5167,34 @@ public static SixModelObject getstaticcode(SixModelObject code, ThreadContext tc
         else
             throw ExceptionHandling.dieInternal(tc, "getstaticcode can only be used with a CodeRef");
     }
+    public static SixModelObject setdispatcher(SixModelObject disp, ThreadContext tc) {
+        tc.currentDispatcher = disp;
+        return disp;
+    }
+    public static SixModelObject setdispatcherfor(SixModelObject disp, SixModelObject dispFor, ThreadContext tc) {
+        tc.currentDispatcher = disp;
+        if (dispFor instanceof CodeRef) {
+            tc.currentDispatcherFor = dispFor;
+        }
+        else {
+            InvocationSpec is = dispFor.st.InvocationSpec;
+            if (is == null)
+                throw ExceptionHandling.dieInternal(tc, "setdispatcherfor needs invokable target");
+                if (is.ClassHandle != null)
+                    tc.currentDispatcherFor = (CodeRef)dispFor.get_attribute_boxed(tc,
+                            is.ClassHandle, is.AttrName, is.Hint);
+                else
+                    throw ExceptionHandling.dieInternal(tc, "setdispatcherfor needs simple invokable target");
+        }
+        return disp;
+    }
     public static void takedispatcher(int lexIdx, ThreadContext tc) {
         if (tc.currentDispatcher != null) {
-            tc.curFrame.oLex[lexIdx] = tc.currentDispatcher;
-            tc.currentDispatcher = null;
+            if (tc.currentDispatcherFor == null ||
+                    tc.currentDispatcherFor == tc.curFrame.codeRef) {
+                tc.curFrame.oLex[lexIdx] = tc.currentDispatcher;
+                tc.currentDispatcher = null;
+            }
         }
     }
 

src/vm/jvm/runtime/org/perl6/nqp/runtime/ThreadContext.java

@@ -79,9 +79,11 @@ public class ThreadContext {
     public CallCaptureInstance savedCC;
 
     /**
-     * The currently set dispatcher, for the next interested call to take.
+     * The currently set dispatcher, for the next interested call (or the
+     * one matching currentDispatcherFor, if set) to take.
      */
     public SixModelObject currentDispatcher;
+    public SixModelObject currentDispatcherFor;
 
     /**
      * Serialization context write barrier disabled depth (anything non-zero