#include <xs/Sub.h>
#include <xs/Stash.h>
#include <xs/Object.h>
#include <panda/string.h>
namespace
xs {
Sub Sub::create (panda::string_view sub_code) {
auto
code = panda::string(
"sub { "
) + sub_code +
" }"
;
return
eval(code);
}
Sub Sub::create (XSUBADDR_t xsfunc) {
return
newXS(
nullptr
, xsfunc,
"<C++>"
);
}
Stash Sub::stash ()
const
{
return
CvSTASH((CV*)sv); }
Glob Sub::glob ()
const
{
return
CvGV((CV*)sv); }
void
Sub::_throw_super ()
const
{
throw
std::invalid_argument(panda::string(
"can't locate super method '"
) + name() +
"' via package '"
+ stash().name() +
"'"
);
}
size_t
Sub::_call (CV* cv, I32 flags,
const
CallArgs& args, SV** ret,
size_t
maxret, AV** avr) {
dTHX; dSP; ENTER; SAVETMPS;
PUSHMARK(SP);
if
(args.self) XPUSHs(args.self);
if
(args.scalars)
for
(
size_t
i = 0; i < args.items; ++i) XPUSHs(args.scalars[i] ? args.scalars[i].get() : &PL_sv_undef);
else
for
(
size_t
i = 0; i < args.items; ++i) XPUSHs(args.list[i] ? args.list[i] : &PL_sv_undef);
PUTBACK;
if
(!maxret && !avr) flags |= G_DISCARD;
size_t
count = call_sv((SV*)cv, flags|G_EVAL);
SPAGAIN;
auto
errsv = GvSV(PL_errgv);
if
(SvTRUE(errsv)) {
while
(count > 0) { (
void
)POPs; --count; }
PUTBACK; FREETMPS; LEAVE;
auto
exc = Sv::noinc(errsv);
GvSV(PL_errgv) = newSVpvs(
""
);
throw
PerlRuntimeException(exc);
}
auto
nret = count > maxret ? maxret : count;
if
(!avr) {
while
(count > maxret) { (
void
)POPs; --count; }
while
(count > 0) ret[--count] = SvREFCNT_inc_NN(POPs);
}
else
if
(count) {
nret = count;
AV* av = *avr = newAV();
av_extend(av, count-1);
AvFILLp(av) = count-1;
SV** svlist = AvARRAY(av);
while
(count--) svlist[count] = SvREFCNT_inc_NN(POPs);
}
else
*avr = NULL;
PUTBACK; FREETMPS; LEAVE;
return
nret;
}
Sub Sub::clone_anon_xsub (
const
Sub& proto) {
dTHX;
CV* cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
CvCLONED_on(cv);
CvFILE(cv) = CvFILE(proto);
CvGV_set(cv,CvGV(proto));
CvSTASH_set(cv, CvSTASH(proto));
CvISXSUB_on(cv);
CvXSUB(cv) = CvXSUB(proto);
#if PERL_VERSION >= 22
#ifndef PERL_IMPLICIT_CONTEXT
CvHSCXT(cv) = &PL_stack_sp;
#else
PoisonPADLIST(cv);
#endif
#endif
CvANON_on(cv);
return
Sub::noinc(cv);
}
static
inline
OP* want_get_op_assign (OP* entersub) {
#ifndef op_parent
auto
cx = caller_cx(0, NULL);
auto
cv = cx->blk_sub.cv;
OP* path[30];
size_t
path_max =
sizeof
(path) /
sizeof
(path[0]);
size_t
cur = 0;
for
(
size_t
i = 0; i < path_max; ++i) path[i] =
nullptr
;
auto
op = CvSTART(cv);
while
(1) {
if
(op == entersub)
break
;
if
(op->op_flags & OPf_KIDS) {
if
(cur >= path_max)
return
nullptr
;
path[cur++] = op;
op = cUNOPx(op)->op_first;
continue
;
}
while
(!(op = OpSIBLING(op))) {
if
(cur == 0)
return
nullptr
;
op = path[--cur];
}
}
if
(op != entersub)
return
nullptr
;
while
(cur--) {
OP* op = path[cur];
#else
for
(OP* op = op_parent(entersub); op; op = op_parent(op)) {
#endif
switch
(op->op_type) {
case
OP_AASSIGN:
return
op;
case
OP_SASSIGN:
case
OP_ANONHASH:
case
OP_ANONLIST:
case
OP_ENTERSUB:
return
nullptr
;
}
}
return
nullptr
;
}
static
inline
OP* want_unwrap (OP* op) {
if
(op->op_type == OP_LIST)
return
cUNOPx(op)->op_first;
if
(op->op_type == OP_NULL) {
if
(op->op_targ == OP_LIST || (PL_opargs[op->op_targ] & OA_CLASS_MASK) & (OA_UNOP|OA_BINOP|OA_LISTOP)) {
return
cUNOPx(op)->op_first;
}
}
return
nullptr
;
}
static
double
want_count_slice (OP* op_slice);
static
inline
double
want_count_list (OP* op) {
double
count = 0;
OP* unwrapped;
for
(; op; op = OpSIBLING(op)) {
if
((unwrapped = want_unwrap(op))) {
count += want_count_list(unwrapped);
continue
;
}
switch
(op->op_type) {
case
OP_CONST:
case
OP_PADSV:
case
OP_GVSV:
case
OP_UNDEF:
++count;
break
;
case
OP_PADAV:
case
OP_PADHV:
case
OP_ENTERSUB:
return
std::numeric_limits<
double
>::infinity();
case
OP_ASLICE:
case
OP_HSLICE:
count += want_count_slice(op);
break
;
case
OP_AELEM:
case
OP_AELEMFAST:
case
OP_AELEMFAST_LEX:
case
OP_HELEM:
case
OP_MULTIDEREF:
++count;
break
;
case
OP_PADRANGE:
case
OP_PUSHMARK:
case
OP_NULL:
break
;
default
:
return
std::numeric_limits<
double
>::infinity();
}
}
return
count;
}
static
double
want_count_slice (OP* op_slice) {
auto
op = cLISTOPx(op_slice)->op_first;
op = OpSIBLING(op);
assert
(op);
auto
inner = want_unwrap(op);
if
(inner)
return
want_count_list(inner);
switch
(op->op_type) {
case
OP_RV2AV: {
auto
opf = cUNOPx(op)->op_first;
if
(opf->op_type == OP_CONST && SvTYPE(cSVOPx_sv(opf)) == SVt_PVAV) {
return
AvFILLp((AV*)cSVOPx_sv(opf)) + 1;
}
return
std::numeric_limits<
double
>::infinity();
}
}
return
std::numeric_limits<
double
>::infinity();
}
int
Sub::want_count () {
auto
type = want();
if
(type == Want::Void)
return
0;
else
if
(type == Want::Scalar)
return
1;
auto
entersub = PL_op;
if
(entersub->op_type != OP_ENTERSUB)
throw
"want_count() must be called from XS sub"
;
OP* op_assign = want_get_op_assign(entersub);
if
(!op_assign)
return
-1;
OP* lhs_root = cBINOPx(op_assign)->op_last;
auto
ret = want_count_list(lhs_root);
return
ret == std::numeric_limits<
double
>::infinity() ? -1 : (
int
)ret;
}
}