Skip to content

Commit

Permalink
Merge branch 'nqp-mbc'
Browse files Browse the repository at this point in the history
  • Loading branch information
@niner
niner committed Nov 3, 2018
2 parents b2a976c + 656a804 commit 09cceb9
Showing 1 changed file with 78 additions and 112 deletions.
190 changes: 78 additions & 112 deletions src/vm/moar/Perl6/Ops.nqp
View file
Expand Up @@ -81,67 +81,59 @@ sub register_op_desugar($name, $desugar, :$inlinable = 1) is export {
# Perl 6 opcode specific mappings.
my $ops := nqp::getcomp('QAST').operations;
$ops.add_hll_op('perl6', 'p6store', -> $qastcomp, $op {
my @ops;
my $cont_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
my $value_res := $qastcomp.as_mast($op[1], :want($MVM_reg_obj));
push_ilist(@ops, $cont_res);
push_ilist(@ops, $value_res);

my $iscont_reg := $*REGALLOC.fresh_i();
my $decont_reg := $*REGALLOC.fresh_o();
my $no_cont_lbl := MAST::Label.new();
my $done_lbl := MAST::Label.new();
nqp::push(@ops, MAST::Op.new( :op('iscont'), $iscont_reg, $cont_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('unless_i'), $iscont_reg, $no_cont_lbl ));
MAST::Op.new( :op('iscont'), $iscont_reg, $cont_res.result_reg );
MAST::Op.new( :op('unless_i'), $iscont_reg, $no_cont_lbl );
$*REGALLOC.release_register($iscont_reg, $MVM_reg_int64);
nqp::push(@ops, MAST::Op.new( :op('decont'), $decont_reg, $value_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('assign'), $cont_res.result_reg, $decont_reg ));
MAST::Op.new( :op('decont'), $decont_reg, $value_res.result_reg );
MAST::Op.new( :op('assign'), $cont_res.result_reg, $decont_reg );
$*REGALLOC.release_register($decont_reg, $MVM_reg_obj);
nqp::push(@ops, MAST::Op.new( :op('goto'), $done_lbl ));
MAST::Op.new( :op('goto'), $done_lbl );

my $meth_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, $no_cont_lbl);
nqp::push(@ops, MAST::Op.new( :op('findmeth'), $meth_reg, $cont_res.result_reg,
MAST::SVal.new( :value('STORE') ) ));
nqp::push(@ops, MAST::Call.new(
$*MAST_FRAME.add-label($no_cont_lbl);
MAST::Op.new( :op('findmeth'), $meth_reg, $cont_res.result_reg,
MAST::SVal.new( :value('STORE') ) );
MAST::Call.new(
:target($meth_reg),
:flags($Arg::obj, $Arg::obj),
$cont_res.result_reg, $value_res.result_reg
));
nqp::push(@ops, $done_lbl);
);
$*MAST_FRAME.add-label($done_lbl);
$*REGALLOC.release_register($meth_reg, $MVM_reg_obj);

MAST::InstructionList.new(@ops, $cont_res.result_reg, $MVM_reg_obj)
MAST::InstructionList.new($cont_res.result_reg, $MVM_reg_obj)
});
$ops.add_hll_op('perl6', 'p6definite', -> $qastcomp, $op {
my @ops;
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
push_ilist(@ops, $value_res);
my $tmp_reg := $*REGALLOC.fresh_i();
my $res_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, MAST::Op.new( :op('decont'), $res_reg, $value_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('isconcrete'), $tmp_reg, $res_reg ));
nqp::push(@ops, MAST::Op.new( :op('hllbool'), $res_reg, $tmp_reg ));
MAST::Op.new( :op('decont'), $res_reg, $value_res.result_reg );
MAST::Op.new( :op('isconcrete'), $tmp_reg, $res_reg );
MAST::Op.new( :op('hllbool'), $res_reg, $tmp_reg );
$*REGALLOC.release_register($value_res.result_reg, $MVM_reg_obj);
$*REGALLOC.release_register($tmp_reg, $MVM_reg_int64);
MAST::InstructionList.new(@ops, $res_reg, $MVM_reg_obj)
MAST::InstructionList.new($res_reg, $MVM_reg_obj)
});
$ops.add_hll_moarop_mapping('perl6', 'p6capturelex', 'p6capturelex');
$ops.add_hll_op('perl6', 'p6bindassert', -> $qastcomp, $op {
# Compile the bind value and the type.
my @ops;
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
my $type_res := $qastcomp.as_mast($op[1], :want($MVM_reg_obj));
push_ilist(@ops, $value_res);
push_ilist(@ops, $type_res);

# Emit a type check.
my $tcr_reg := $*REGALLOC.fresh_i();
my $dc_reg := $*REGALLOC.fresh_o();
my $lbl_done := MAST::Label.new();
nqp::push(@ops, MAST::Op.new( :op('decont'), $dc_reg, $value_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('istype'), $tcr_reg, $dc_reg, $type_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('if_i'), $tcr_reg, $lbl_done ));
MAST::Op.new( :op('decont'), $dc_reg, $value_res.result_reg );
MAST::Op.new( :op('istype'), $tcr_reg, $dc_reg, $type_res.result_reg );
MAST::Op.new( :op('if_i'), $tcr_reg, $lbl_done );
$*REGALLOC.release_register($dc_reg, $MVM_reg_obj);
$*REGALLOC.release_register($tcr_reg, $MVM_reg_int64);

Expand All @@ -158,99 +150,89 @@ $ops.add_hll_op('perl6', 'p6bindassert', -> $qastcomp, $op {
}
}
my $err_rep := $qastcomp.as_mast(QAST::WVal.new( :value(nqp::getcodeobj(&bind_error)) ));
push_ilist(@ops, $err_rep);
nqp::push(@ops, MAST::Call.new(
MAST::Call.new(
:target($err_rep.result_reg),
:flags($Arg::obj, $Arg::obj),
$value_res.result_reg, $type_res.result_reg
));
nqp::push(@ops, $lbl_done);
);
$*MAST_FRAME.add-label($lbl_done);
$*REGALLOC.release_register($err_rep.result_reg, $MVM_reg_obj);

MAST::InstructionList.new(@ops, $value_res.result_reg, $MVM_reg_obj)
MAST::InstructionList.new($value_res.result_reg, $MVM_reg_obj)
});
$ops.add_hll_moarop_mapping('perl6', 'p6stateinit', 'p6stateinit');
$ops.add_hll_moarop_mapping('perl6', 'p6setpre', 'p6setpre');
$ops.add_hll_moarop_mapping('perl6', 'p6clearpre', 'p6clearpre');
$ops.add_hll_moarop_mapping('perl6', 'p6setfirstflag', 'p6setfirstflag');
$ops.add_hll_moarop_mapping('perl6', 'p6takefirstflag', 'p6takefirstflag');
$ops.add_hll_op('perl6', 'p6return', :!inlinable, -> $qastcomp, $op {
my @ops;
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
push_ilist(@ops, $value_res);
my $ex_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, MAST::Op.new( :op('exception'), $ex_reg ));
nqp::push(@ops, MAST::Op.new( :op('exreturnafterunwind'), $ex_reg ));
MAST::Op.new( :op('exception'), $ex_reg );
MAST::Op.new( :op('exreturnafterunwind'), $ex_reg );
$*REGALLOC.release_register($ex_reg, $MVM_reg_obj);
nqp::push(@ops, MAST::Op.new( :op('return_o'), $value_res.result_reg ));
MAST::InstructionList.new(@ops, $value_res.result_reg, $MVM_reg_obj)
MAST::Op.new( :op('return_o'), $value_res.result_reg );
MAST::InstructionList.new($value_res.result_reg, $MVM_reg_obj)
});
$ops.add_hll_moarop_mapping('perl6', 'p6getouterctx', 'p6getouterctx', :decont(0));
$ops.add_hll_moarop_mapping('perl6', 'p6captureouters', 'p6captureouters', 0);
$ops.add_hll_moarop_mapping('nqp', 'p6captureouters2', 'p6captureouters', 0);
$ops.add_hll_op('perl6', 'p6argvmarray', -> $qastcomp, $op {
my @ops;
my $res_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, MAST::Op.new( :op('param_sp'), $res_reg,
MAST::IVal.new( :value(0), :size(16) )));
MAST::Op.new( :op('param_sp'), $res_reg,
MAST::IVal.new( :value(0), :size(16) ));
my $i_reg := $*REGALLOC.fresh_i();
my $n_reg := $*REGALLOC.fresh_i();
my $cmp_reg := $*REGALLOC.fresh_i();
my $tmp_reg := $*REGALLOC.fresh_o();
my $lbl_next := MAST::Label.new();
my $lbl_done := MAST::Label.new();
nqp::push(@ops, MAST::Op.new( :op('elems'), $n_reg, $res_reg ));
nqp::push(@ops, MAST::Op.new( :op('const_i64'), $i_reg, MAST::IVal.new( :value(0) ) ));
nqp::push(@ops, $lbl_next);
nqp::push(@ops, MAST::Op.new( :op('lt_i'), $cmp_reg, $i_reg, $n_reg ));
nqp::push(@ops, MAST::Op.new( :op('unless_i'), $cmp_reg, $lbl_done ));
nqp::push(@ops, MAST::Op.new( :op('atpos_o'), $tmp_reg, $res_reg, $i_reg ));
nqp::push(@ops, MAST::Op.new( :op('hllize'), $tmp_reg, $tmp_reg ));
nqp::push(@ops, MAST::Op.new( :op('bindpos_o'), $res_reg, $i_reg, $tmp_reg ));
nqp::push(@ops, MAST::Op.new( :op('const_i64'), $cmp_reg, MAST::IVal.new( :value(1) ) ));
nqp::push(@ops, MAST::Op.new( :op('add_i'), $i_reg, $i_reg, $cmp_reg ));
nqp::push(@ops, MAST::Op.new( :op('goto'), $lbl_next ));
nqp::push(@ops, $lbl_done);
MAST::Op.new( :op('elems'), $n_reg, $res_reg );
MAST::Op.new( :op('const_i64'), $i_reg, MAST::IVal.new( :value(0) ) );
$*MAST_FRAME.add-label($lbl_next);
MAST::Op.new( :op('lt_i'), $cmp_reg, $i_reg, $n_reg );
MAST::Op.new( :op('unless_i'), $cmp_reg, $lbl_done );
MAST::Op.new( :op('atpos_o'), $tmp_reg, $res_reg, $i_reg );
MAST::Op.new( :op('hllize'), $tmp_reg, $tmp_reg );
MAST::Op.new( :op('bindpos_o'), $res_reg, $i_reg, $tmp_reg );
MAST::Op.new( :op('const_i64'), $cmp_reg, MAST::IVal.new( :value(1) ) );
MAST::Op.new( :op('add_i'), $i_reg, $i_reg, $cmp_reg );
MAST::Op.new( :op('goto'), $lbl_next );
$*MAST_FRAME.add-label($lbl_done);
$*REGALLOC.release_register($i_reg, $MVM_reg_int64);
$*REGALLOC.release_register($n_reg, $MVM_reg_int64);
$*REGALLOC.release_register($cmp_reg, $MVM_reg_int64);
$*REGALLOC.release_register($tmp_reg, $MVM_reg_obj);
MAST::InstructionList.new(@ops, $res_reg, $MVM_reg_obj)
MAST::InstructionList.new($res_reg, $MVM_reg_obj)
});
$ops.add_hll_op('perl6', 'p6bindattrinvres', -> $qastcomp, $op {
my @ops;

my $inv_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
push_ilist(@ops, $inv_res);

my $ch_res := $qastcomp.as_mast(
nqp::istype($op[1], QAST::WVal) && !nqp::isconcrete($op[1].value)
?? $op[1]
!! QAST::Op.new( :op('decont'), $op[1] ),
:want($MVM_reg_obj));
push_ilist(@ops, $ch_res);

my $val_res := $qastcomp.as_mast($op[3], :want($MVM_reg_obj));
push_ilist(@ops, $val_res);

my $name := $op[2];
$name := $name[2] if nqp::istype($name, QAST::Want) && $name[1] eq 'Ss';
if nqp::istype($name, QAST::SVal) {
nqp::push(@ops, MAST::Op.new( :op('bindattr_o'), $inv_res.result_reg,
MAST::Op.new( :op('bindattr_o'), $inv_res.result_reg,
$ch_res.result_reg, MAST::SVal.new( :value($name.value) ), $val_res.result_reg,
MAST::IVal.new( :value(-1) )));
MAST::IVal.new( :value(-1) ));
}
else {
my $nam_res := $qastcomp.as_mast($name, :want($MVM_reg_str));
push_ilist(@ops, $nam_res);
nqp::push(@ops, MAST::Op.new( :op('bindattrs_o'), $inv_res.result_reg,
$ch_res.result_reg, $nam_res.result_reg, $val_res.result_reg));
MAST::Op.new( :op('bindattrs_o'), $inv_res.result_reg,
$ch_res.result_reg, $nam_res.result_reg, $val_res.result_reg);
$*REGALLOC.release_register($nam_res.result_reg, $MVM_reg_str);
}

$*REGALLOC.release_register($ch_res.result_reg, $MVM_reg_obj);
$*REGALLOC.release_register($val_res.result_reg, $MVM_reg_obj);
MAST::InstructionList.new(@ops, $inv_res.result_reg, $MVM_reg_obj)
MAST::InstructionList.new($inv_res.result_reg, $MVM_reg_obj)
});
$ops.add_hll_moarop_mapping('perl6', 'p6finddispatcher', 'p6finddispatcher');
$ops.add_hll_moarop_mapping('perl6', 'p6argsfordispatcher', 'p6argsfordispatcher');
Expand All @@ -268,32 +250,30 @@ $ops.add_hll_op('perl6', 'p6sink', -> $qastcomp, $op {
my $sinkee_res := $qastcomp.as_mast($op[0]);
if $sinkee_res.result_kind == $MVM_reg_obj {
# Put computation of sinkee first.
my @ops;
push_ilist(@ops, $sinkee_res);

# Check it's concrete try to find the sink method.
my $sinkee_reg := $sinkee_res.result_reg;
my $itmp := $*REGALLOC.fresh_i();
my $meth := $*REGALLOC.fresh_o();
my $done_lbl := MAST::Label.new();
nqp::push(@ops, MAST::Op.new( :op('isconcrete'), $itmp, $sinkee_reg ));
nqp::push(@ops, MAST::Op.new( :op('unless_i'), $itmp, $done_lbl ));
nqp::push(@ops, MAST::Op.new( :op('tryfindmeth'), $meth, $sinkee_reg,
MAST::SVal.new( :value('sink') )));
nqp::push(@ops, MAST::Op.new( :op('isnull'), $itmp, $meth ));
nqp::push(@ops, MAST::Op.new( :op('if_i'), $itmp, $done_lbl ));
MAST::Op.new( :op('isconcrete'), $itmp, $sinkee_reg );
MAST::Op.new( :op('unless_i'), $itmp, $done_lbl );
MAST::Op.new( :op('tryfindmeth'), $meth, $sinkee_reg,
MAST::SVal.new( :value('sink') ));
MAST::Op.new( :op('isnull'), $itmp, $meth );
MAST::Op.new( :op('if_i'), $itmp, $done_lbl );
$*REGALLOC.release_register($itmp, $MVM_reg_int64);

# Emit sink method call.
nqp::push(@ops, MAST::Call.new(
MAST::Call.new(
:target($meth), :flags([$Arg::obj]), $sinkee_reg
));
);
$*REGALLOC.release_register($meth, $MVM_reg_obj);

# Add end label, and we're done.
nqp::push(@ops, $done_lbl);
$*MAST_FRAME.add-label($done_lbl);
$*REGALLOC.release_register($sinkee_res.result_reg, $MVM_reg_obj);
MAST::InstructionList.new(@ops, MAST::VOID, $MVM_reg_void);
MAST::InstructionList.new(MAST::VOID, $MVM_reg_void);
}
else {
$sinkee_res
Expand Down Expand Up @@ -334,51 +314,45 @@ $ops.add_hll_op('perl6', 'defor', -> $qastcomp, $op {
# Boxing and unboxing configuration.
sub boxer($kind, $box_op, $type_op) {
-> $qastcomp, $reg {
my @ops;
my $res_reg := $*REGALLOC.fresh_register($MVM_reg_obj);
nqp::push(@ops, MAST::Op.new( :op($type_op), $res_reg ));
nqp::push(@ops, MAST::Op.new( :op($box_op), $res_reg, $reg, $res_reg ));
MAST::Op.new( :op($type_op), $res_reg );
MAST::Op.new( :op($box_op), $res_reg, $reg, $res_reg );
$*REGALLOC.release_register($reg, $kind);
MAST::InstructionList.new(@ops, $res_reg, $MVM_reg_obj)
MAST::InstructionList.new($res_reg, $MVM_reg_obj)
}
}
$ops.add_hll_box('perl6', $MVM_reg_int64, boxer($MVM_reg_int64, 'box_i', 'hllboxtype_i'));
$ops.add_hll_box('perl6', $MVM_reg_num64, boxer($MVM_reg_num64, 'box_n', 'hllboxtype_n'));
$ops.add_hll_box('perl6', $MVM_reg_str, boxer($MVM_reg_str, 'box_s', 'hllboxtype_s'));
$ops.add_hll_box('perl6', $MVM_reg_uint64, boxer($MVM_reg_uint64, 'box_u', 'hllboxtype_i'));
QAST::MASTOperations.add_hll_unbox('perl6', $MVM_reg_int64, -> $qastcomp, $reg {
my $il := nqp::list();
my $res_reg := $*REGALLOC.fresh_register($MVM_reg_int64);
nqp::push($il, MAST::Op.new( :op('decont_i'), $res_reg, $reg ));
MAST::Op.new( :op('decont_i'), $res_reg, $reg );
$*REGALLOC.release_register($reg, $MVM_reg_obj);
MAST::InstructionList.new($il, $res_reg, $MVM_reg_int64)
MAST::InstructionList.new($res_reg, $MVM_reg_int64)
});
QAST::MASTOperations.add_hll_unbox('perl6', $MVM_reg_num64, -> $qastcomp, $reg {
my $il := nqp::list();
my $res_reg := $*REGALLOC.fresh_register($MVM_reg_num64);
nqp::push($il, MAST::Op.new( :op('decont_n'), $res_reg, $reg ));
MAST::Op.new( :op('decont_n'), $res_reg, $reg );
$*REGALLOC.release_register($reg, $MVM_reg_obj);
MAST::InstructionList.new($il, $res_reg, $MVM_reg_num64)
MAST::InstructionList.new($res_reg, $MVM_reg_num64)
});
QAST::MASTOperations.add_hll_unbox('perl6', $MVM_reg_str, -> $qastcomp, $reg {
my $il := nqp::list();
my $res_reg := $*REGALLOC.fresh_register($MVM_reg_str);
nqp::push($il, MAST::Op.new( :op('decont_s'), $res_reg, $reg ));
MAST::Op.new( :op('decont_s'), $res_reg, $reg );
$*REGALLOC.release_register($reg, $MVM_reg_obj);
MAST::InstructionList.new($il, $res_reg, $MVM_reg_str)
MAST::InstructionList.new($res_reg, $MVM_reg_str)
});
QAST::MASTOperations.add_hll_unbox('perl6', $MVM_reg_uint64, -> $qastcomp, $reg {
my $il := nqp::list();
my $res_reg := $*REGALLOC.fresh_register($MVM_reg_uint64);
nqp::push($il, MAST::Op.new( :op('decont_u'), $res_reg, $reg ));
MAST::Op.new( :op('decont_u'), $res_reg, $reg );
$*REGALLOC.release_register($reg, $MVM_reg_obj);
MAST::InstructionList.new($il, $res_reg, $MVM_reg_uint64)
MAST::InstructionList.new($res_reg, $MVM_reg_uint64)
});

# Signature binding related bits.
our $Binder;
$ops.add_hll_op('perl6', 'p6bindsig', :!inlinable, -> $qastcomp, $op {
my @ops;
my $isnull_result := $*REGALLOC.fresh_i();
my $dont_return_lbl := MAST::Label.new();
my $bind_res := $qastcomp.as_mast(
Expand All @@ -388,15 +362,14 @@ $ops.add_hll_op('perl6', 'p6bindsig', :!inlinable, -> $qastcomp, $op {
QAST::Op.new( :op('savecapture') ),
), :want($MVM_reg_obj)
);
push_ilist(@ops, $bind_res);
nqp::push(@ops, MAST::Op.new( :op('isnull'), $isnull_result, $bind_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('if_i'), $isnull_result, $dont_return_lbl ));
nqp::push(@ops, MAST::Op.new( :op('return_o'), $bind_res.result_reg ));
nqp::push(@ops, $dont_return_lbl);
MAST::Op.new( :op('isnull'), $isnull_result, $bind_res.result_reg );
MAST::Op.new( :op('if_i'), $isnull_result, $dont_return_lbl );
MAST::Op.new( :op('return_o'), $bind_res.result_reg );
$*MAST_FRAME.add-label($dont_return_lbl);

$*REGALLOC.release_register($bind_res.result_reg, $MVM_reg_obj);
$*REGALLOC.release_register($isnull_result, $MVM_reg_int64);
MAST::InstructionList.new(@ops, MAST::VOID, $MVM_reg_void);
MAST::InstructionList.new(MAST::VOID, $MVM_reg_void);
});
my $is_bindable := -> $qastcomp, $op {
$qastcomp.as_mast(QAST::Op.new(
Expand Down Expand Up @@ -444,29 +417,26 @@ $ops.add_hll_op('perl6', 'p6typecheckrv', -> $qastcomp, $op {
}
else {
# Use a spesh plugin to appropriately optimize return type checks.
my @ops;
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
my $type_res := $qastcomp.as_mast(QAST::WVal.new( :value($type) ), :want($MVM_reg_obj));
push_ilist(@ops, $value_res);
push_ilist(@ops, $type_res);
my $plugin_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, MAST::Call.new(
MAST::Call.new(
:target(MAST::SVal.new( :value('typecheckrv') )),
:flags([$Arg::obj, $Arg::obj]),
$value_res.result_reg,
$type_res.result_reg,
:result($plugin_reg),
:op(2)
));
nqp::push(@ops, MAST::Call.new(
);
MAST::Call.new(
:target($plugin_reg),
:flags([$Arg::obj]),
$value_res.result_reg,
:result($value_res.result_reg),
));
);
$*REGALLOC.release_register($plugin_reg, $MVM_reg_obj);
$*REGALLOC.release_register($type_res.result_reg, $MVM_reg_obj);
MAST::InstructionList.new(@ops, $value_res.result_reg, $MVM_reg_obj)
MAST::InstructionList.new($value_res.result_reg, $MVM_reg_obj)
}
}
else {
Expand Down Expand Up @@ -508,7 +478,3 @@ $ops.add_hll_op('perl6', 'p6configposbindfailover', :inlinable, -> $qastcomp, $o
QAST::WVal.new( :value($Binder) ),
$op[0], $op[1]), :want($MVM_reg_obj));
});

sub push_ilist(@dest, $src) {
nqp::splice(@dest, $src.instructions, +@dest, 0);
}

0 comments on commit 09cceb9

Please sign in to comment.