Lines Matching defs:o
169 #define CALL_PEEP(o) PL_peepp(aTHX_ o)
170 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
212 #define DIFF(o,p) \
213 (assert(((char *)(p) - (char *)(o)) % sizeof(I32**) == 0), \
214 ((size_t)((I32 **)(p) - (I32**)(o))))
273 #define link_freed_op(slab, o) S_link_freed_op(aTHX_ slab, o)
275 S_link_freed_op(pTHX_ OPSLAB *slab, OP *o) {
276 U16 sz = OpSLOT(o)->opslot_size;
306 o->op_next = slab->opslab_freed[index];
307 slab->opslab_freed[index] = o;
322 OP *o;
334 o = (OP*)PerlMemShared_calloc(1, sz);
369 o = head_slab->opslab_freed[base_index];
372 (void *)o, (void *)OpMySLAB(o), (void *)head_slab));
373 head_slab->opslab_freed[base_index] = o->op_next;
374 Zero(o, sz, char);
375 o->op_slabbed = 1;
384 o = &slot->opslot_op; \
385 o->op_slabbed = 1
396 o->op_type = OP_FREED;
398 (void *)o, (void *)slab2, (void *)head_slab));
399 link_freed_op(head_slab, o);
417 (void*)o, (void*)slab2, (void*)head_slab));
421 assert(!o->op_moresib);
422 assert(!o->op_sibparent);
424 return (void *)o;
488 OP * const o = (OP *)op;
494 o->op_ppaddr = S_pp_freed;
497 if (!o->op_slabbed) {
498 if (!o->op_static)
503 slab = OpSLAB(o);
505 assert(o->op_type != OP_FREED);
506 o->op_type = OP_FREED;
507 link_freed_op(slab, o);
509 (void*)o, (void *)OpMySLAB(o), (void*)slab));
611 Perl_op_refcnt_inc(pTHX_ OP *o)
613 if(o) {
614 OPSLAB *const slab = o->op_slabbed ? OpSLAB(o) : NULL;
617 ++o->op_targ;
620 ++o->op_targ;
623 return o;
628 Perl_op_refcnt_dec(pTHX_ OP *o)
631 OPSLAB *const slab = o->op_slabbed ? OpSLAB(o) : NULL;
637 result = --o->op_targ;
640 result = --o->op_targ;
649 #define CHECKOP(type,o) \
651 ? ( op_free((OP*)o), \
654 : PL_check[type](aTHX_ (OP*)o))
659 S_no_fh_allowed(pTHX_ OP *o)
664 OP_DESC(o)));
665 return o;
669 S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
673 return o;
677 S_too_many_arguments_pv(pTHX_ OP *o, const char *name, U32 flags)
682 return o;
686 S_bad_type_pv(pTHX_ I32 n, const char *t, const OP *o, const OP *kid)
691 (int)n, PL_op_desc[(o)->op_type], t, OP_DESC(kid)), 0);
705 Perl_no_bareword_allowed(pTHX_ OP *o)
712 o->op_private &= ~OPpCONST_STRICT; /* prevent warning twice about the same OP */
827 PADOFFSET off = 0, o = 1;
834 for (; o < PL_stashpadmax; ++o) {
835 if (PL_stashpad[o] == hv) return PL_stashpadix = o;
836 if (!PL_stashpad[o] || SvTYPE(PL_stashpad[o]) != SVt_PVHV)
837 found_slot = TRUE, off = o;
855 S_op_destroy(pTHX_ OP *o)
857 FreeOp(o);
873 OP *kid = o->op_first; o->op_first = NULL;
874 o->op_flags &= ~OPf_KIDS;
875 op_free(o);
881 Perl_op_free(pTHX_ OP *o)
884 OP *top_op = o;
885 OP *next_op = o;
890 if (!o || o->op_type == OP_FREED)
893 if (o->op_private & OPpREFCOUNTED) {
895 switch (o->op_type) {
905 refcnt = OpREFCNT_dec(o);
910 find_and_forget_pmops(o);
921 o = next_op;
930 assert(!(o->op_flags & OPf_KIDS) || cUNOPo->op_first);
932 if (!went_up && o->op_flags & OPf_KIDS) {
938 * (can't rely on o->op_* fields being valid after o has been
944 next_op = (o == top_op) ? NULL : o->op_sibparent;
945 went_up = cBOOL(!OpHAS_SIBLING(o)); /* parents are already visited */
951 assert(!o->op_slabbed || OpSLAB(o)->opslab_refcnt != ~(size_t)0);
954 if (!o || o->op_type == OP_FREED)
957 type = o->op_type;
972 if ( o->op_ppaddr == PL_ppaddr[type]
978 assert(!(o->op_private & ~PL_op_private_valid[type]));
986 CALL_OPFREEHOOK(o);
989 type = (OPCODE)o->op_targ;
991 if (o->op_slabbed)
992 Slab_to_rw(OpSLAB(o));
997 cop_free((COP*)o);
1000 op_clear(o);
1001 FreeOp(o);
1002 if (PL_op == o)
1012 void S_op_clear_gv(pTHX_ OP *o, PADOFFSET *ixp)
1014 void S_op_clear_gv(pTHX_ OP *o, SV**svp)
1018 GV *gv = (o->op_type == OP_GV || o->op_type == OP_GVSV
1019 || o->op_type == OP_MULTIDEREF)
1063 Perl_op_clear(pTHX_ OP *o)
1069 switch (o->op_type) {
1075 o->op_targ = 0;
1078 if (!(o->op_flags & OPf_REF) || !OP_IS_STAT(o->op_type))
1085 S_op_clear_gv(aTHX_ o, &(cPADOPx(o)->op_padix));
1087 S_op_clear_gv(aTHX_ o, &(cSVOPx(o)->op_sv));
1107 if (o->op_targ) {
1108 pad_swipe(o->op_targ, 1);
1109 o->op_targ = 0;
1124 if(o->op_targ) {
1125 pad_swipe(o->op_targ,1);
1126 o->op_targ = 0;
1135 if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
1140 if ( (o->op_type == OP_TRANS || o->op_type == OP_TRANSR)
1141 && (o->op_private & OPpTRANS_USE_SVOP))
1163 if ( (o->op_private & OPpSPLIT_ASSIGN) /* @array = split */
1164 && !(o->op_flags & OPf_STACKED)) /* @{expr} = split */
1166 if (o->op_private & OPpSPLIT_LEX)
1251 S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
1253 S_op_clear_gv(aTHX_ o, &((++items)->sv));
1262 S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
1264 S_op_clear_gv(aTHX_ o, &((++items)->sv));
1304 S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
1306 S_op_clear_gv(aTHX_ o, &((++items)->sv));
1350 if (o->op_targ > 0) {
1351 pad_free(o->op_targ);
1352 o->op_targ = 0;
1388 S_forget_pmop(pTHX_ PMOP *const o)
1390 HV * const pmstash = PmopSTASH(o);
1402 if (array[i] == o) {
1418 if (PL_curpm == o)
1424 S_find_and_forget_pmops(pTHX_ OP *o)
1426 OP* top_op = o;
1431 switch (o->op_type) {
1439 if (o->op_flags & OPf_KIDS) {
1440 o = cUNOPo->op_first;
1445 if (o == top_op)
1447 if (OpHAS_SIBLING(o)) {
1448 o = o->op_sibparent; /* process next sibling */
1451 o = o->op_sibparent; /*try parent's next sibling */
1467 Perl_op_null(pTHX_ OP *o)
1472 if (o->op_type == OP_NULL)
1474 op_clear(o);
1475 o->op_targ = o->op_type;
1476 OpTYPE_set(o, OP_NULL);
1663 Returns the parent OP of C<o>, if it has a parent. Returns C<NULL> otherwise.
1669 Perl_op_parent(OP *o)
1672 while (OpHAS_SIBLING(o))
1673 o = OpSIBLING(o);
1674 return o->op_sibparent;
1739 C<o> is the op tree, and C<context> must be C<G_SCALAR>, C<G_LIST>,
1747 Perl_op_contextualize(pTHX_ OP *o, I32 context)
1751 case G_SCALAR: return scalar(o);
1752 case G_LIST: return list(o);
1753 case G_VOID: return scalarvoid(o);
1771 Perl_op_linklist(pTHX_ OP *o)
1776 OP * top_op = o;
1783 if (!o->op_next) {
1784 if (o->op_flags & OPf_KIDS) {
1785 o = cUNOPo->op_first;
1788 o->op_next = o; /* leaf node; link to self initially */
1793 if (o == top_op)
1794 return o->op_next;
1796 /* o is now processed. Next, process any sibling subtrees */
1798 if (OpHAS_SIBLING(o)) {
1799 o = OpSIBLING(o);
1807 o = o->op_sibparent;
1808 assert(!o->op_next);
1809 prevp = &(o->op_next);
1810 kid = (o->op_flags & OPf_KIDS) ? cUNOPo->op_first : NULL;
1816 *prevp = o;
1822 S_scalarkids(pTHX_ OP *o)
1824 if (o && o->op_flags & OPf_KIDS) {
1829 return o;
1833 S_scalarboolean(pTHX_ OP *o)
1837 if ((o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST &&
1839 (o->op_type == OP_NOT && cUNOPo->op_first->op_type == OP_SASSIGN &&
1854 return scalar(o);
1858 S_op_varname_subscript(pTHX_ const OP *o, int subscript_type)
1860 assert(o);
1861 assert(o->op_type == OP_PADAV || o->op_type == OP_RV2AV ||
1862 o->op_type == OP_PADHV || o->op_type == OP_RV2HV);
1864 const char funny = o->op_type == OP_PADAV
1865 || o->op_type == OP_RV2AV ? '@' : '%';
1866 if (o->op_type == OP_RV2AV || o->op_type == OP_RV2HV) {
1874 varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, subscript_type);
1879 Perl_op_varname(pTHX_ const OP *o)
1883 return S_op_varname_subscript(aTHX_ o, 1);
1891 it is given by the C<SVOP_sv> of the C<OP_CONST> op given by C<o>.
1897 Perl_warn_elem_scalar_context(pTHX_ const OP *o, SV *name, bool is_hash, bool is_slice)
1907 if (o->op_type == OP_CONST) {
1954 /* apply scalar context to the o subtree */
1957 Perl_scalar(pTHX_ OP *o)
1959 OP * top_op = o;
1966 if (!o || (PL_parser && PL_parser->error_count)
1967 || (o->op_flags & OPf_WANT)
1968 || o->op_type == OP_RETURN)
1973 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
1975 switch (o->op_type) {
1981 if (o->op_private & OPpREPEAT_DOLIST) {
1986 o->op_private &=~ OPpREPEAT_DOLIST;
1999 if (o->op_flags & OPf_KIDS)
2073 warn_elem_scalar_context(kid, name, o->op_type == OP_KVHSLICE, false);
2082 if (o == top_op)
2084 if (OpHAS_SIBLING(o))
2085 next_kid = o->op_sibparent;
2087 o = o->op_sibparent; /*try parent's next sibling */
2088 switch (o->op_type) {
2100 o = next_kid;
2112 OP *o = arg;
2122 if (o->op_type == OP_NEXTSTATE
2123 || o->op_type == OP_DBSTATE
2124 || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
2125 || o->op_targ == OP_DBSTATE)))
2126 PL_curcop = (COP*)o; /* for warning below */
2129 want = o->op_flags & OPf_WANT;
2132 || o->op_type == OP_RETURN || o->op_type == OP_REQUIRE || o->op_type == OP_LEAVEWHEN)
2137 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
2139 switch (o->op_type) {
2141 if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
2145 if (o->op_flags & OPf_STACKED)
2147 if (o->op_type == OP_REPEAT)
2151 if ((o->op_flags & OPf_STACKED) &&
2152 !(o->op_private & OPpCONCAT_NESTED))
2156 if (o->op_private == 4)
2223 if ( (PL_opargs[o->op_type] & OA_TARGLEX)
2224 && (o->op_private & OPpTARGET_MY)
2231 useless = OP_DESC(o);
2245 if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
2247 useless = OP_DESC(o);
2251 if (!(o->op_private & OPpSPLIT_ASSIGN))
2252 useless = OP_DESC(o);
2277 if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
2278 (!OpHAS_SIBLING(o) || OpSIBLING(o)->op_type != OP_READLINE))
2285 no_bareword_allowed(o);
2317 op_null(o); /* don't execute or even remember it */
2321 OpTYPE_set(o, OP_PREINC); /* pre-increment is faster */
2325 OpTYPE_set(o, OP_PREDEC); /* pre-decrement is faster */
2329 OpTYPE_set(o, OP_I_PREINC); /* pre-increment is faster */
2333 OpTYPE_set(o, OP_I_PREDEC); /* pre-decrement is faster */
2341 if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)
2369 assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0);
2372 o->op_private |= OPpASSIGN_CV_TO_GV;
2380 inplace_aassign(o);
2389 if (o->op_type == OP_AND) {
2390 OpTYPE_set(o, OP_OR);
2392 OpTYPE_set(o, OP_AND);
2406 if (o->op_flags & OPf_STACKED)
2413 if (!(o->op_flags & OPf_KIDS))
2444 op_null(o); /* NULL the list */
2448 scalarkids(o);
2451 scalar(o);
2454 if (!(o->op_private & OPpTARGET_MY))
2455 useless = (o->op_private & OPpEMPTYAVHV_IS_HV) ?
2479 if (o == arg)
2481 if (OpHAS_SIBLING(o))
2482 next_kid = o->op_sibparent;
2484 o = o->op_sibparent; /*try parent's next sibling */
2486 o = next_kid;
2493 S_listkids(pTHX_ OP *o)
2495 if (o && o->op_flags & OPf_KIDS) {
2500 return o;
2504 /* apply list context to the o subtree */
2507 Perl_list(pTHX_ OP *o)
2509 OP * top_op = o;
2517 if (!o || (o->op_flags & OPf_WANT)
2519 || o->op_type == OP_RETURN)
2524 if ((o->op_private & OPpTARGET_MY)
2525 && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
2530 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
2532 switch (o->op_type) {
2534 if (o->op_private & OPpREPEAT_DOLIST
2535 && !(o->op_flags & OPf_STACKED))
2543 op_null(o); /* repeat */
2546 op_free(op_sibling_splice(o, cBINOPo->op_first, 1, NULL));
2559 if (!(o->op_flags & OPf_KIDS))
2562 if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
2564 gen_constant_list(o);
2573 op_null(o); /* NULL the list */
2575 if (o->op_flags & OPf_KIDS)
2625 if (o == top_op)
2627 if (OpHAS_SIBLING(o))
2628 next_kid = o->op_sibparent;
2630 o = o->op_sibparent; /*try parent's next sibling */
2631 switch (o->op_type) {
2645 o = next_kid;
2652 S_voidnonfinal(pTHX_ OP *o)
2654 if (o) {
2655 const OPCODE type = o->op_type;
2677 o->op_flags &= ~OPf_PARENS;
2679 o->op_flags |= OPf_PARENS;
2682 o = newOP(OP_STUB, 0);
2683 return o;
2687 S_modkids(pTHX_ OP *o, I32 type)
2689 if (o && o->op_flags & OPf_KIDS) {
2694 return o;
2873 /* apply lvalue reference (aliasing) context to the optree o.
2876 * o would be the list ($x,$y) and type would be OP_AASSIGN.
2882 S_lvref(pTHX_ OP *o, I32 type)
2885 OP * top_op = o;
2888 switch (o->op_type) {
2890 o = OpSIBLING(cUNOPo->op_first);
2898 o->op_flags |= OPf_STACKED;
2899 if (o->op_flags & OPf_PARENS) {
2900 if (o->op_private & OPpLVAL_INTRO) {
2906 OpTYPE_set(o, OP_LVAVREF);
2907 o->op_private &= OPpLVAL_INTRO|OPpPAD_STATE;
2908 o->op_flags |= OPf_MOD|OPf_REF;
2911 o->op_private |= OPpLVREF_AV;
2919 o->op_private = OPpLVREF_CV;
2921 o->op_flags |= OPf_STACKED;
2923 o->op_targ = kid->op_targ;
2927 o->op_flags &=~ OPf_KIDS;
2933 if (o->op_flags & OPf_PARENS) {
2939 o->op_private |= OPpLVREF_HV;
2944 o->op_flags |= OPf_STACKED;
2948 if (o->op_flags & OPf_PARENS) goto parenhash;
2949 o->op_private |= OPpLVREF_HV;
2952 PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
2956 PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
2957 if (o->op_flags & OPf_PARENS) goto slurpy;
2958 o->op_private |= OPpLVREF_AV;
2963 o->op_private |= OPpLVREF_ELEM;
2964 o->op_flags |= OPf_STACKED;
2969 OpTYPE_set(o, OP_LVREFSLICE);
2970 o->op_private &= OPpLVAL_INTRO;
2974 if (o->op_flags & OPf_SPECIAL) /* do BLOCK */
2976 else if (!(o->op_flags & OPf_KIDS))
2983 assert(o->op_targ == OP_LIST
2987 o = cLISTOPo->op_first;
2991 if (o->op_flags & OPf_PARENS)
2998 o->op_type == OP_NULL && o->op_flags & OPf_SPECIAL
3000 : OP_DESC(o),
3005 OpTYPE_set(o, OP_LVREF);
3006 o->op_private &=
3009 o->op_private |= OPpLVREF_ITER;
3013 if (o == top_op)
3015 if (OpHAS_SIBLING(o)) {
3016 o = o->op_sibparent;
3019 o = o->op_sibparent; /*try parent's next sibling */
3059 Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
3061 OP *top_op = o;
3063 if (!o || (PL_parser && PL_parser->error_count))
3064 return o;
3072 if ((o->op_private & OPpTARGET_MY)
3073 && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
3080 if ((o->op_flags & OPf_WANT) == OPf_WANT_VOID)
3085 switch (o->op_type) {
3093 if ((o->op_flags & OPf_PARENS))
3099 !(o->op_flags & OPf_STACKED)) {
3100 OpTYPE_set(o, OP_RV2CV); /* entersub => rv2cv */
3106 o->op_private |= OPpLVAL_INTRO;
3109 o->op_private |= OPpENTERSUB_INARGS;
3173 (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
3175 : OP_DESC(o)),
3198 if (!(o->op_flags & OPf_STACKED))
3204 if (o->op_flags & OPf_STACKED) {
3208 if (!(o->op_private & OPpREPEAT_DOLIST))
3240 if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
3244 o->op_flags |= OPf_MOD;
3249 if (scalar_mod_type(o, type))
3251 ref(cUNOPo->op_first, o->op_type);
3260 (o->op_type != OP_RV2AV && o->op_type != OP_RV2HV)
3261 || (o->op_flags & OPf_WANT) != OPf_WANT_SCALAR
3263 o->op_private |= OPpMAYBE_LVSUB;
3274 o->op_private |= OPpMAYBE_LVSUB;
3279 && (o->op_private & OPpAVHVSWITCH_MASK) + OP_EACH == OP_KEYS)
3280 o->op_private |= OPpMAYBE_LVSUB;
3286 o->op_private |= OPpMAYBE_LVSUB;
3291 ref(cUNOPo->op_first, o->op_type);
3313 if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
3317 o->op_flags |= OPf_MOD;
3320 if (scalar_mod_type(o, type))
3322 if ((o->op_flags & OPf_WANT) != OPf_WANT_SCALAR
3324 o->op_private |= OPpMAYBE_LVSUB;
3330 PNfARG(PAD_COMPNAME(o->op_targ)));
3331 if (!(o->op_private & OPpLVAL_INTRO)
3333 && PadnameIsSTATE(PAD_COMPNAME_SV(o->op_targ)) ))
3334 S_mark_padname_lvalue(aTHX_ PAD_COMPNAME_SV(o->op_targ));
3346 if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
3353 o->op_private |= OPpMAYBE_LVSUB;
3354 if (o->op_flags & OPf_KIDS && OpHAS_SIBLING(cBINOPo->op_first)) {
3367 : o->op_type);
3373 ref(cBINOPo->op_first, o->op_type);
3375 !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
3376 o->op_private |= OPpLVAL_DEFER;
3378 o->op_private |= OPpMAYBE_LVSUB;
3385 o->op_private |= OPpLVALUE;
3391 if (o->op_flags & OPf_KIDS)
3397 if (o->op_flags & OPf_SPECIAL) /* do BLOCK */
3399 else if (!(o->op_flags & OPf_KIDS))
3402 if (o->op_targ != OP_LIST) {
3489 if (o->op_type == OP_REFGEN)
3491 op_null(o);
3495 if ((o->op_private & OPpSPLIT_ASSIGN)) {
3516 if (LIKELY(o->op_flags & OPf_REF)) goto nomod;
3528 if (type == OP_REFGEN && OP_IS_STAT(o->op_type))
3532 o->op_flags |= OPf_MOD;
3535 o->op_flags |= o->op_type == OP_ENTERSUB ? 0 : OPf_SPECIAL|OPf_REF;
3539 o->op_private |= OPpLVAL_INTRO;
3540 o->op_flags &= ~OPf_SPECIAL;
3547 "Useless localization of %s", OP_DESC(o));
3551 && type != OP_LEAVESUBLV && o->op_type != OP_ENTERSUB)
3552 o->op_flags |= OPf_REF;
3556 if (o == top_op)
3558 if (OpHAS_SIBLING(o)) {
3559 next_kid = o->op_sibparent;
3571 o = parent;
3577 o = o->op_sibparent; /*try parent's next sibling */
3580 o = next_kid;
3588 S_scalar_mod_type(const OP *o, I32 type)
3593 if (o && o->op_type == OP_RV2GV)
3646 S_is_handle_constructor(const OP *o, I32 numargs)
3650 switch (o->op_type) {
3671 S_refkids(pTHX_ OP *o, I32 type)
3673 if (o && o->op_flags & OPf_KIDS) {
3678 return o;
3682 /* Apply reference (autovivification) context to the subtree at o.
3685 * o will be the head of 'expression' and type will be OP_RV2AV.
3686 * It marks the op o (or a suitable child) as autovivifying, e.g. by
3691 * Also calls scalar(o).
3695 Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
3697 OP * top_op = o;
3702 return o;
3705 switch (o->op_type) {
3708 !(o->op_flags & OPf_STACKED)) {
3709 OpTYPE_set(o, OP_RV2CV); /* entersub => rv2cv */
3713 o->op_flags |= OPf_SPECIAL;
3716 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
3719 o->op_flags |= OPf_MOD;
3725 o = OpSIBLING(cUNOPo->op_first);
3730 o->op_flags |= OPf_SPECIAL; /* don't create GV */
3734 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
3737 o->op_flags |= OPf_MOD;
3739 if (o->op_flags & OPf_KIDS) {
3740 type = o->op_type;
3741 o = cUNOPo->op_first;
3749 o->op_flags |= OPf_REF;
3753 o->op_flags |= OPf_SPECIAL; /* don't create GV */
3754 type = o->op_type;
3755 o = cUNOPo->op_first;
3761 o->op_flags |= OPf_REF;
3766 if (!(o->op_flags & OPf_KIDS) || type == OP_DEFINED)
3768 o = cBINOPo->op_first;
3774 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
3777 o->op_flags |= OPf_MOD;
3779 type = o->op_type;
3780 o = cBINOPo->op_first;
3789 if (!(o->op_flags & OPf_KIDS))
3791 o = cLISTOPo->op_last;
3799 if (o == top_op)
3801 if (OpHAS_SIBLING(o)) {
3802 o = o->op_sibparent;
3806 if (!OpHAS_SIBLING(o)
3807 && o->op_sibparent->op_type == OP_COND_EXPR)
3811 o = o->op_sibparent; /*try parent's next sibling */
3818 S_dup_attrlist(pTHX_ OP *o)
3828 if (o->op_type == OP_CONST)
3829 rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc_NN(cSVOPo->op_sv));
3831 assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
3833 for (o = cLISTOPo->op_first; o; o = OpSIBLING(o)) {
3834 if (o->op_type == OP_CONST)
3836 newSVOP(OP_CONST, o->op_flags,
3974 OP *o;
3981 o = *attrs;
3982 if (o->op_type == OP_CONST) {
3986 SV ** const tmpo = cSVOPx_svp(o);
3989 new_proto = o;
3992 } else if (o->op_type == OP_LIST) {
3994 assert(o->op_flags & OPf_KIDS);
3997 for (o = OpSIBLING(lasto); o; o = OpSIBLING(o)) {
3998 if (o->op_type == OP_CONST) {
4002 SV ** const tmpo = cSVOPx_svp(o);
4013 new_proto = o;
4016 o = lasto;
4020 lasto = o;
4068 S_cant_declare(pTHX_ OP *o)
4070 if (o->op_type == OP_NULL
4071 && (o->op_flags & (OPf_SPECIAL|OPf_KIDS)) == OPf_KIDS)
4072 o = cUNOPo->op_first;
4074 o->op_type == OP_NULL
4075 && o->op_flags & OPf_SPECIAL
4077 : OP_DESC(o),
4084 S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
4091 if (!o || (PL_parser && PL_parser->error_count))
4092 return o;
4094 type = o->op_type;
4096 if (OP_TYPE_IS_OR_WAS(o, OP_LIST)) {
4100 return o;
4102 return o;
4107 S_cant_declare(aTHX_ o);
4119 o->op_private |= OPpOUR_INTRO;
4120 return o;
4131 return o;
4138 S_cant_declare(aTHX_ o);
4139 return o;
4149 stash = PAD_COMPNAME_TYPE(o->op_targ);
4152 apply_attrs_my(stash, o, attrs, imopsp);
4154 o->op_flags |= OPf_MOD;
4155 o->op_private |= OPpLVAL_INTRO;
4157 o->op_private |= OPpPAD_STATE;
4158 return o;
4162 Perl_my_attrs(pTHX_ OP *o, OP *attrs)
4172 if (o->op_flags & OPf_PARENS)
4173 list(o);
4182 o = my_kid(o, attrs, &rops);
4184 if (maybe_scalar && o->op_type == OP_PADSV) {
4185 o = scalar(op_append_list(OP_LIST, rops, o));
4186 o->op_private |= OPpLVAL_INTRO;
4200 o = op_append_list(OP_LIST, o, rops);
4205 return o;
4209 Perl_sawparens(pTHX_ OP *o)
4212 if (o)
4213 o->op_flags |= OPf_PARENS;
4214 return o;
4220 OP *o;
4281 o = right;
4292 o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
4294 o = op_prepend_elem(rtype, scalar(left), right);
4297 return newUNOP(OP_NOT, 0, scalar(o));
4298 return o;
4306 Perl_invert(pTHX_ OP *o)
4308 if (!o)
4310 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
4486 Perl_op_scope(pTHX_ OP *o)
4488 if (o) {
4489 if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
4490 o = op_prepend_elem(OP_LINESEQ,
4491 newOP(OP_ENTER, (o->op_flags & OPf_WANT)), o);
4492 OpTYPE_set(o, OP_LEAVE);
4494 else if (o->op_type == OP_LINESEQ) {
4496 OpTYPE_set(o, OP_SCOPE);
4509 o = newLISTOP(OP_SCOPE, 0, o, NULL);
4511 return o;
4515 Perl_op_unscope(pTHX_ OP *o)
4517 if (o && o->op_type == OP_LINESEQ) {
4523 return o;
4573 OP *o;
4578 o = newSTATEOP(0, NULL, NULL);
4579 op_null(o);
4580 retval = op_append_elem(OP_LINESEQ, retval, o);
4588 o = pad_leavemy();
4590 if (o) {
4638 OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : o;
4639 OP * const last = o->op_flags & OPf_KIDS ? cLISTOPo->op_last : o;
4643 o = op_append_elem(OP_LINESEQ, o, newkid);
4646 retval = op_prepend_elem(OP_LINESEQ, o, retval);
4674 Perl_newPROG(pTHX_ OP *o)
4687 ? OPf_SPECIAL : 0), o);
4702 SAVEFREEOP(o);
4709 if (o->op_type == OP_STUB) {
4715 Historically (5.000) the guard above was !o. However, commit
4738 S_op_destroy(aTHX_ o);
4741 PL_main_root = op_scope(sawparens(scalarvoid(o)));
4769 Perl_localize(pTHX_ OP *o, I32 lex)
4773 if (o->op_flags & OPf_PARENS)
4777 list(o);
4821 o = my(o);
4823 o = op_lvalue(o, OP_NULL); /* a bit kludgey */
4826 return o;
4830 Perl_jmaybe(pTHX_ OP *o)
4834 if (o->op_type == OP_LIST) {
4838 o = op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, o2, o));
4847 return o;
4851 S_op_std_init(pTHX_ OP *o)
4853 I32 type = o->op_type;
4858 scalar(o);
4859 if (PL_opargs[type] & OA_TARGET && !o->op_targ)
4860 o->op_targ = pad_alloc(type, SVs_PADTMP);
4862 return o;
4866 S_op_integerize(pTHX_ OP *o)
4868 I32 type = o->op_type;
4875 o->op_ppaddr = PL_ppaddr[++(o->op_type)];
4882 return o;
4906 S_fold_constants(pTHX_ OP *const o)
4910 I32 type = o->op_type;
4971 if (o->op_private & OPpREPEAT_DOLIST) goto nope;
4982 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
5004 curop = LINKLIST(o);
5005 old_next = o->op_next;
5006 o->op_next = 0;
5035 if (o->op_targ && sv == PAD_SV(o->op_targ)) { /* grab pad temp? */
5036 pad_swipe(o->op_targ, FALSE);
5048 o->op_next = old_next;
5077 is_stringify = type == OP_STRINGIFY && !o->op_folded;
5078 op_free(o);
5091 return o;
5099 S_gen_constant_list(pTHX_ OP *o)
5114 list(o);
5118 curop = LINKLIST(o);
5119 old_next = o->op_next;
5120 o->op_next = 0;
5121 op_was_null = o->op_type == OP_NULL;
5123 o->op_type = OP_CUSTOM;
5126 o->op_type = OP_NULL;
5161 o->op_next = old_next;
5185 OpTYPE_set(o, OP_RV2AV);
5186 o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */
5187 o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
5188 o->op_opt = 0; /* needs to be revisited in rpeep() */
5193 op_sibling_splice(o, NULL, -1, newSVOP(OP_CONST, 0, (SV *)av));
5203 LINKLIST(o);
5204 list(o);
5216 static void walk_ops_find_labels(pTHX_ OP *o, HV *gotolabels)
5218 switch(o->op_type) {
5224 const char *label_pv = CopLABEL_len_flags((COP *)o, &label_len, &label_flags);
5236 if(!(o->op_flags & OPf_KIDS))
5246 static void walk_ops_forbid(pTHX_ OP *o, U32 flags, HV *permittedloops, HV *permittedgotos, const char *blockname)
5251 switch(o->op_type) {
5254 PL_curcop = (COP *)o;
5263 if(o->op_flags & OPf_STACKED)
5281 if(o->op_flags & OPf_SPECIAL) {
5288 if(o->op_flags & OPf_STACKED)
5324 croak("Can't \"%s\" out of %s", PL_op_name[o->op_type], blockname);
5330 if(!(o->op_flags & OPf_KIDS))
5381 Perl_forbid_outofblock_ops(pTHX_ OP *o, const char *blockname)
5394 walk_ops_find_labels(aTHX_ o, gotolabels);
5396 walk_ops_forbid(aTHX_ o, FORBID_LOOPEX_DEFAULT, looplabels, gotolabels, blockname);
5515 Converts C<o> into a list op if it is not one already, and then converts it
5527 Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
5534 if (!o || o->op_type != OP_LIST)
5535 o = force_list(o, FALSE);
5538 o->op_flags &= ~OPf_WANT;
5539 o->op_private &= ~OPpLVAL_INTRO;
5553 /* At this point o is a LISTOP, but OP_SPLIT is a PMOP; let
5557 OpTYPE_set(o, type);
5559 o->op_flags |= flags;
5561 o->op_folded = 1;
5563 o = CHECKOP(type, o);
5564 if (o->op_type != (unsigned)type)
5565 return o;
5567 return fold_constants(op_integerize(op_std_init(o)));
5590 /* promote o and any siblings to be a list if its not already; i.e.
5592 * o - A - B
5598 * pushmark - o - A - B
5604 S_force_list(pTHX_ OP *o, bool nullit)
5606 if (!o || o->op_type != OP_LIST) {
5608 if (o) {
5610 rest = OpSIBLING(o);
5611 OpLASTSIB_set(o, NULL);
5613 o = newLISTOP(OP_LIST, 0, o, NULL);
5615 op_sibling_splice(o, cLISTOPo->op_last, 0, rest);
5618 op_null(o);
5619 return o;
5625 Promotes o and any siblings to be an C<OP_LIST> if it is not already. If
5632 o = op_contextualize(op_force_list(o), G_LIST);
5638 Perl_op_force_list(pTHX_ OP *o)
5640 return force_list(o, TRUE);
5733 OP *o = newLISTOP(OP_LIST, 0, NULL, NULL);
5737 o = op_append_elem(OP_LIST, o, kid);
5741 return op_convert_list(type, flags, o);
5758 OP *o;
5770 NewOp(1101, o, 1, OP);
5771 OpTYPE_set(o, type);
5772 o->op_flags = (U8)flags;
5774 o->op_next = o;
5775 o->op_private = (U8)(0 | (flags >> 8));
5777 scalar(o);
5779 o->op_targ = pad_alloc(type, SVs_PADTMP);
5780 return CHECKOP(type, o);
6060 /* Given an OP_TRANS / OP_TRANSR op o, plus OP_CONST ops expr and repl
6062 * a translation table attached as o->op_pv.
6077 S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
6149 const bool complement = cBOOL(o->op_private & OPpTRANS_COMPLEMENT);
6150 const bool squash = cBOOL(o->op_private & OPpTRANS_SQUASH);
6151 const bool del = cBOOL(o->op_private & OPpTRANS_DELETE);
6724 o->op_private |= OPpTRANS_GROWS;
6815 * [i-1] J j # J-O => j-o
7046 o->op_private |= OPpTRANS_IDENTICAL;
7069 o->op_private |= OPpTRANS_USE_SVOP;
7072 o->op_private |= OPpTRANS_CAN_FORCE_UTF8;
7118 /* Non-utf8 case: set o->op_pv to point to a simple 256+ entry lookup
7128 o->op_private &= ~OPpTRANS_USE_SVOP;
7217 cBOOL(o->op_private & OPpTRANS_IDENTICAL),
7218 cBOOL(o->op_private & OPpTRANS_USE_SVOP),
7219 cBOOL(o->op_private & OPpTRANS_GROWS),
7220 cBOOL(o->op_private & OPpTRANS_CAN_FORCE_UTF8),
7234 return o;
7329 /* Given some sort of match op o, and an expression expr containing a
7330 * pattern, either compile expr into a regex and attach it to o (if it's
7349 Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
7354 bool is_trans = (o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
7363 return pmtrans(o, expr, repl);
7440 /* XXX optimize_optree() must be called on o before
7518 return o;
7537 return o;
7562 (void)pad_add_anon(cv, o->op_type);
7640 rcop = alloc_LOGOP(OP_REGCOMP, scalar(expr), o);
7660 op_prepend_elem(o->op_type, scalar((OP*)rcop), o);
7701 op_prepend_elem(o->op_type, scalar(repl), o);
7704 rcop = alloc_LOGOP(OP_SUBSTCONT, scalar(repl), o);
7883 Perl_package(pTHX_ OP *o)
7899 op_free(o);
8294 /* given the optree o on the LHS of an assignment, determine whether its:
8301 S_assignment_type(pTHX_ const OP *o)
8307 if (!o)
8310 if (o->op_type == OP_SREFGEN)
8314 flags = o->op_flags | kid->op_flags;
8321 if ((o->op_type == OP_NULL) && (o->op_flags & OPf_KIDS))
8322 o = cUNOPo->op_first;
8323 flags = o->op_flags;
8324 type = o->op_type;
8342 o->op_private & OPpLVAL_INTRO)
8403 OP *o = (OP *)alloc_LOGOP(OP_ARGDEFELEM, expr, LINKLIST(expr));
8404 o->op_flags |= (U8)(flags);
8405 o->op_private = 1 | (U8)(flags >> 8);
8408 o->op_targ = (PADOFFSET)(argindex);
8410 return o;
8439 OP *o;
8468 o = newBINOP(OP_AASSIGN, flags, list(op_force_list(right)), curop);
8469 o->op_private = (U8)(0 | (flags >> 8));
8565 /* detach the split subtreee from the o tree,
8566 * then free the residual o tree */
8568 op_free(o); /* blow off assign */
8612 o = S_newONCEOP(aTHX_ o, state_var_op);
8613 return o;
8625 o = newBINOP(OP_SASSIGN, flags,
8628 return o;
8642 If C<o> is null, the state op is returned. Otherwise the state op is
8643 combined with C<o> into a C<lineseq> list op, which is returned. C<o>
8650 Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
8720 return op_prepend_elem(OP_LINESEQ, (OP*)cop, o);
8746 /* See if the optree o contains a single OP_CONST (plus possibly
8752 S_search_const(pTHX_ OP *o)
8757 switch (o->op_type) {
8759 return o;
8761 if (o->op_flags & OPf_KIDS) {
8762 o = cUNOPo->op_first;
8771 if (!(o->op_flags & OPf_KIDS))
8792 o = kid;
8805 OP *o;
8958 o = newUNOP(prepend_not ? OP_NOT : OP_NULL,
8961 other->op_next = o;
8963 return o;
8985 OP *o;
9039 o = newUNOP(OP_NULL, 0, (OP*)logop);
9041 trueop->op_next = falseop->op_next = o;
9043 o->op_next = start;
9044 return o;
9125 OP *o;
9140 o = newUNOP(OP_NULL, 0, flop);
9164 flip->op_next = o;
9166 LINKLIST(o); /* blow off optimizer unless constant */
9168 return o;
9193 OP* o;
9247 o = new_logop(OP_AND, 0, &expr, &listop);
9254 cLISTOPx(listop)->op_last->op_next = LINKLIST(o);
9256 if (once && o != listop)
9260 o->op_next = cLOGOPx(cUNOPo->op_first)->op_other;
9263 if (o == listop)
9264 o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */
9266 o->op_flags |= flags;
9267 o = op_scope(o);
9268 o->op_flags |= OPf_SPECIAL; /* suppress cx_popblock() curpm restoration*/
9269 return o;
9303 OP *o;
9362 o = new_logop(OP_AND, 0, &expr, &listop);
9363 if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
9369 (o == listop ? redo : LINKLIST(o));
9372 o = listop;
9381 o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
9384 loop->op_lastop = o;
9385 o->op_private |= loopflags;
9390 loop->op_nextop = o;
9392 o->op_flags |= flags;
9393 o->op_private |= (flags >> 8);
9394 return o;
9625 OP *o = NULL;
9635 o = newOP(type, OPf_SPECIAL);
9651 o = newPVOP(type,
9659 if (o)
9661 else o = newUNOP(type, OPf_STACKED, label);
9664 return o;
9715 OP *o;
9724 o = newUNOP(leave_opcode, 0, (OP *) enterop);
9730 o->op_next = LINKLIST(cond);
9736 o ->op_flags |= OPf_SPECIAL;
9738 o->op_next = (OP *) enterop;
9746 block->op_next = enterop->op_other = o;
9748 return o;
9766 S_looks_like_bool(pTHX_ const OP *o)
9770 switch(o->op_type) {
9787 o->op_flags & OPf_KIDS
9824 if (o->op_private & OPpTRUEBOOL)
9917 OP *o, *start, *blockfirst;
9930 o = (OP *)alloc_LOGOP(OP_PUSHDEFER, block, start);
9931 o->op_flags |= OPf_WANT_VOID | (U8)(flags);
9932 o->op_private = (U8)(flags >> 8);
9939 return o;
9962 OP *o = newLISTOP(OP_LINESEQ, 0, newDEFEROP((OPpDEFER_FINALLY << 8), finally), block);
9963 o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
9964 OpTYPE_set(o, OP_LEAVE);
9966 return o;
10102 S_op_const_sv(pTHX_ const OP *o, CV *cv, bool allow_lex)
10107 assert(o);
10110 for (; o; o = o->op_next) {
10111 const OPCODE type = o->op_type;
10125 else if (type == OP_UNDEF && !o->op_private) {
10130 if (PAD_COMPNAME_FLAGS(o->op_targ) & PADNAMEf_OUTER)
10150 S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
10154 assert (o || name);
10178 SV *namesv = o
10209 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
10220 PADOFFSET pax = o->op_targ;
10560 op_free(o);
10608 If C<o_is_gv> is false and C<o> is null, then the subroutine will
10609 be anonymous. If C<o_is_gv> is false and C<o> is non-null, then C<o>
10613 stash will be selected in some manner. If C<o_is_gv> is true, then C<o>
10646 set to FALSE. This means that if C<o> is null, the new sub will be anonymous;
10647 otherwise the name will be derived from C<o> in the way described (as with all
10655 set to FALSE, and its C<attrs> parameter to NULL. This means that if C<o> is
10657 C<o> in the way described (as with all other details) in
10665 Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
10686 o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
10688 bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv);
10697 gv = (GV*)o;
10698 o = NULL;
10743 if (o)
10744 SAVEFREEOP(o);
10817 o ? (const GV *)cSVOPo->op_sv : NULL, ps,
10876 o ? (const GV *)cSVOPo->op_sv : NULL, ps,
10920 S_already_defined(aTHX_ cv, block, o, NULL, &const_sv);
11750 Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
11762 gv = o
11772 if (o) {
11798 op_free(o);
11814 Perl_newANONLIST(pTHX_ OP *o)
11816 return (o) ? op_convert_list(OP_ANONLIST, OPf_SPECIAL, o)
11829 Perl_newANONHASH(pTHX_ OP *o)
11831 OP * anon = (o) ? op_convert_list(OP_ANONHASH, OPf_SPECIAL, o)
11833 if (!o)
11845 set to FALSE, and its C<o> and C<attrs> parameters to NULL.
11864 set to FALSE, and its C<o> parameter to NULL.
11892 Perl_oopsAV(pTHX_ OP *o)
11897 switch (o->op_type) {
11900 OpTYPE_set(o, OP_PADAV);
11901 return ref(o, OP_RV2AV);
11905 OpTYPE_set(o, OP_RV2AV);
11906 ref(o, OP_RV2AV);
11913 return o;
11917 Perl_oopsHV(pTHX_ OP *o)
11922 switch (o->op_type) {
11925 OpTYPE_set(o, OP_PADHV);
11926 return ref(o, OP_RV2HV);
11930 OpTYPE_set(o, OP_RV2HV);
11932 o->op_private &= ~OPpARG1_MASK;
11933 ref(o, OP_RV2HV);
11940 return o;
11952 Perl_newAVREF(pTHX_ OP *o)
11957 if (o->op_type == OP_PADANY) {
11958 OpTYPE_set(o, OP_PADAV);
11959 return o;
11961 else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
11964 return newUNOP(OP_RV2AV, 0, scalar(o));
11976 Perl_newGVREF(pTHX_ I32 type, OP *o)
11979 return newUNOP(OP_NULL, 0, o);
11983 o->op_type == OP_CONST && (o->op_private & OPpCONST_BARE)) {
11987 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
11999 Perl_newHVREF(pTHX_ OP *o)
12004 if (o->op_type == OP_PADANY) {
12005 OpTYPE_set(o, OP_PADHV);
12006 return o;
12008 else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
12011 return newUNOP(OP_RV2HV, 0, scalar(o));
12023 Perl_newCVREF(pTHX_ I32 flags, OP *o)
12025 if (o->op_type == OP_PADANY) {
12026 OpTYPE_set(o, OP_PADCV);
12028 return newUNOP(OP_RV2CV, flags, scalar(o));
12040 Perl_newSVREF(pTHX_ OP *o)
12045 if (o->op_type == OP_PADANY) {
12046 OpTYPE_set(o, OP_PADSV);
12047 scalar(o);
12048 return o;
12050 return newUNOP(OP_RV2SV, 0, scalar(o));
12057 Perl_ck_anoncode(pTHX_ OP *o)
12061 cSVOPo->op_targ = pad_add_anon((CV*)cSVOPo->op_sv, o->op_type);
12063 return o;
12067 S_io_hints(pTHX_ OP *o)
12081 o->op_private |= OPpOPEN_IN_RAW;
12085 o->op_private |= OPpOPEN_IN_CRLF;
12097 o->op_private |= OPpOPEN_OUT_RAW;
12101 o->op_private |= OPpOPEN_OUT_CRLF;
12107 PERL_UNUSED_ARG(o);
12112 Perl_ck_backtick(pTHX_ OP *o)
12118 o = ck_fun(o);
12120 if (o->op_flags & OPf_KIDS && (sibl = OpSIBLING(cUNOPo->op_first))
12123 /* detach rest of siblings from o and its first child */
12124 op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
12127 else if (!(o->op_flags & OPf_KIDS))
12130 op_free(o);
12133 S_io_hints(aTHX_ o);
12134 return o;
12138 Perl_ck_bitop(pTHX_ OP *o)
12143 o->op_private = (PL_hints & HINT_INTEGER) ? OPpUSEINT : 0;
12145 if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
12146 && OP_IS_INFIX_BIT(o->op_type))
12156 o->op_type == OP_BIT_OR
12157 ||o->op_type == OP_NBIT_OR ? "|"
12158 : o->op_type == OP_BIT_AND
12159 ||o->op_type == OP_NBIT_AND ? "&"
12160 : o->op_type == OP_BIT_XOR
12161 ||o->op_type == OP_NBIT_XOR ? "^"
12162 : o->op_type == OP_SBIT_OR ? "|."
12163 : o->op_type == OP_SBIT_AND ? "&." : "^."
12166 return o;
12170 is_dollar_bracket(pTHX_ const OP * const o)
12174 return o->op_type == OP_RV2SV && o->op_flags & OPf_KIDS
12175 && (kid = cUNOPx(o)->op_first)
12183 Perl_ck_cmp(pTHX_ OP *o)
12195 is_eq = ( o->op_type == OP_EQ
12196 || o->op_type == OP_NE
12197 || o->op_type == OP_I_EQ
12198 || o->op_type == OP_I_NE);
12213 "$[ used in %s (did you mean $] ?)", OP_DESC(o));
12233 return o;
12237 return o;
12240 return o;
12244 return o;
12248 return o;
12251 if (o->op_type == OP_LT || o->op_type == OP_I_LT) {
12253 return o;
12256 else if (o->op_type == OP_LE || o->op_type == OP_I_LE) {
12258 return o;
12261 else if (o->op_type == OP_GE || o->op_type == OP_I_GE) {
12263 return o;
12266 else if (o->op_type == OP_GT || o->op_type == OP_I_GT) {
12268 return o;
12271 else if (o->op_type == OP_EQ || o->op_type == OP_I_EQ) {
12273 return o;
12277 assert(o->op_type == OP_NE || o->op_type == OP_I_NE);
12279 return o;
12284 indexop->op_flags |= (o->op_flags & OPf_PARENS);
12289 (void)op_sibling_splice(o, start, 1, NULL);
12290 op_free(o);
12297 Perl_ck_concat(pTHX_ OP *o)
12308 o->op_flags |= OPf_STACKED;
12309 o->op_private |= OPpCONCAT_NESTED;
12311 return o;
12315 Perl_ck_spair(pTHX_ OP *o)
12320 if (o->op_flags & OPf_KIDS) {
12324 const OPCODE type = o->op_type;
12325 o = modkids(ck_fun(o), type);
12332 return o;
12333 if (o->op_type == OP_REFGEN
12340 return o;
12348 o->op_ppaddr = PL_ppaddr[++o->op_type];
12349 return ck_fun(o);
12353 Perl_ck_delete(pTHX_ OP *o)
12357 o = ck_fun(o);
12358 o->op_private = 0;
12359 if (o->op_flags & OPf_KIDS) {
12363 o->op_flags |= OPf_SPECIAL;
12366 o->op_private |= OPpSLICE;
12369 o->op_flags |= OPf_SPECIAL;
12374 o->op_flags |= OPf_SPECIAL;
12377 o->op_private |= OPpKVSLICE;
12384 o->op_private |= OPpLVAL_INTRO;
12387 return o;
12391 Perl_ck_eof(pTHX_ OP *o)
12395 if (o->op_flags & OPf_KIDS) {
12399 = newUNOP(o->op_type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
12400 op_free(o);
12401 o = newop;
12403 o = ck_fun(o);
12408 return o;
12413 Perl_ck_eval(pTHX_ OP *o)
12421 if (o->op_flags & OPf_KIDS) {
12425 if (o->op_type == OP_ENTERTRY) {
12428 /* cut whole sibling chain free from o */
12429 op_sibling_splice(o, NULL, -1, NULL);
12430 op_free(o);
12437 o = op_prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
12438 OpTYPE_set(o, OP_LEAVETRY);
12439 enter->op_other = o;
12440 return o;
12448 const U8 priv = o->op_private;
12449 op_free(o);
12456 o->op_targ = (PADOFFSET)PL_hints;
12457 if (o->op_private & OPpEVAL_BYTES) o->op_targ &= ~HINT_UTF8;
12459 && !(o->op_private & OPpEVAL_COPHH) && GvHV(PL_hintgv)) {
12466 op_sibling_splice(o, cUNOPo->op_first, 0, hhop);
12468 o->op_private |= OPpEVAL_HAS_HH;
12470 if (!(o->op_private & OPpEVAL_BYTES)
12472 o->op_private |= OPpEVAL_UNICODE;
12473 return o;
12477 Perl_ck_trycatch(pTHX_ OP *o)
12496 /* cut whole sibling chain free from o */
12497 op_sibling_splice(o, NULL, -1, NULL);
12499 op_free(o);
12506 o = op_prepend_elem(OP_LINESEQ, (OP*)enter, trykid);
12507 op_append_elem(OP_LINESEQ, (OP*)o, catchkid);
12509 OpTYPE_set(o, OP_LEAVETRYCATCH);
12524 o->op_next = LINKLIST(o);
12530 trykid->op_next = o;
12533 catchroot->op_next = o;
12535 return o;
12539 Perl_ck_exec(pTHX_ OP *o)
12543 if (o->op_flags & OPf_STACKED) {
12545 o = ck_fun(o);
12551 o = listkids(o);
12552 return o;
12556 Perl_ck_exists(pTHX_ OP *o)
12560 o = ck_fun(o);
12561 if (o->op_flags & OPf_KIDS) {
12564 (void) ref(kid, o->op_type);
12569 o->op_private |= OPpEXISTS_SUB;
12572 o->op_flags |= OPf_SPECIAL;
12578 return o;
12582 Perl_ck_helemexistsor(pTHX_ OP *o)
12586 o = ck_fun(o);
12589 if(!(o->op_flags & OPf_KIDS) ||
12606 keyop->op_next = o;
12608 return o;
12612 Perl_ck_rvconst(pTHX_ OP *o)
12618 if (o->op_type == OP_RV2HV)
12620 o->op_private &= ~OPpARG1_MASK;
12622 o->op_private |= (PL_hints & HINT_STRICT_REFS);
12631 return o;
12633 if (SvTYPE(kidsv) == SVt_PVAV) return o;
12634 if ((o->op_private & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
12636 switch (o->op_type) {
12663 iscv = o->op_type == OP_RV2CV ? GV_NOEXPAND|GV_ADDMULTI : 0;
12665 o->op_type == OP_RV2CV
12666 && o->op_private & OPpMAY_RETURN_CONSTANT
12671 : o->op_type == OP_RV2SV
12673 : o->op_type == OP_RV2AV
12675 : o->op_type == OP_RV2HV
12682 if (!(o->op_private & OPpMAY_RETURN_CONSTANT)
12702 return o;
12706 Perl_ck_ftst(pTHX_ OP *o)
12708 const I32 type = o->op_type;
12712 if (o->op_flags & OPf_REF) {
12715 else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
12726 op_free(o);
12743 if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
12744 o->op_private |= OPpFT_ACCESS;
12748 o->op_private |= OPpFT_STACKED;
12754 o->op_private |= OPpFT_AFTER_t;
12758 op_free(o);
12760 o = newGVOP(type, OPf_REF, PL_stdingv);
12762 o = newUNOP(type, 0, newDEFSVOP());
12764 return o;
12768 Perl_ck_fun(pTHX_ OP *o)
12770 const int type = o->op_type;
12775 if (o->op_flags & OPf_STACKED) {
12779 return no_fh_allowed(o);
12782 if (o->op_flags & OPf_KIDS) {
12801 if (optional) o->op_private |= numargs;
12802 return o;
12810 op_sibling_splice(o, prev_kid, 0, kid);
12823 return too_many_arguments_pv(o,PL_op_desc[type], 0);
12846 bad_type_pv(numargs, "array", o, kid);
12849 bad_type_pv(1, "array", o, kid);
12861 bad_type_pv(numargs, "hash", o, kid);
12868 S_op_sibling_newUNOP(aTHX_ o, prev_kid, OP_NULL, 0);
12886 op_sibling_splice(o, prev_kid, 1, newop);
12892 bad_type_pv(numargs, "HANDLE", o, kid);
12900 if (is_handle_constructor(o,numargs)) {
12989 kid = S_op_sibling_newUNOP(aTHX_ o, prev_kid,
13001 return too_many_arguments_pv(o,PL_op_desc[type], 0);
13011 o->op_private |= numargs;
13013 return too_many_arguments_pv(o,OP_DESC(o), 0);
13014 listkids(o);
13018 op_free(o);
13026 return too_few_arguments_pv(o,OP_DESC(o), 0);
13028 return o;
13032 Perl_ck_glob(pTHX_ OP *o)
13038 o = ck_fun(o);
13039 if ((o->op_flags & OPf_KIDS) && !OpHAS_SIBLING(cLISTOPo->op_first))
13040 op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
13042 if (!(o->op_flags & OPf_SPECIAL) && (gv = gv_override("glob", 4)))
13056 o->op_flags |= OPf_SPECIAL;
13057 o->op_targ = pad_alloc(OP_GLOB, SVs_PADTMP);
13058 o = S_new_entersubop(aTHX_ gv, o);
13059 o = newUNOP(OP_NULL, 0, o);
13060 o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */
13061 return o;
13063 else o->op_flags &= ~OPf_SPECIAL;
13075 op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
13077 scalarkids(o);
13078 return o;
13082 Perl_ck_grep(pTHX_ OP *o)
13086 const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
13092 if (o->op_flags & OPf_STACKED) {
13095 return no_fh_allowed(o);
13096 o->op_flags &= ~OPf_STACKED;
13103 o = ck_fun(o);
13105 return o;
13111 gwop = alloc_LOGOP(type, o, LINKLIST(kid));
13113 o->op_private = gwop->op_private = 0;
13124 Perl_ck_index(pTHX_ OP *o)
13128 if (o->op_flags & OPf_KIDS) {
13150 return ck_fun(o);
13154 Perl_ck_lfun(pTHX_ OP *o)
13156 const OPCODE type = o->op_type;
13160 return modkids(ck_fun(o), type);
13164 Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */
13168 if ((o->op_flags & OPf_KIDS)) {
13187 return ck_rfun(o);
13191 Perl_ck_readline(pTHX_ OP *o)
13195 if (o->op_flags & OPf_KIDS) {
13207 op_free(o);
13210 return o;
13214 Perl_ck_rfun(pTHX_ OP *o)
13216 const OPCODE type = o->op_type;
13220 return refkids(ck_fun(o), type);
13224 Perl_ck_listiob(pTHX_ OP *o)
13232 o = op_force_list(o);
13237 if (kid && o->op_flags & OPf_STACKED)
13245 o->op_flags |= OPf_STACKED; /* make it a filehandle */
13248 kid = S_op_sibling_newUNOP(aTHX_ o, cLISTOPo->op_first,
13255 op_append_elem(o->op_type, o, newDEFSVOP());
13257 if (o->op_type == OP_PRTF) return modkids(listkids(o), OP_PRTF);
13258 return listkids(o);
13262 Perl_ck_smartmatch(pTHX_ OP *o)
13265 if (0 == (o->op_flags & OPf_SPECIAL)) {
13274 op_sibling_splice(o, NULL, 1, NULL);
13275 op_sibling_splice(o, NULL, 1, NULL);
13278 op_sibling_splice(o, NULL, 0, second);
13279 op_sibling_splice(o, NULL, 0, first);
13290 return o;
13295 S_maybe_targlex(pTHX_ OP *o)
13311 (o->op_flags & (OPf_WANT|OPf_PARENS));
13321 | (o->op_flags & OPf_WANT);
13327 op_sibling_splice(o, NULL, 1, NULL);
13328 op_free(o);
13333 return o;
13337 Perl_ck_sassign(pTHX_ OP *o)
13354 return S_newONCEOP(aTHX_ o, kkid);
13357 return S_maybe_targlex(aTHX_ o);
13362 Perl_ck_match(pTHX_ OP *o)
13367 return o;
13371 Perl_ck_method(pTHX_ OP *o)
13382 if (kid->op_type != OP_CONST) return o;
13406 op_free(o);
13411 op_free(o);
13428 op_free(o);
13433 Perl_ck_null(pTHX_ OP *o)
13437 return o;
13441 Perl_ck_open(pTHX_ OP *o)
13445 S_io_hints(aTHX_ o);
13449 OP * const first = cLISTOPx(o)->op_first; /* The pushmark. */
13450 OP * const last = cLISTOPx(o)->op_last; /* The bareword. */
13466 return ck_fun(o);
13470 Perl_ck_prototype(pTHX_ OP *o)
13473 if (!(o->op_flags & OPf_KIDS)) {
13474 op_free(o);
13477 return o;
13481 Perl_ck_refassign(pTHX_ OP *o)
13492 o->op_private = 0;
13500 o->op_private |= OPpLVREF_AV;
13503 o->op_private |= OPpLVREF_HV;
13507 o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE));
13508 o->op_targ = varop->op_targ;
13509 if (!(o->op_private & (OPpPAD_STATE|OPpLVAL_INTRO)))
13511 PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
13515 o->op_private |= OPpLVREF_AV;
13519 o->op_private |= OPpLVREF_HV;
13523 o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO));
13534 o->op_private |= OPpLVREF_CV;
13549 o->op_targ = kid->op_targ;
13555 o->op_private |= (varop->op_private & OPpLVAL_INTRO);
13556 o->op_private |= OPpLVREF_ELEM;
13568 return o;
13577 o->op_flags |= OPf_STACKED;
13578 op_sibling_splice(o, right, 1, varop);
13581 o->op_flags &=~ OPf_STACKED;
13582 op_sibling_splice(o, right, 1, NULL);
13584 if (o->op_private & OPpPAD_STATE && o->op_private & OPpLVAL_INTRO) {
13585 o = S_newONCEOP(aTHX_ o, varop);
13588 return o;
13592 Perl_ck_repeat(pTHX_ OP *o)
13598 o->op_private |= OPpREPEAT_DOLIST;
13599 kids = op_sibling_splice(o, NULL, 1, NULL); /* detach first kid */
13601 op_sibling_splice(o, NULL, 0, kids); /* and add back */
13604 scalar(o);
13605 return o;
13609 Perl_ck_require(pTHX_ OP *o)
13615 if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
13682 if (!(o->op_flags & OPf_SPECIAL) /* Wasn't written as CORE::require */
13686 if (o->op_flags & OPf_KIDS) {
13688 op_sibling_splice(o, NULL, -1, NULL);
13693 op_free(o);
13698 return ck_fun(o);
13702 Perl_ck_return(pTHX_ OP *o)
13708 if (o->op_flags & OPf_STACKED) {
13712 o->op_flags &= ~OPf_STACKED;
13721 return o;
13725 Perl_ck_select(pTHX_ OP *o)
13731 if (o->op_flags & OPf_KIDS) {
13734 OpTYPE_set(o, OP_SSELECT);
13735 o = ck_fun(o);
13736 return fold_constants(op_integerize(op_std_init(o)));
13739 o = ck_fun(o);
13743 return o;
13747 Perl_ck_shift(pTHX_ OP *o)
13749 const I32 type = o->op_type;
13753 if (!(o->op_flags & OPf_KIDS)) {
13757 o->op_flags |= OPf_SPECIAL;
13758 return o;
13762 op_free(o);
13765 return scalar(ck_fun(o));
13769 Perl_ck_sort(pTHX_ OP *o)
13777 if (o->op_flags & OPf_STACKED)
13778 simplify_sort(o);
13782 return too_few_arguments_pv(o,OP_DESC(o), 0);
13784 if ((stacked = o->op_flags & OPf_STACKED)) { /* may have been cleared */
13799 o->op_flags |= OPf_SPECIAL;
13839 return o;
13853 S_simplify_sort(pTHX_ OP *o)
13941 o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
13943 o->op_private |= OPpSORT_DESCEND;
13945 o->op_private |= OPpSORT_NUMERIC;
13947 o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
13950 op_sibling_splice(o, cLISTOPo->op_first, 1, NULL);
13955 Perl_ck_split(pTHX_ OP *o)
13962 assert(o->op_type == OP_LIST);
13964 if (o->op_flags & OPf_STACKED)
13965 return no_fh_allowed(o);
13970 op_sibling_splice(o, NULL, 1,
13978 op_sibling_splice(o, NULL, 1, NULL);
13981 op_sibling_splice(o, NULL, 0, kid);
14005 op_sibling_splice(o, NULL, 1, NULL); /* detach match op from o */
14006 sibs = op_sibling_splice(o, NULL, -1, NULL); /* detach any other sibs */
14009 kid->op_flags = (o->op_flags | (kid->op_flags & OPf_KIDS));
14010 kid->op_private = o->op_private;
14011 op_free(o);
14012 o = kid;
14017 op_append_elem(OP_SPLIT, o, kid);
14024 op_append_elem(OP_SPLIT, o, kid);
14025 o->op_private |= OPpSPLIT_IMPLIM;
14030 return too_many_arguments_pv(o,OP_DESC(o), 0);
14032 return o;
14036 Perl_ck_stringify(pTHX_ OP *o)
14045 op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
14046 op_free(o);
14049 return ck_fun(o);
14053 Perl_ck_join(pTHX_ OP *o)
14082 op_sibling_splice(o, kid, 1, NULL));
14083 op_free(o);
14088 return ck_fun(o);
14858 S_entersub_alloc_targ(pTHX_ OP * const o)
14860 o->op_targ = pad_alloc(OP_ENTERSUB, SVs_PADTMP);
14861 o->op_private |= OPpENTERSUB_HASTARG;
14865 Perl_ck_subr(pTHX_ OP *o)
14875 aop = cUNOPx(o)->op_first;
14883 o->op_private &= ~1;
14884 o->op_private |= (PL_hints & HINT_STRICT_REFS);
14886 o->op_private |= OPpENTERSUB_DB;
14889 o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
14897 o->op_flags |= OPf_REF;
14939 S_entersub_alloc_targ(aTHX_ o);
14940 return ck_entersub_args_list(o);
14947 S_entersub_alloc_targ(aTHX_ o);
14962 if (!namegv) return ck_entersub_args_list(o);
14965 return ckfun(aTHX_ o, namegv, ckobj);
14970 Perl_ck_svconst(pTHX_ OP *o)
14990 return o;
14994 Perl_ck_trunc(pTHX_ OP *o)
14998 if (o->op_flags & OPf_KIDS) {
15007 o->op_flags |= OPf_SPECIAL;
15014 return ck_fun(o);
15018 Perl_ck_substr(pTHX_ OP *o)
15022 o = ck_fun(o);
15023 if ((o->op_flags & OPf_KIDS) && (o->op_private == 4)) {
15035 return o;
15039 Perl_ck_tell(pTHX_ OP *o)
15042 o = ck_fun(o);
15043 if (o->op_flags & OPf_KIDS) {
15048 return o;
15052 S_last_non_null_kid(OP *o) {
15068 Perl_ck_each(pTHX_ OP *o)
15070 OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
15071 const unsigned orig_type = o->op_type;
15132 OpTYPE_set(o, orig_type == OP_EACH ? OP_AEACH
15149 bad_type_pv(1, "hash or array", o, kid);
15150 return o;
15153 return ck_fun(o);
15157 Perl_ck_length(pTHX_ OP *o)
15161 o = ck_fun(o);
15164 const OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL;
15178 return o;
15197 return o;
15202 Perl_ck_isa(pTHX_ OP *o)
15214 return o;
15222 S_inplace_aassign(pTHX_ OP *o) {
15230 assert((o->op_flags & OPf_WANT) == OPf_WANT_VOID);
15294 op_null(o);
15348 Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
15357 assert(o->op_type == OP_CUSTOM);
15365 keysv = sv_2mortal(newSViv(PTR2IV(o->op_ppaddr)));
15392 Perl_custom_op_register(aTHX_ o->op_ppaddr, xop);
15597 OP *o;
15613 o = newUNOP(OP_AVHVSWITCH,0,argop);
15614 o->op_private = opnum-OP_EACH;
15615 return o;
15640 o = newUNOP(OP_ENTEREVAL,OPpEVAL_COPHH<<8,argop);
15641 if (code == -KEY_evalbytes) o->op_private |= OPpEVAL_BYTES;
15643 else o = newUNOP(opnum,0,argop);
15644 if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
15647 if (is_handle_constructor(o, 1))
15652 return o;
15654 o = op_convert_list(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
15655 if (is_handle_constructor(o, 2))
15658 o->op_private |= OPpMAYBE_LVSUB;
15659 return o;