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.
Raku · Jan 3, 2017 · 918cdb3 · 918cdb3
1 parent 5f40147
commit 918cdb3
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 17 deletions.
diff --git a/src/vm/jvm/QAST/Compiler.nqp b/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');

diff --git a/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java b/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;
+            }
         }
     }
 

diff --git a/src/vm/jvm/runtime/org/perl6/nqp/runtime/ThreadContext.java b/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