/* op.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
register OP *kid, *nextkid;
OPCODE type;
- if (!o || o->op_seq == (U16)-1)
+ if (!o || o->op_static)
return;
if (o->op_private & OPpREFCOUNTED) {
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
+ if (! (o->op_type == OP_AELEMFAST && o->op_flags & OPf_SPECIAL)) {
+ /* not an OP_PADAV replacement */
#ifdef USE_ITHREADS
- if (cPADOPo->op_padix > 0) {
- /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
- * may still exist on the pad */
- pad_swipe(cPADOPo->op_padix, TRUE);
- cPADOPo->op_padix = 0;
- }
+ if (cPADOPo->op_padix > 0) {
+ /* No GvIN_PAD_off(cGVOPo_gv) here, because other references
+ * may still exist on the pad */
+ pad_swipe(cPADOPo->op_padix, TRUE);
+ cPADOPo->op_padix = 0;
+ }
#else
- SvREFCNT_dec(cSVOPo->op_sv);
- cSVOPo->op_sv = Nullsv;
+ SvREFCNT_dec(cSVOPo->op_sv);
+ cSVOPo->op_sv = Nullsv;
#endif
+ }
break;
case OP_METHOD_NAMED:
case OP_CONST:
#ifdef USE_ITHREADS
/** Bug #15654
Even if op_clear does a pad_free for the target of the op,
- pad_free doesn't actually remove the sv that exists in the bad
+ pad_free doesn't actually remove the sv that exists in the pad;
instead it lives on. This results in that it could be reused as
a target later on when the pad was reallocated.
**/
else {
if (ckWARN(WARN_VOID)) {
useless = "a constant";
+ /* don't warn on optimised away booleans, eg
+ * use constant Foo, 5; Foo || print; */
+ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
+ useless = 0;
/* the constants 0 and 1 are permitted as they are
conventionally used as dummies in constructs like
1 while some_condition_with_side_effects; */
- if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+ else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
useless = 0;
else if (SvPOK(sv)) {
/* perl4's way of mixing documentation and code
break;
case OP_AELEMFAST:
- localize = 1;
+ localize = -1;
PL_modcount++;
break;
Perl_block_start(pTHX_ int full)
{
int retval = PL_savestack_ix;
- /* If there were syntax errors, don't try to start a block */
- if (PL_yynerrs) return retval;
-
pad_block_start(full);
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
{
int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
- /* If there were syntax errors, don't try to close a block */
- if (PL_yynerrs) return retval;
LEAVE_SCOPE(floor);
PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
if (needblockscope)
o->op_ppaddr = PL_ppaddr[OP_RV2AV];
o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */
o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
- o->op_seq = 0; /* needs to be revisited in peep() */
+ o->op_opt = 0; /* needs to be revisited in peep() */
curop = ((UNOP*)o)->op_first;
((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
op_free(curop);
op_free(right);
return Nullop;
}
+ /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
+ if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
+ && right->op_type == OP_STUB
+ && (left->op_private & OPpLVAL_INTRO))
+ {
+ op_free(right);
+ return left;
+ }
curop = list(force_list(left));
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = (U8)(0 | (flags >> 8));
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
*firstp = Nullop;
+ other->op_private |= OPpCONST_SHORTCIRCUIT;
return other;
}
else {
+ /* check for C<my $x if 0>, or C<my($x,$y) if 0> */
+ OP *o2 = other;
+ if ( ! (o2->op_type == OP_LIST
+ && (( o2 = cUNOPx(o2)->op_first))
+ && o2->op_type == OP_PUSHMARK
+ && (( o2 = o2->op_sibling)) )
+ )
+ o2 = other;
+ if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
+ || o2->op_type == OP_PADHV)
+ && o2->op_private & OPpLVAL_INTRO
+ && ckWARN(WARN_DEPRECATED))
+ {
+ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ "Deprecated use of my() in false conditional");
+ }
+
op_free(other);
*otherp = Nullop;
+ first->op_private |= OPpCONST_SHORTCIRCUIT;
return first;
}
}
}
}
+ /* if block is null, the next append_elem() would put UNSTACK, a scalar
+ * op, in listop. This is wrong. [perl #27024] */
+ if (!block)
+ block = newOP(OP_NULL, 0);
listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
o = new_logop(OP_AND, 0, &expr, &listop);
}
else {
padoff = offset;
- iterpflags = OPpLVAL_INTRO; /* my $_; for () */
}
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
if (SvPOK(cv))
Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
+ else
+ Perl_sv_catpvf(aTHX_ msg, ": none");
sv_catpv(msg, " vs ");
if (p)
Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
OP_IS_FILETEST_ACCESS(o))
o->op_private |= OPpFT_ACCESS;
}
+ if (PL_check[kid->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst)
+ && kid->op_type != OP_STAT && kid->op_type != OP_LSTAT)
+ o->op_private |= OPpFT_STACKED;
}
else {
op_free(o);
return kid;
}
}
+ /* optimise C<my $x = undef> to C<my $x> */
+ if (kid->op_type == OP_UNDEF) {
+ OP *kkid = kid->op_sibling;
+ if (kkid && kkid->op_type == OP_PADSV
+ && (kkid->op_private & OPpLVAL_INTRO))
+ {
+ cLISTOPo->op_first = NULL;
+ kid->op_sibling = NULL;
+ op_free(o);
+ op_free(kid);
+ return kkid;
+ }
+ }
return o;
}
{
register OP* oldop = 0;
- if (!o || o->op_seq)
+ if (!o || o->op_opt)
return;
ENTER;
SAVEOP();
SAVEVPTR(PL_curcop);
for (; o; o = o->op_next) {
- if (o->op_seq)
+ if (o->op_opt)
break;
- /* The special value -1 is used by the B::C compiler backend to indicate
- * that an op is statically defined and should not be freed */
- if (!PL_op_seqmax || PL_op_seqmax == (U16)-1)
- PL_op_seqmax = 1;
PL_op = o;
switch (o->op_type) {
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
PL_curcop = ((COP*)o); /* for warnings */
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_CONST:
o->op_targ = ix;
}
#endif
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_CONCAT:
op_null(o->op_next);
}
ignore_optimization:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break; /* Scalar stub must produce undef. List stub is noop */
}
goto nothin;
to peep() from mistakenly concluding that optimisation
has already occurred. This doesn't fix the real problem,
though (See 20010220.007). AMS 20010719 */
+ /* op_seq functionality is now replaced by op_opt */
if (oldop && o->op_next) {
oldop->op_next = o->op_next;
continue;
oldop->op_next = o->op_next;
continue;
}
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
+ case OP_PADAV:
case OP_GV:
- if (o->op_next->op_type == OP_RV2SV) {
- if (!(o->op_next->op_private & OPpDEREF)) {
- op_null(o->op_next);
- o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
- | OPpOUR_INTRO);
- o->op_next = o->op_next->op_next;
- o->op_type = OP_GVSV;
- o->op_ppaddr = PL_ppaddr[OP_GVSV];
- }
- }
- else if (o->op_next->op_type == OP_RV2AV) {
- OP* pop = o->op_next->op_next;
+ if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) {
+ OP* pop = (o->op_type == OP_PADAV) ?
+ o->op_next : o->op_next->op_next;
IV i;
if (pop && pop->op_type == OP_CONST &&
- (PL_op = pop->op_next) &&
+ ((PL_op = pop->op_next)) &&
pop->op_next->op_type == OP_AELEM &&
!(pop->op_next->op_private &
(OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
i >= 0)
{
GV *gv;
- op_null(o->op_next);
+ if (cSVOPx(pop)->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(pop);
+ if (o->op_type == OP_GV)
+ op_null(o->op_next);
op_null(pop->op_next);
op_null(pop);
o->op_flags |= pop->op_next->op_flags & OPf_MOD;
o->op_next = pop->op_next->op_next;
- o->op_type = OP_AELEMFAST;
o->op_ppaddr = PL_ppaddr[OP_AELEMFAST];
o->op_private = (U8)i;
- gv = cGVOPo_gv;
- GvAVn(gv);
+ if (o->op_type == OP_GV) {
+ gv = cGVOPo_gv;
+ GvAVn(gv);
+ }
+ else
+ o->op_flags |= OPf_SPECIAL;
+ o->op_type = OP_AELEMFAST;
+ }
+ o->op_opt = 1;
+ break;
+ }
+
+ if (o->op_next->op_type == OP_RV2SV) {
+ if (!(o->op_next->op_private & OPpDEREF)) {
+ op_null(o->op_next);
+ o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
+ | OPpOUR_INTRO);
+ o->op_next = o->op_next->op_next;
+ o->op_type = OP_GVSV;
+ o->op_ppaddr = PL_ppaddr[OP_GVSV];
}
}
else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_PROTOTYPE)) {
op_null(o->op_next);
}
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_MAPWHILE:
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
case OP_ENTERLOOP:
case OP_ENTERITER:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
peep(cLOOP->op_redoop);
case OP_QR:
case OP_MATCH:
case OP_SUBST:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cPMOP->op_pmreplstart &&
cPMOP->op_pmreplstart->op_type == OP_NULL)
cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
break;
case OP_EXEC:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
if (ckWARN(WARN_SYNTAX) && o->op_next
&& o->op_next->op_type == OP_NEXTSTATE) {
if (o->op_next->op_sibling &&
char *key = NULL;
STRLEN keylen;
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
if (((BINOP*)o)->op_last->op_type != OP_CONST)
break;
break;
}
+ case OP_SORT: {
+ /* make @a = sort @a act in-place */
+
+ /* will point to RV2AV or PADAV op on LHS/RHS of assign */
+ OP *oleft, *oright;
+ OP *o2;
+
+ o->op_opt = 1;
+
+ /* check that RHS of sort is a single plain array */
+ oright = cUNOPo->op_first;
+ if (!oright || oright->op_type != OP_PUSHMARK)
+ break;
+ oright = cUNOPx(oright)->op_sibling;
+ if (!oright)
+ break;
+ if (oright->op_type == OP_NULL) { /* skip sort block/sub */
+ 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 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
+ )
+ break;
+
+ /* transfer MODishness etc from LHS arg to RHS arg */
+ oright->op_flags = oleft->op_flags;
+ o->op_private |= OPpSORT_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;
+ }
+
+
+
default:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
}
oldop = o;
https://perl5.git.perl.org / perl5.git / blobdiff