From 1cc2d3e1015282a30d035eadbfc3327fc3fb1c71 Mon Sep 17 00:00:00 2001
From: jnthn <jnthn@jnthn.net>
Date: Sat, 27 Apr 2013 14:13:17 +0200
Subject: [PATCH] Reduce cost of immediate block invocation.

---
 src/vm/jvm/QAST/Compiler.nqp                  | 36 ++++++++++++++++++-
 .../runtime/org/perl6/nqp/runtime/Ops.java    |  1 +
 2 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/src/vm/jvm/QAST/Compiler.nqp b/src/vm/jvm/QAST/Compiler.nqp
index 1d7e4463f3..4e511879f4 100644
--- a/src/vm/jvm/QAST/Compiler.nqp
+++ b/src/vm/jvm/QAST/Compiler.nqp
@@ -2076,6 +2076,10 @@ class QAST::CompilerJAST {
                 !! nqp::die("Unknown CUID '$cuid'")
         }
         
+        method cuid_to_jastmethname($cuid) {
+            @!jastmeth_names[self.cuid_to_idx($cuid)]
+        }
+        
         method set_lexical_names($cuid, @ilex, @nlex, @slex, @olex) {
             @!lexical_name_lists[self.cuid_to_idx($cuid)] := [@ilex, @nlex, @slex, @olex];
         }
@@ -3039,7 +3043,37 @@ class QAST::CompilerJAST {
                 return self.as_jast(QAST::BVal.new( :value($node) ));
             }
             elsif $blocktype eq 'immediate' {
-                return self.as_jast(QAST::Op.new( :op('call'), QAST::BVal.new( :value($node) ) ));
+                # Can emit a direct JVM level call. First, get self, TC,
+                # code ref, callsite descriptor and args (both empty) onto
+                # the stack.
+                my $il := JAST::InstructionList.new();
+                $il.append(JAST::Instruction.new( :op('aload_0') ));
+                $il.append(JAST::Instruction.new( :op('aload_1') ));
+                $il.append(JAST::Instruction.new( :op('aload_0') ));
+                $il.append(JAST::PushSVal.new( :value($node.cuid) ));
+                $il.append(JAST::Instruction.new( :op('invokevirtual'),
+                    $TYPE_CU, 'lookupCodeRef', $TYPE_CR, $TYPE_STR ));
+                $il.append(JAST::Instruction.new( :op('getstatic'),
+                    $TYPE_OPS, 'emptyCallSite', $TYPE_CSD ));
+                $il.append(JAST::Instruction.new( :op('getstatic'),
+                    $TYPE_OPS, 'emptyArgList', "[$TYPE_OBJ" ));
+                
+                # Emit the virtual call.
+                $il.append(JAST::Instruction.new( :op('invokevirtual'),
+                    'L' ~ $*JCLASS.name ~ ';',
+                    $*CODEREFS.cuid_to_jastmethname($node.cuid),
+                    'V', $TYPE_TC, $TYPE_CR, $TYPE_CSD, "[$TYPE_OBJ" ));
+                
+                # Load result onto the stack, unless in void context.
+                if $*WANT != $RT_VOID {
+                    $il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
+                    $il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
+                        'result_' ~ typechar($RT_OBJ), jtype($RT_OBJ), $TYPE_CF ));
+                    return result($il, $RT_OBJ)
+                }
+                else {
+                    return result($il, $RT_VOID)
+                }
             }
             elsif $blocktype eq 'raw' {
                 return self.as_jast(QAST::Op.new( :op('null') ));
diff --git a/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java b/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java
index 682a7d9d16..245a7a92f2 100644
--- a/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java
+++ b/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java
@@ -1193,6 +1193,7 @@ public static SixModelObject captureposarg(SixModelObject obj, long idx, ThreadC
     
     /* Invocation. */
     public static final CallSiteDescriptor emptyCallSite = new CallSiteDescriptor(new byte[0], null);
+    public static final Object[] emptyArgList = new Object[0];
     public static final CallSiteDescriptor invocantCallSite = new CallSiteDescriptor(new byte[] { CallSiteDescriptor.ARG_OBJ }, null);
     public static void invoke(SixModelObject invokee, int callsiteIndex, Object[] args, ThreadContext tc) throws Exception {
         // If it's lexotic, throw the exception right off.