Refactor handling of how we locate the candidate list for a dispatche…

…r to be a bit more dynamic.

build/Makefile.in

@@ -198,7 +198,7 @@ $(PERL6_ML_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/ModuleLoader.pm
 	$(PARROT) $(PARROT_ARGS) -o $(PERL6_ML_PBC) $(PERL6_ML)
 
 $(PERL6_ST_PBC): $(NQP_EXE) $(PERL6_ML_PBC) src/Perl6/SymbolTable.pm
-	$(NQP_EXE) --target=pir --output=$(PERL6_ST) --encoding=utf8 \
+	$(NQP_EXE) --vmlibs=perl6_group,perl6_ops --target=pir --output=$(PERL6_ST) --encoding=utf8 \
 	    src/Perl6/SymbolTable.pm
 	$(PARROT) $(PARROT_ARGS) -o $(PERL6_ST_PBC) $(PERL6_ST)
 

src/CORE.setting/Code.pm

@@ -1,14 +1,14 @@
 my class Code {
     method clone() {
         my $cloned := pir::repr_clone__PP(self);
-        pir::setattribute__0PPsP($cloned, Code, 
+        pir::setattribute__0PPSP($cloned, Code,
             pir::repr_unbox_str__SP('$!do'),
-            pir::clone__PP($!do))
+            pir::perl6_associate_sub_code_object__0PP(
+                pir::clone__PP($!do), $cloned))
     }
 
     method derive_dispatcher() {
-        my $cloned := pir::repr_clone__PP(self);
-        pir::setattribute__0PPSP($cloned, Code,
+        pir::setattribute__0PPSP(self.clone(), Code,
             pir::repr_unbox_str__SP('$!dispatchees'),
             pir::clone__PP($!dispatchees))
     }

src/Perl6/Actions.pm

@@ -1082,11 +1082,6 @@ class Perl6::Actions is HLL::Actions {
         # Create code object.
         my $code := $*ST.create_code_object($block, 'Sub', $signature,
             $*MULTINESS eq 'proto');
-
-        # If we're a multi-dispatch entry point, add code object reference.
-        if $block<multi_enterer> {
-            $block<multi_enterer>.push($*ST.get_object_sc_ref_past($code));
-        }
 
         # Install PAST block so that it gets capture_lex'd correctly and also
         # install it in the lexpad.
@@ -1173,11 +1168,6 @@ class Perl6::Actions is HLL::Actions {
         my $code := $*ST.create_code_object($past, $type, $signature,
             $*MULTINESS eq 'proto');
 
-        # If we're a multi-dispatch entry point, add code object reference.
-        if $past<multi_enterer> {
-            $past<multi_enterer>.push($*ST.get_object_sc_ref_past($code));
-        }
-
         # Install PAST block so that it gets capture_lex'd correctly.
         my $outer := $*ST.cur_lexpad();
         $outer[0].push($past);
@@ -1211,9 +1201,7 @@ class Perl6::Actions is HLL::Actions {
 
     method onlystar($/) {
         my $BLOCK := $*CURPAD;
-        my $enterer := PAST::Op.new( :pirop('perl6_enter_multi_dispatch_from_onlystar_block PP') );
-        $BLOCK<multi_enterer> := $enterer;
-        $BLOCK.push($enterer);
+        $BLOCK.push(PAST::Op.new( :pirop('perl6_enter_multi_dispatch_from_onlystar_block P') ));
         $BLOCK.node($/);
         make $BLOCK;
     }

src/Perl6/SymbolTable.pm

@@ -393,14 +393,21 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
         my $stub := sub (*@pos, *%named) {
             unless $precomp {
                 $precomp := self.compile_in_context($code_past);
+                pir::perl6_associate_sub_code_object__vPP($precomp[0], $code);
             }
             $precomp(|@pos, |%named);
         };
         my $code_type := self.find_symbol(['Code']);
         pir::setattribute__vPPsP($code, $code_type, '$!do', $stub);
 
         # Fixup will install the real thing.
-        $fixups.push(self.set_attribute($code, $code_type, '$!do', PAST::Val.new( :value($code_past) )));
+        $fixups.push(PAST::Stmts.new(
+            self.set_attribute($code, $code_type, '$!do', PAST::Val.new( :value($code_past) )),
+            PAST::Op.new(
+                :pirop('perl6_associate_sub_code_object vPP'),
+                PAST::Val.new( :value($code_past) ),
+                self.get_object_sc_ref_past($code)
+            )));
 
         # Desserialization should do the actual creation and just put the right
         # code in there in the first place.
@@ -422,6 +429,12 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
                 PAST::Op.new( :pasttype('list') )));
         }
 
+        # Deserialization also needs to give the Parrot sub its backlink.
+        $des.push(PAST::Op.new(
+            :pirop('perl6_associate_sub_code_object vPP'),
+            PAST::Val.new( :value($code_past) ),
+            self.get_object_sc_ref_past($code)));
+
         self.add_event(:deserialize_past($des), :fixup_past($fixups));
         $code;
     }

src/ops/perl6.ops

@@ -516,6 +516,29 @@ inline op find_method_null_ok(out PMC, in PMC, in STR) :base_core {
 }
 
 
+/*
+
+=item perl6_associate_sub_code_object()
+
+Takes a Parrot Sub in $2 and a code object in $1 and associates the two.
+Actually, it uses a field in the Parrot Sub PMC that Rakudo never makes
+use of. Evil, but saves a prophash for every single code object.
+
+=cut
+
+*/
+inline op perl6_associate_sub_code_object(in PMC, in PMC) :base_core {
+    if ($1->vtable->base_type == enum_class_Sub) {
+        SETATTR_Sub_multi_signature(interp, $1, $2);
+        PARROT_GC_WRITE_BARRIER(interp, $1);
+    }
+    else {
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Can only use perl6_associate_sub_code_object if first operand is a Sub.");
+    }
+}
+
+
 /*
 
 =item perl6_enter_multi_dispatch()
@@ -526,9 +549,15 @@ candidate.
 =cut
 
 */
-inline op perl6_enter_multi_dispatch_from_onlystar_block(out PMC, in PMC) :base_core {
-    PMC *cur_ctx = CURRENT_CONTEXT(interp);
-    PMC *chosen  = Rakudo_md_dispatch(interp, $2, cur_ctx, NULL);
+inline op perl6_enter_multi_dispatch_from_onlystar_block(out PMC) :base_core {
+    PMC *cur_ctx    = CURRENT_CONTEXT(interp);
+    PMC *parrot_sub = Parrot_pcc_get_sub(interp, cur_ctx);
+    PMC *perl6_code, *chosen;
+    GETATTR_Sub_multi_signature(interp, parrot_sub, perl6_code);
+    if (PMC_IS_NULL(perl6_code))
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+                "Could not locate Perl 6 code object");
+    chosen = Rakudo_md_dispatch(interp, perl6_code, cur_ctx, NULL);
     if (!PMC_IS_NULL(chosen)) {
         /* Invoke the chosen candidate; we use the existing call frame
          * and don't make a nested runloop. */