Permalink
Browse files

Get optimizer inlining working on JVM backend.

This also fixes an oops-looking-at-invalid-memory bug that could take
place on the Parrot backend post-inline.
  • Loading branch information...
jnthn committed Aug 5, 2013
1 parent e815354 commit fe419d2c615b297f0d9475e849d9923f0bfc7f36
View
@@ -2148,6 +2148,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
unless nqp::objprimspec($block[1].returns) {
$block[1] := QAST::Op.new(
:op('p6decontrv'),
+ QAST::WVal.new( :value($*DECLARAND) ),
$block[1]);
}
$block[1] := QAST::Op.new(
@@ -2542,7 +2543,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
if is_clearly_returnless($past) {
$past[1] := QAST::Op.new(
:op('p6typecheckrv'),
- QAST::Op.new( :op('p6decontrv'), $past[1]),
+ QAST::Op.new( :op('p6decontrv'), QAST::WVal.new( :value($*DECLARAND) ), $past[1] ),
QAST::WVal.new( :value($*DECLARAND) ));
}
else {
@@ -2637,6 +2638,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
if is_clearly_returnless($block) {
$block[1] := QAST::Op.new(
:op('p6decontrv'),
+ QAST::WVal.new( :value($*DECLARAND) ),
$block[1]);
}
else {
@@ -5930,7 +5932,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
:op<lexotic>, :name<RETURN>,
# If we fall off the bottom, decontainerize if
# rw not set.
- QAST::Op.new( :op('p6decontrv'), $past )
+ QAST::Op.new( :op('p6decontrv'), QAST::WVal.new( :value($*DECLARAND) ), $past )
),
QAST::Op.new(
:op<bind>,
View
@@ -41,7 +41,7 @@ $ops.map_classlib_hll_op('perl6', 'p6store', $TYPE_P6OPS, 'p6store', [$RT_OBJ, $
$ops.map_classlib_hll_op('perl6', 'p6var', $TYPE_P6OPS, 'p6var', [$RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6reprname', $TYPE_P6OPS, 'p6reprname', [$RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6definite', $TYPE_P6OPS, 'p6definite', [$RT_OBJ], $RT_OBJ, :tc);
-$ops.add_hll_op('perl6', 'p6bindsig', -> $qastcomp, $op {
+$ops.add_hll_op('perl6', 'p6bindsig', :!inlinable, -> $qastcomp, $op {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
$il.append(JAST::Instruction.new( :op('aload'), 'csd' ));
@@ -69,16 +69,16 @@ $ops.map_classlib_hll_op('perl6', 'p6isbindable', $TYPE_P6OPS, 'p6isbindable', [
$ops.map_classlib_hll_op('perl6', 'p6bindcaptosig', $TYPE_P6OPS, 'p6bindcaptosig', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6trialbind', $TYPE_P6OPS, 'p6trialbind', [$RT_OBJ, $RT_OBJ, $RT_OBJ], $RT_INT, :tc);
$ops.map_classlib_hll_op('perl6', 'p6typecheckrv', $TYPE_P6OPS, 'p6typecheckrv', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6decontrv', $TYPE_P6OPS, 'p6decontrv', [$RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6capturelex', $TYPE_P6OPS, 'p6capturelex', [$RT_OBJ], $RT_OBJ, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6decontrv', $TYPE_P6OPS, 'p6decontrv', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6capturelex', $TYPE_P6OPS, 'p6capturelex', [$RT_OBJ], $RT_OBJ, :tc, :!inlinable);
$ops.map_classlib_hll_op('perl6', 'p6bindassert', $TYPE_P6OPS, 'p6bindassert', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6stateinit', $TYPE_P6OPS, 'p6stateinit', [], $RT_INT, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6stateinit', $TYPE_P6OPS, 'p6stateinit', [], $RT_INT, :tc, :!inlinable);
$ops.map_classlib_hll_op('perl6', 'p6setpre', $TYPE_P6OPS, 'p6setpre', [], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6clearpre', $TYPE_P6OPS, 'p6clearpre', [], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6inpre', $TYPE_P6OPS, 'p6inpre', [], $RT_INT, :tc);
$ops.map_classlib_hll_op('perl6', 'p6setfirstflag', $TYPE_P6OPS, 'p6setfirstflag', [$RT_OBJ], $RT_OBJ, :tc);
$ops.map_classlib_hll_op('perl6', 'p6takefirstflag', $TYPE_P6OPS, 'p6takefirstflag', [], $RT_INT, :tc);
-$ops.add_hll_op('perl6', 'p6return', -> $qastcomp, $op {
+$ops.add_hll_op('perl6', 'p6return', :!inlinable, -> $qastcomp, $op {
my $il := JAST::InstructionList.new();
my $exprres := $qastcomp.as_jast($op[0], :want($RT_OBJ));
$il.append($exprres.jast);
@@ -97,9 +97,9 @@ $ops.add_hll_op('perl6', 'p6return', -> $qastcomp, $op {
$il.append(JAST::Instruction.new( :op('return') ));
$ops.result($il, $RT_OBJ);
});
-$ops.map_classlib_hll_op('perl6', 'p6routinereturn', $TYPE_P6OPS, 'p6routinereturn', [$RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6getouterctx', $TYPE_P6OPS, 'p6getouterctx', [$RT_OBJ], $RT_OBJ, :tc);
-$ops.map_classlib_hll_op('perl6', 'p6captureouters', $TYPE_P6OPS, 'p6captureouters', [$RT_OBJ], $RT_OBJ, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6routinereturn', $TYPE_P6OPS, 'p6routinereturn', [$RT_OBJ], $RT_OBJ, :tc, :!inlinable);
+$ops.map_classlib_hll_op('perl6', 'p6getouterctx', $TYPE_P6OPS, 'p6getouterctx', [$RT_OBJ], $RT_OBJ, :tc, :!inlinable);
+$ops.map_classlib_hll_op('perl6', 'p6captureouters', $TYPE_P6OPS, 'p6captureouters', [$RT_OBJ], $RT_OBJ, :tc, :!inlinable);
$ops.add_hll_op('perl6', 'p6argvmarray', -> $qastcomp, $op {
my $il := JAST::InstructionList.new();
$il.append(JAST::Instruction.new( :op('aload_1') ));
@@ -432,10 +432,10 @@ public static SixModelObject p6store(SixModelObject cont, SixModelObject value,
return cont;
}
- public static SixModelObject p6decontrv(SixModelObject cont, ThreadContext tc) {
+ public static SixModelObject p6decontrv(SixModelObject routine, SixModelObject cont, ThreadContext tc) {
GlobalExt gcx = key.getGC(tc);
if (cont != null && isRWScalar(tc, gcx, cont)) {
- tc.curFrame.codeRef.codeObject.get_attribute_native(tc, gcx.Routine, "$!rw", HINT_ROUTINE_RW);
+ routine.get_attribute_native(tc, gcx.Routine, "$!rw", HINT_ROUTINE_RW);
if (tc.native_i == 0) {
/* Recontainerize to RO. */
SixModelObject roCont = gcx.Scalar.st.REPR.allocate(tc, gcx.Scalar.st);
@@ -19,7 +19,7 @@ $ops.add_hll_pirop_mapping('perl6', 'p6isbindable', 'perl6_is_sig_bindable', 'IP
$ops.add_hll_pirop_mapping('perl6', 'p6bindcaptosig', 'perl6_bind_sig_to_cap', '0PP');
$ops.add_hll_pirop_mapping('perl6', 'p6trialbind', 'perl6_trial_bind_ct', 'IPPP');
$ops.add_hll_pirop_mapping('perl6', 'p6typecheckrv', 'perl6_type_check_return_value', '0PP', :inlinable(1));
-$ops.add_hll_pirop_mapping('perl6', 'p6decontrv', 'perl6_decontainerize_return_value', 'PP', :inlinable(1));
+$ops.add_hll_pirop_mapping('perl6', 'p6decontrv', 'perl6_decontainerize_return_value', 'PPP', :inlinable(1));
$ops.add_hll_pirop_mapping('perl6', 'p6capturelex', 'perl6_capture_lex', '0P');
$ops.add_hll_pirop_mapping('perl6', 'p6bindassert', 'perl6_assert_bind_ok', '0PP');
$ops.add_hll_pirop_mapping('perl6', 'p6stateinit', 'perl6_state_needs_init', 'I');
@@ -925,19 +925,14 @@ If the sub is not rw, decontainerizes the return value.
=cut
*/
-inline op perl6_decontainerize_return_value(out PMC, in PMC) :base_core {
- if ($2->vtable->base_type == smo_id && Rakudo_cont_is_rw_scalar(interp, $2)) {
- PMC *cur_ctx = CURRENT_CONTEXT(interp);
- PMC *parrot_sub = Parrot_pcc_get_sub(interp, cur_ctx);
- PMC *p6sub;
- Rakudo_Code *code;
- GETATTR_Sub_multi_signature(interp, parrot_sub, p6sub);
- code = (Rakudo_Code *)PMC_data(p6sub);
- $1 = code->rw ? $2 : Rakudo_cont_scalar_with_value_no_descriptor(interp,
- Rakudo_cont_decontainerize(interp, $2));
+inline op perl6_decontainerize_return_value(out PMC, invar PMC, invar PMC) :base_core {
+ if ($3->vtable->base_type == smo_id && Rakudo_cont_is_rw_scalar(interp, $3)) {
+ Rakudo_Code *code = (Rakudo_Code *)PMC_data($2);
+ $1 = code->rw ? $3 : Rakudo_cont_scalar_with_value_no_descriptor(interp,
+ Rakudo_cont_decontainerize(interp, $3));
}
else {
- $1 = $2;
+ $1 = $3;
}
}

0 comments on commit fe419d2

Please sign in to comment.