bool
Emitter::is_jittable(PerlJIT::AST::Term *ast)
{
switch (ast->get_type()) {
case pj_ttype_constant:
case pj_ttype_lexical:
case pj_ttype_variabledeclaration:
return true;
case pj_ttype_optree:
return false;
case pj_ttype_statement:
return is_jittable(static_cast<PerlJIT::AST::Statement *>(ast)->kids[0]);
case pj_ttype_statementsequence: {
std::vector<Term *> all = ast->get_kids();
unsigned int jittable = 0;
for (size_t i = 0, max = all.size(); i < max; ++i)
jittable += is_jittable(all[i]);
// TODO arbitrary threshold, it's probably better to look for
// long stretches of JITtable ops
return jittable * 2 >= all.size();
}
case pj_ttype_op: {
Op *op = static_cast<Op *>(ast);
bool known = Jittable_Ops.find(op->get_op_type()) != Jittable_Ops.end();
if (!known)
return false;
if (op->may_have_explicit_overload())
return true;
if (op->op_class() == pj_opc_binop &&
static_cast<Binop *>(op)->is_synthesized_assignment())
return is_jittable(op->kids[1]);
return !needs_excessive_magic(op);
}
default:
return false;
}
}
bool
Emitter::_jit_emit_return(Term *ast, pj_op_context context, Value *value, const PerlJIT::AST::Type *type)
{
// TODO OPs with OPpTARGET_MY flag are in scalar context even when
// they should be in void context, so we're emitting an useless push
// below
if (context == pj_context_caller) {
set_error("Caller-determined context not implemented");
return false;
}
if (context != pj_context_scalar)
return true;
Op *op = dynamic_cast<Op *>(ast);
Value *res;
switch (op->op_class()) {
case pj_opc_binop: {
// the assumption here is that the OPf_STACKED assignment
// has been handled by _jit_emit below, and here we only need
// to handle cases like '$x = $y += 7'
if (op->get_op_type() == pj_binop_sassign) {
if (type->equals(&SCALAR_T)) {
res = value;
} else {
// TODO suboptimal, but correct, need to ask for SCALAR
// in the call to _jit_emit() above
res = pa.emit_sv_newmortal();
}
} else {
if (!op->get_perl_op()->op_targ && type->equals(&SCALAR_T)) {
res = value;
} else {
if (!op->get_perl_op()->op_targ) {
set_error("Binary OP without target");
return false;
}
res = pa.emit_OP_targ();
}
}
}
case pj_opc_unop:
if (!op->get_perl_op()->op_targ) {
set_error("Unary OP without target");
return false;
}
res = pa.emit_OP_targ();
default:
res = pa.emit_sv_newmortal();
break;
}
if (res != value)
if (!_jit_assign_sv(res, value, type))
return false;
pa.alloc_sp();
pa.emit_SPAGAIN();
pa.emit_XPUSHs(res);
pa.emit_PUTBACK();
return true;
}