#define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
#define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
+/* remove any leading "empty" ops from the op_next chain whose first
+ * node's address is stored in op_p. Store the updated address of the
+ * first node in op_p.
+ */
+
+STATIC void
+S_prune_chain_head(pTHX_ OP** op_p)
+{
+ while (*op_p
+ && ( (*op_p)->op_type == OP_NULL
+ || (*op_p)->op_type == OP_SCOPE
+ || (*op_p)->op_type == OP_SCALAR
+ || (*op_p)->op_type == OP_LINESEQ)
+ )
+ *op_p = (*op_p)->op_next;
+}
+
+
/* See the explanatory comments above struct opslab in op.h. */
#ifdef PERL_DEBUG_READONLY_OPS
o->op_targ = 0;
goto retry;
}
+ /* FALLTHROUGH */
case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
o->op_targ = 0;
if (!(o->op_flags & OPf_REF)
|| (PL_check[o->op_type] != Perl_ck_ftst))
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
case OP_REDO:
if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_TRANS:
case OP_TRANSR:
if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
#else
SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv));
#endif
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_MATCH:
case OP_QR:
clear_pmop:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalar(kid);
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_SPLIT:
case OP_MATCH:
case OP_QR:
default:
if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_REPEAT:
if (o->op_flags & OPf_STACKED)
break;
case OP_SUBSTR:
if (o->op_private == 4)
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_GVSV:
case OP_WANTARRAY:
case OP_GV:
}
op_null(kid);
}
+ /* FALLTHROUGH */
case OP_DOR:
case OP_COND_EXPR:
case OP_NULL:
if (o->op_flags & OPf_STACKED)
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
case OP_ENTERTRY:
case OP_ENTER:
if (!(o->op_flags & OPf_KIDS))
break;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_SCOPE:
case OP_LEAVE:
case OP_LEAVETRY:
case OP_HSLICE:
S_scalar_slice_warning(aTHX_ o);
+ /* FALLTHROUGH */
case OP_KVHSLICE:
kid = cLISTOPo->op_first->op_sibling;
break;
}
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
default:
nomod:
if (flags & OP_LVALUE_NO_CROAK) return NULL;
PL_modcount = RETURN_UNLIMITED_NUMBER;
return o; /* Treat \(@foo) like ordinary list. */
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_RV2GV:
if (scalar_mod_type(o, type))
goto nomod;
ref(cUNOPo->op_first, o->op_type);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_ASLICE:
case OP_HSLICE:
localize = 1;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_AASSIGN:
/* Do not apply the lvsub flag for rv2[ah]v in scalar context. */
if (type == OP_LEAVESUBLV && (
|| (o->op_flags & OPf_WANT) != OPf_WANT_SCALAR
))
o->op_private |= OPpMAYBE_LVSUB;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
PL_modcount = RETURN_UNLIMITED_NUMBER;
case OP_RV2SV:
ref(cUNOPo->op_first, o->op_type);
localize = 1;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_GV:
PL_hints |= HINT_BLOCK_SCOPE;
+ /* FALLTHROUGH */
case OP_SASSIGN:
case OP_ANDASSIGN:
case OP_ORASSIGN:
if ((o->op_flags & OPf_WANT) != OPf_WANT_SCALAR
&& type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_PADSV:
PL_modcount++;
if (!type) /* local() */
case OP_SUBSTR:
if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
goto nomod;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_POS:
case OP_VEC:
lvalue_func:
case OP_LEAVE:
case OP_LEAVELOOP:
o->op_private |= OPpLVALUE;
+ /* FALLTHROUGH */
case OP_SCOPE:
case OP_ENTER:
case OP_LINESEQ:
op_lvalue(cBINOPo->op_first, type);
break;
}
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_LIST:
localize = 0;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
case OP_SASSIGN:
if (o && o->op_type == OP_RV2GV)
return FALSE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_PREINC:
case OP_PREDEC:
case OP_POSTINC:
case OP_SOCKPAIR:
if (numargs == 2)
return TRUE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_SYSOPEN:
case OP_OPEN:
case OP_SELECT: /* XXX c.f. SelectSaver.pm */
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
doref(cUNOPo->op_first, o->op_type, set_op_ref);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_PADSV:
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
case OP_RV2HV:
if (set_op_ref)
o->op_flags |= OPf_REF;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_RV2GV:
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
case OP_SCOPE:
case OP_LEAVE:
set_op_ref = FALSE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_ENTER:
case OP_LIST:
if (!(o->op_flags & OPf_KIDS))
S_cant_declare(aTHX_ o);
} else if (attrs) {
GV * const gv = cGVOPx_gv(cUNOPo->op_first);
+ assert(PL_parser);
PL_parser->in_my = FALSE;
PL_parser->in_my_stash = NULL;
apply_attrs(GvSTASH(gv),
else if (attrs && type != OP_PUSHMARK) {
HV *stash;
+ assert(PL_parser);
PL_parser->in_my = FALSE;
PL_parser->in_my_stash = NULL;
ENTER;
CALL_PEEP(PL_eval_start);
finalize_optree(PL_eval_root);
+ S_prune_chain_head(aTHX_ &PL_eval_start);
LEAVE;
PL_savestack_ix = i;
}
PL_main_root->op_next = 0;
CALL_PEEP(PL_main_start);
finalize_optree(PL_main_root);
+ S_prune_chain_head(aTHX_ &PL_main_start);
cv_forget_slab(PL_compcv);
PL_compcv = 0;
if (PL_parser && PL_parser->error_count)
return o; /* Don't attempt to run with errors */
- PL_op = curop = LINKLIST(o);
+ curop = LINKLIST(o);
o->op_next = 0;
CALL_PEEP(curop);
+ S_prune_chain_head(aTHX_ &curop);
+ PL_op = curop;
Perl_pp_pushmark(aTHX);
CALLRUNOPS(aTHX);
PL_op = curop;
/* have to peep the DOs individually as we've removed it from
* the op_next chain */
CALL_PEEP(o);
+ S_prune_chain_head(aTHX_ &(o->op_next));
if (is_compiletime)
/* runtime finalizes as part of finalizing whole tree */
finalize_optree(o);
else
return FALSE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
default:
return FALSE;
}
}
/* op_const_sv: examine an optree to determine whether it's in-lineable.
+ * Can be called in 3 ways:
+ *
+ * !cv
+ * look for a single OP_CONST with attached value: return the value
+ *
+ * cv && CvCLONE(cv) && !CvCONST(cv)
+ *
+ * examine the clone prototype, and if contains only a single
+ * OP_CONST referencing a pad const, or a single PADSV referencing
+ * an outer lexical, return a non-zero value to indicate the CV is
+ * a candidate for "constizing" at clone time
+ *
+ * cv && CvCONST(cv)
+ *
+ * We have just cloned an anon prototype that was marked as a const
+ * candidate. Try to grab the current value, and in the case of
+ * PADSV, ignore it if it has multiple references. In this case we
+ * return a newly created *copy* of the value.
*/
SV *
-Perl_op_const_sv(pTHX_ const OP *o)
+Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
{
dVAR;
SV *sv = NULL;
return NULL;
if (type == OP_CONST && cSVOPo->op_sv)
sv = cSVOPo->op_sv;
+ else if (cv && type == OP_CONST) {
+ sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+ if (!sv)
+ return NULL;
+ }
+ else if (cv && type == OP_PADSV) {
+ if (CvCONST(cv)) { /* newly cloned anon */
+ sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+ /* the candidate should have 1 ref from this pad and 1 ref
+ * from the parent */
+ if (!sv || SvREFCNT(sv) != 2)
+ return NULL;
+ sv = newSVsv(sv);
+ SvREADONLY_on(sv);
+ return sv;
+ }
+ else {
+ if (PAD_COMPNAME_FLAGS(o->op_targ) & SVf_FAKE)
+ sv = &PL_sv_undef; /* an arbitrary non-null value */
+ }
+ }
else {
return NULL;
}
)
const_sv = NULL;
else
- const_sv = op_const_sv(block);
+ const_sv = op_const_sv(block, NULL);
if (cv) {
const bool exists = CvROOT(cv) || CvXSUB(cv);
CvROOT(cv)->op_next = 0;
CALL_PEEP(CvSTART(cv));
finalize_optree(CvROOT(cv));
+ S_prune_chain_head(aTHX_ &CvSTART(cv));
/* now that optimizer has done its work, adjust pad values */
pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+ if (CvCLONE(cv)) {
+ assert(!CvCONST(cv));
+ if (ps && !*ps && op_const_sv(block, cv))
+ CvCONST_on(cv);
+ }
+
attrs:
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
)
const_sv = NULL;
else
- const_sv = op_const_sv(block);
+ const_sv = op_const_sv(block, NULL);
if (cv) {
const bool exists = CvROOT(cv) || CvXSUB(cv);
CvROOT(cv)->op_next = 0;
CALL_PEEP(CvSTART(cv));
finalize_optree(CvROOT(cv));
+ S_prune_chain_head(aTHX_ &CvSTART(cv));
/* now that optimizer has done its work, adjust pad values */
pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+ if (CvCLONE(cv)) {
+ assert(!CvCONST(cv));
+ if (ps && !*ps && op_const_sv(block, cv))
+ CvCONST_on(cv);
+ }
+
attrs:
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
CvROOT(cv)->op_next = 0;
CALL_PEEP(CvSTART(cv));
finalize_optree(CvROOT(cv));
+ S_prune_chain_head(aTHX_ &CvSTART(cv));
cv_forget_slab(cv);
finish:
static void
S_io_hints(pTHX_ OP *o)
{
+#ifdef PERLIO_BINARY_AND_TEXT_DIFFERENT_AND_EFFECTIVE
HV * const table =
PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;;
if (table) {
o->op_private |= OPpOPEN_OUT_CRLF;
}
}
+#else
+ PERL_UNUSED_ARG(o);
+#endif
}
OP *
switch (kid->op_type) {
case OP_ASLICE:
o->op_flags |= OPf_SPECIAL;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_HSLICE:
o->op_private |= OPpSLICE;
break;
case OP_AELEM:
o->op_flags |= OPf_SPECIAL;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_HELEM:
break;
case OP_KVASLICE:
op_append_elem(OP_SPLIT, o, newDEFSVOP());
kid = kid->op_sibling;
+ assert(kid);
scalar(kid);
if (!kid->op_sibling)
/* _ must be at the end */
if (proto[1] && !strchr(";@%", proto[1]))
goto oops;
+ /* FALLTHROUGH */
case '$':
proto++;
arg++;
MAGIC *callmg;
sv_magic((SV*)cv, &PL_sv_undef, PERL_MAGIC_checkcall, NULL, 0);
callmg = mg_find((SV*)cv, PERL_MAGIC_checkcall);
+ assert(callmg);
if (callmg->mg_flags & MGf_REFCOUNTED) {
SvREFCNT_dec(callmg->mg_obj);
callmg->mg_flags &= ~MGf_REFCOUNTED;
op_null(oleft);
}
+
+
+/* mechanism for deferring recursion in rpeep() */
+
#define MAX_DEFERRED 4
#define DEFER(o) \
STMT_START { \
if (defer_ix == (MAX_DEFERRED-1)) { \
- CALL_RPEEP(defer_queue[defer_base]); \
+ OP **defer = defer_queue[defer_base]; \
+ CALL_RPEEP(*defer); \
+ S_prune_chain_head(aTHX_ defer); \
defer_base = (defer_base + 1) % MAX_DEFERRED; \
defer_ix--; \
} \
- defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o; \
+ defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = &(o); \
} STMT_END
#define IS_AND_OP(o) (o->op_type == OP_AND)
#define IS_OR_OP(o) (o->op_type == OP_OR)
+
STATIC void
S_null_listop_in_list_context(pTHX_ OP *o)
{
dVAR;
OP* oldop = NULL;
OP* oldoldop = NULL;
- OP* defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
+ OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
int defer_base = 0;
int defer_ix = -1;
if (o && o->op_opt)
o = NULL;
if (!o) {
- while (defer_ix >= 0)
- CALL_RPEEP(defer_queue[(defer_base + defer_ix--) % MAX_DEFERRED]);
+ while (defer_ix >= 0) {
+ OP **defer =
+ defer_queue[(defer_base + defer_ix--) % MAX_DEFERRED];
+ CALL_RPEEP(*defer);
+ S_prune_chain_head(aTHX_ defer);
+ }
break;
}
though (See 20010220.007). AMS 20010719 */
/* op_seq functionality is now replaced by op_opt */
o->op_opt = 0;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case OP_SCALAR:
case OP_LINESEQ:
case OP_SCOPE:
nothin:
- if (oldop && o->op_next) {
+ if (oldop) {
oldop->op_next = o->op_next;
o->op_opt = 0;
continue;
if (OP_GIMME(o,0) == G_VOID) {
OP *right = cBINOP->op_first;
if (right) {
+ /* sassign
+ * RIGHT
+ * substr
+ * pushmark
+ * arg1
+ * arg2
+ * ...
+ * becomes
+ *
+ * ex-sassign
+ * substr
+ * pushmark
+ * RIGHT
+ * arg1
+ * arg2
+ * ...
+ */
OP *left = right->op_sibling;
if (left->op_type == OP_SUBSTR
&& (left->op_private & 7) < 4) {
}
}
- oldoldop = oldop;
- oldop = o;
+ /* did we just null the current op? If so, re-process it to handle
+ * eliding "empty" ops from the chain */
+ if (o->op_type == OP_NULL && oldop && oldop->op_next == o) {
+ o->op_opt = 0;
+ o = oldop;
+ }
+ else {
+ oldoldop = oldop;
+ oldop = o;
+ }
}
LEAVE;
}
OP_SSELECT),
coresub_op(coreargssv, 0, OP_SELECT)
);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
default:
switch (PL_opargs[opnum] & OA_CLASS_MASK) {
case OA_BASEOP:
https://perl5.git.perl.org / perl5.git / blobdiff