Merge pull request #4393 from rakudo/speed_up_native_call_setup

Speed up setup of NativeCall subs and reduce memory usage
rakudo · Jun 10, 2021 · 9433d0f · 9433d0f
2 parents faec804 + 3b7fef2
commit 9433d0f
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 10 deletions.
diff --git a/lib/NativeCall.rakumod b/lib/NativeCall.rakumod
@@ -578,8 +578,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi
 
         # finish compilation of the original routine so our changes won't
         # become undone right afterwards
-        my Mu \compstuff := nqp::getattr(self, Code, q<@!compstuff>);
-        compstuff[1]() unless nqp::isnull(compstuff);
+        $*W.unstub_code_object(self, Code) if $*W;
 
         my $replacement := -> |args {
             self.create-optimized-call() unless
@@ -594,11 +593,6 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi
             nqp::nativecall($!rettype, self, $args)
         };
 
-        if $*W { # prevent compile_in_context from undoing our replacement
-            my $cuid := nqp::getcodecuid(nqp::getattr(self, Code, '$!do'));
-            nqp::deletekey($*W.context().sub_id_to_code_object(), $cuid);
-        }
-
         my $do := nqp::getattr($replacement, Code, '$!do');
         nqp::bindattr(self, Code, '$!do', $do);
         nqp::setcodename($do, $!name);

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -2677,11 +2677,11 @@ class Perl6::World is HLL::World {
                 # do dynamic compilation.
                 %!code_object_fixup_list{$cuid} := $fixups;
             }
-
-            # Stash the QAST block in the comp stuff.
-            @compstuff[0] := $code_past;
         }
 
+        # Stash the QAST block in the comp stuff.
+        @compstuff[0] := $code_past;
+
         # If this is a dispatcher, install dispatchee list that we can
         # add the candidates too.
         if $is_dispatcher {
@@ -2977,6 +2977,26 @@ class Perl6::World is HLL::World {
         # asked to compile.
         $result
     }
+    method unstub_code_object($code, $code_type) {
+        my @compstuff := nqp::getattr($code, $code_type, q<@!compstuff>);
+        unless nqp::isnull(@compstuff) {
+            my $subid := @compstuff[0].cuid;
+
+            nqp::bindattr($code, $code_type, '@!compstuff', nqp::null());
+
+            my %sub_id_to_sc_idx := self.context().sub_id_to_sc_idx();
+            my $code_ref := nqp::getattr($code, $code_type, '$!do');
+            if nqp::existskey(%sub_id_to_sc_idx, $subid) {
+                nqp::markcodestatic($code_ref); # maybe $!do instead
+                self.update_root_code_ref(%sub_id_to_sc_idx{$subid}, $code_ref);
+            }
+            if nqp::existskey(%!code_object_fixup_list, $subid) {
+                my $fixups := %!code_object_fixup_list{$subid};
+                $fixups.pop() while $fixups.list;
+            }
+            nqp::deletekey(self.context().sub_id_to_code_object(), $subid);
+        }
+    }
     method try_add_to_sc($value, $fallback) {
         if nqp::isnull($value) {
             return $fallback;