First cut of op for finding a dispatcher (doesn't try to consider exh…

…austedness or any such stuff yet, though).

src/ops/perl6.ops

@@ -778,14 +778,63 @@ then this is a no-op.
 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(interp, lexpad, Parrot_str_new_constant(interp, "$*DISPATCHER"),
+        VTABLE_set_pmc_keyed_str(interp, lexpad, Parrot_str_new_constant(interp, "$*DISPATCHER"),
             current_dispatcher);
         current_dispatcher = NULL;
     }
 }
 
 /*
 
+=item perl6_find_dispatcher(out PMC)
+
+Locates the nearest dispatcher $*DISPATCHER, vivifying it if required,
+and returns it.
+
+=cut
+
+*/
+inline op perl6_find_dispatcher(out PMC) :base_core {
+    PMC     *ctx            = CURRENT_CONTEXT(interp);
+    STRING  *dispatcher_str = Parrot_str_new_constant(interp, "$*DISPATCHER");
+    PMC     *dispatcher     = NULL;
+
+    while (!PMC_IS_NULL(ctx)) {
+        /* Do we have a dispatcher here? */
+        PMC *lexpad = Parrot_pcc_get_lex_pad(interp, ctx);
+        if (VTABLE_exists_keyed_str(interp, lexpad, dispatcher_str)) {
+            dispatcher = VTABLE_get_pmc_keyed_str(interp, lexpad, dispatcher_str);
+            if (!REPR(dispatcher)->defined(interp, dispatcher)) {
+                /* Need to vivify it. */
+                PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
+                PMC *meth    = VTABLE_find_method(interp, dispatcher, Parrot_str_new_constant(interp, "vivify_for"));
+                PMC *cappy   = Parrot_pmc_new(interp, enum_class_CallContext);
+                PMC *sub     = Parrot_pcc_get_sub(interp, ctx);
+                PMC *p6sub;
+                VTABLE_push_pmc(interp, cappy, dispatcher);
+                GETATTR_Sub_multi_signature(interp, sub, p6sub);
+                VTABLE_push_pmc(interp, cappy, p6sub);
+                VTABLE_push_pmc(interp, cappy, lexpad);
+                Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
+                cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
+                Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
+                dispatcher = VTABLE_get_pmc_keyed_int(interp, cappy, 0);
+            }
+            break;
+        }
+
+        /* Follow dynamic chain. */
+        ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+    }
+
+    if (!dispatcher)
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "No dispatcher in scope");
+    $1 = dispatcher;
+}
+
+/*
+
 =item perl6_current_args_rpa(out PMC)
 
 Gets a ResizablePMCArray containing the positional arguments passed to the