+OP *
+Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
+ const int opnum)
+{
+ OP * const argop = newSVOP(OP_COREARGS,0,coreargssv);
+ OP *o;
+
+ PERL_ARGS_ASSERT_CORESUB_OP;
+
+ switch(opnum) {
+ case 0:
+ return op_append_elem(OP_LINESEQ,
+ argop,
+ newSLICEOP(0,
+ newSVOP(OP_CONST, 0, newSViv(-code % 3)),
+ newOP(OP_CALLER,0)
+ )
+ );
+ case OP_SELECT: /* which represents OP_SSELECT as well */
+ if (code)
+ return newCONDOP(
+ 0,
+ newBINOP(OP_GT, 0,
+ newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
+ newSVOP(OP_CONST, 0, newSVuv(1))
+ ),
+ coresub_op(newSVuv((UV)OP_SSELECT), 0,
+ OP_SSELECT),
+ coresub_op(coreargssv, 0, OP_SELECT)
+ );
+ /* FALL THROUGH */
+ default:
+ switch (PL_opargs[opnum] & OA_CLASS_MASK) {
+ case OA_BASEOP:
+ return op_append_elem(
+ OP_LINESEQ, argop,
+ newOP(opnum,
+ opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
+ );
+ case OA_BASEOP_OR_UNOP:
+ o = newUNOP(opnum,0,argop);
+ if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
+ else {
+ onearg:
+ if (is_handle_constructor(o, 1))
+ argop->op_private |= OPpCOREARGS_DEREF1;
+ }
+ return o;
+ default:
+ o = convert(opnum,0,argop);
+ if (is_handle_constructor(o, 2))
+ argop->op_private |= OPpCOREARGS_DEREF2;
+ if (scalar_mod_type(NULL, opnum))
+ argop->op_private |= OPpCOREARGS_SCALARMOD;
+ if (opnum == OP_SUBSTR) {
+ o->op_private |= OPpMAYBE_LVSUB;
+ return o;
+ }
+ else goto onearg;
+ }
+ }
+}
+