}
}
- /* check for duplicate declaration */
- pad_check_dup(name, len, is_our ? pad_add_OUR : 0,
- (PL_curstash ? PL_curstash : PL_defstash));
-
/* allocate a spare slot and store the name in that slot */
- off = pad_add_name(name,
+ off = pad_add_name(name, len,
+ is_our ? padadd_OUR :
+ PL_parser->in_my == KEY_state ? padadd_STATE : 0,
PL_parser->in_my_stash,
(is_our
/* $_ is always in main::, even with our */
? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
: NULL
- ),
- 0, /* not fake */
- PL_parser->in_my == KEY_state
+ )
);
/* anon sub prototypes contains state vars should always be cloned,
* otherwise the state var would be shared between anon subs */
o->op_targ = 0;
goto retry;
}
+ case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
o->op_targ = 0;
break;
want = o->op_flags & OPf_WANT;
if ((want && want != OPf_WANT_SCALAR)
|| (PL_parser && PL_parser->error_count)
- || o->op_type == OP_RETURN)
+ || o->op_type == OP_RETURN || o->op_type == OP_REQUIRE)
{
return o;
}
useless = OP_DESC(o);
break;
+ case OP_SPLIT:
+ kid = cLISTOPo->op_first;
+ if (kid && kid->op_type == OP_PUSHRE
+#ifdef USE_ITHREADS
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff)
+#else
+ && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv)
+#endif
+ useless = OP_DESC(o);
+ break;
+
case OP_NOT:
kid = cUNOPo->op_first;
if (kid->op_type != OP_MATCH && kid->op_type != OP_SUBST &&
case OP_ENTEREVAL:
scalarkids(o);
break;
- case OP_REQUIRE:
- /* all requires must return a boolean value */
- o->op_flags &= ~OPf_WANT;
- /* FALL THROUGH */
case OP_SCALAR:
return scalar(o);
}
}
PL_curcop = &PL_compiling;
break;
- case OP_REQUIRE:
- /* all requires must return a boolean value */
- o->op_flags &= ~OPf_WANT;
- return scalar(o);
}
return o;
}
dVAR;
LISTOP *listop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP);
+
NewOp(1101, listop, 1, LISTOP);
listop->op_type = (OPCODE)type;
{
dVAR;
OP *o;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
NewOp(1101, o, 1, OP);
o->op_type = (OPCODE)type;
o->op_ppaddr = PL_ppaddr[type];
dVAR;
UNOP *unop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
+ || type == OP_SASSIGN
+ || type == OP_ENTERTRY
+ || type == OP_NULL );
+
if (!first)
first = newOP(OP_STUB, 0);
if (PL_opargs[type] & OA_MARK)
{
dVAR;
BINOP *binop;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
+ || type == OP_SASSIGN || type == OP_NULL );
+
NewOp(1101, binop, 1, BINOP);
if (!first)
dVAR;
PMOP *pmop;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP);
+
NewOp(1101, pmop, 1, PMOP);
pmop->op_type = (OPCODE)type;
pmop->op_ppaddr = PL_ppaddr[type];
PERL_ARGS_ASSERT_NEWSVOP;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
svop->op_ppaddr = PL_ppaddr[type];
PERL_ARGS_ASSERT_NEWPADOP;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
padop->op_ppaddr = PL_ppaddr[type];
{
dVAR;
PVOP *pvop;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
NewOp(1101, pvop, 1, PVOP);
pvop->op_type = (OPCODE)type;
pvop->op_ppaddr = PL_ppaddr[type];
|| left->op_type == OP_PADHV
|| left->op_type == OP_PADANY))
{
- maybe_common_vars = FALSE;
+ if (left->op_type == OP_PADSV) maybe_common_vars = FALSE;
if (left->op_private & OPpPAD_STATE) {
/* All single variable list context state assignments, hence
state ($a) = ...
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP);
+
scalarboolean(first);
/* optimize AND and OR ops that have NOTs as children */
if (first->op_type == OP_NOT
PERL_ARGS_ASSERT_NEWLOOPEX;
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
)&& !attrs) {
if (CvFLAGS(PL_compcv)) {
/* might have had built-in attrs applied */
- CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
+ if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && ckWARN(WARN_MISC))
+ Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+ CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS & ~CVf_LVALUE);
}
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(PL_compcv);
&& block->op_type != OP_NULL
#endif
) {
+ cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
cv_undef(cv);
- CvFLAGS(cv) = CvFLAGS(PL_compcv);
+ CvFLAGS(cv) = CvFLAGS(PL_compcv) | existing_builtin_attrs;
if (!CvWEAKOUTSIDE(cv))
SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
if (PL_madskills) {
if (strEQ(name, "import")) {
PL_formfeed = MUTABLE_SV(cv);
- Perl_warner(aTHX_ packWARN(WARN_VOID), "%lx\n", (long)cv);
+ /* diag_listed_as: SKIPME */
+ Perl_warner(aTHX_ packWARN(WARN_VOID), "0x%"UVxf"\n", PTR2UV(cv));
}
}
GvCVGEN(gv) = 0;
/* establish postfix order */
enter->op_next = (OP*)enter;
- CHECKOP(OP_ENTERTRY, enter);
-
o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
o->op_type = OP_LEAVETRY;
o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
if (o->op_flags & OPf_STACKED) {
OP* k;
o = ck_sort(o);
- kid = cLISTOPo->op_first->op_sibling;
- if (!cUNOPx(kid)->op_next)
- Perl_croak(aTHX_ "panic: ck_grep");
- for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
+ kid = cUNOPx(cLISTOPo->op_first->op_sibling)->op_first;
+ if (kid->op_type != OP_SCOPE && kid->op_type != OP_LEAVE)
+ return no_fh_allowed(o);
+ for (k = kid; k; k = k->op_next) {
kid = k;
}
NewOp(1101, gwop, 1, LOGOP);
return newop;
}
- return ck_fun(o);
+ return scalar(ck_fun(o));
}
OP *
/* caller is supposed to assign the return to the
container of the rep_op var */
-OP *
+STATIC OP *
S_opt_scalarhv(pTHX_ OP *rep_op) {
+ dVAR;
UNOP *unop;
PERL_ARGS_ASSERT_OPT_SCALARHV;
return (OP*)unop;
}
+/* Checks if o acts as an in-place operator on an array. oright points to the
+ * beginning of the right-hand side. Returns the left-hand side of the
+ * assignment if o acts in-place, or NULL otherwise. */
+
+STATIC OP *
+S_is_inplace_av(pTHX_ OP *o, OP *oright) {
+ OP *o2;
+ OP *oleft = NULL;
+
+ PERL_ARGS_ASSERT_IS_INPLACE_AV;
+
+ if (!oright ||
+ (oright->op_type != OP_RV2AV && oright->op_type != OP_PADAV)
+ || oright->op_next != o
+ || (oright->op_private & OPpLVAL_INTRO)
+ )
+ return NULL;
+
+ /* o2 follows the chain of op_nexts through the LHS of the
+ * assign (if any) to the aassign op itself */
+ o2 = o->op_next;
+ if (!o2 || o2->op_type != OP_NULL)
+ return NULL;
+ o2 = o2->op_next;
+ if (!o2 || o2->op_type != OP_PUSHMARK)
+ return NULL;
+ o2 = o2->op_next;
+ if (o2 && o2->op_type == OP_GV)
+ o2 = o2->op_next;
+ if (!o2
+ || (o2->op_type != OP_PADAV && o2->op_type != OP_RV2AV)
+ || (o2->op_private & OPpLVAL_INTRO)
+ )
+ return NULL;
+ oleft = o2;
+ o2 = o2->op_next;
+ if (!o2 || o2->op_type != OP_NULL)
+ return NULL;
+ o2 = o2->op_next;
+ if (!o2 || o2->op_type != OP_AASSIGN
+ || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID)
+ return NULL;
+
+ /* check that the sort is the first arg on RHS of assign */
+
+ o2 = cUNOPx(o2)->op_first;
+ if (!o2 || o2->op_type != OP_NULL)
+ return NULL;
+ o2 = cUNOPx(o2)->op_first;
+ if (!o2 || o2->op_type != OP_PUSHMARK)
+ return NULL;
+ if (o2->op_sibling != o)
+ return NULL;
+
+ /* check the array is the same on both sides */
+ if (oleft->op_type == OP_RV2AV) {
+ if (oright->op_type != OP_RV2AV
+ || !cUNOPx(oright)->op_first
+ || cUNOPx(oright)->op_first->op_type != OP_GV
+ || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
+ cGVOPx_gv(cUNOPx(oright)->op_first)
+ )
+ return NULL;
+ }
+ else if (oright->op_type != OP_PADAV
+ || oright->op_targ != oleft->op_targ
+ )
+ return NULL;
+
+ return oleft;
+}
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
){
OP * nop = o;
OP * lop = o;
- if (!(nop->op_flags && OPf_WANT_VOID)) {
+ if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) {
while (nop && nop->op_next) {
switch (nop->op_next->op_type) {
case OP_NOT:
}
}
}
- if (lop->op_flags && OPf_WANT_VOID) {
+ if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) {
if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV)
cLOGOP->op_first = opt_scalarhv(fop);
if (sop && (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV))
oright = cUNOPx(oright)->op_sibling;
}
- if (!oright ||
- (oright->op_type != OP_RV2AV && oright->op_type != OP_PADAV)
- || oright->op_next != o
- || (oright->op_private & OPpLVAL_INTRO)
- )
- break;
-
- /* o2 follows the chain of op_nexts through the LHS of the
- * assign (if any) to the aassign op itself */
- o2 = o->op_next;
- if (!o2 || o2->op_type != OP_NULL)
- break;
- o2 = o2->op_next;
- if (!o2 || o2->op_type != OP_PUSHMARK)
- break;
- o2 = o2->op_next;
- if (o2 && o2->op_type == OP_GV)
- o2 = o2->op_next;
- if (!o2
- || (o2->op_type != OP_PADAV && o2->op_type != OP_RV2AV)
- || (o2->op_private & OPpLVAL_INTRO)
- )
- break;
- oleft = o2;
- o2 = o2->op_next;
- if (!o2 || o2->op_type != OP_NULL)
- break;
- o2 = o2->op_next;
- if (!o2 || o2->op_type != OP_AASSIGN
- || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID)
- break;
-
- /* check that the sort is the first arg on RHS of assign */
-
- o2 = cUNOPx(o2)->op_first;
- if (!o2 || o2->op_type != OP_NULL)
- break;
- o2 = cUNOPx(o2)->op_first;
- if (!o2 || o2->op_type != OP_PUSHMARK)
- break;
- if (o2->op_sibling != o)
- break;
-
- /* check the array is the same on both sides */
- if (oleft->op_type == OP_RV2AV) {
- if (oright->op_type != OP_RV2AV
- || !cUNOPx(oright)->op_first
- || cUNOPx(oright)->op_first->op_type != OP_GV
- || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
- cGVOPx_gv(cUNOPx(oright)->op_first)
- )
- break;
- }
- else if (oright->op_type != OP_PADAV
- || oright->op_targ != oleft->op_targ
- )
+ oleft = is_inplace_av(o, oright);
+ if (!oleft)
break;
/* transfer MODishness etc from LHS arg to RHS arg */
case OP_REVERSE: {
OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av;
OP *gvop = NULL;
+ OP *oleft, *oright;
LISTOP *enter, *exlist;
+ /* @a = reverse @a */
+ if ((oright = cLISTOPo->op_first)
+ && (oright->op_type == OP_PUSHMARK)
+ && (oright = oright->op_sibling)
+ && (oleft = is_inplace_av(o, oright))) {
+ OP *o2;
+
+ /* transfer MODishness etc from LHS arg to RHS arg */
+ oright->op_flags = oleft->op_flags;
+ o->op_private |= OPpREVERSE_INPLACE;
+
+ /* excise push->gv->rv2av->null->aassign */
+ o2 = o->op_next->op_next;
+ op_null(o2); /* PUSHMARK */
+ o2 = o2->op_next;
+ if (o2->op_type == OP_GV) {
+ op_null(o2); /* GV */
+ o2 = o2->op_next;
+ }
+ op_null(o2); /* RV2AV or PADAV */
+ o2 = o2->op_next->op_next;
+ op_null(o2); /* AASSIGN */
+
+ o->op_next = o2->op_next;
+ break;
+ }
+
enter = (LISTOP *) o->op_next;
if (!enter)
break;
projects / p5sagit/p5-mst-13.2.git / blobdiff