checkgv:
if (cUNOPo->op_first->op_type != OP_GV) goto badref;
o->op_flags |= OPf_STACKED;
+ break;
+ case OP_PADHV:
+ if (o->op_flags & OPf_PARENS) goto parenhash;
+ o->op_private |= OPpLVREF_HV;
/* FALLTHROUGH */
case OP_PADSV:
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
break;
case OP_PADAV:
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
if (o->op_flags & OPf_PARENS) goto slurpy;
o->op_private |= OPpLVREF_AV;
break;
- case OP_PADHV:
- if (o->op_flags & OPf_PARENS) goto parenhash;
- o->op_private |= OPpLVREF_HV;
- break;
case OP_AELEM:
case OP_HELEM:
o->op_private |= OPpLVREF_ELEM;
/*
Helper function for newASSIGNOP to detection commonality between the
- lhs and the rhs. Marks all variables with PL_generation. If it
+ lhs and the rhs. (It is actually called very indirectly. newASSIGNOP
+ flags the op and the peephole optimizer calls this helper function
+ if the flag is set.) Marks all variables with PL_generation. If it
returns TRUE the assignment must be able to handle common variables.
+
+ PL_generation sorcery:
+ An assignment like ($a,$b) = ($c,$d) is easier than
+ ($a,$b) = ($c,$a), since there is no need for temporary vars.
+ To detect whether there are common vars, the global var
+ PL_generation is incremented for each assign op we compile.
+ Then, while compiling the assign op, we run through all the
+ variables on both sides of the assignment, setting a spare slot
+ in each of them to PL_generation. If any of them already have
+ that value, we know we've got commonality. Also, if the
+ generation number is already set to PERL_INT_MAX, then
+ the variable is involved in aliasing, so we also have
+ potential commonality in that case. We could use a
+ single bit marker, but then we'd have to make 2 passes, first
+ to clear the flag, then to test and set it. And that
+ wouldn't help with aliasing, either. To find somewhere
+ to store these values, evil chicanery is done with SvUVX().
*/
PERL_STATIC_INLINE bool
S_aassign_common_vars(pTHX_ OP* o)
OP *curop;
for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
- if (curop->op_type == OP_GV) {
+ if (curop->op_type == OP_GV || curop->op_type == OP_GVSV) {
GV *gv = cGVOPx_gv(curop);
if (gv == PL_defgv
|| (int)GvASSIGN_GENERATION(gv) == PL_generation)
curop->op_type == OP_PADANY)
{
if (PAD_COMPNAME_GEN(curop->op_targ)
- == (STRLEN)PL_generation)
+ == (STRLEN)PL_generation
+ || PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
return TRUE;
PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
GvASSIGN_GENERATION_set(gv, PL_generation);
}
}
+ else if (curop->op_type == OP_PADRANGE)
+ /* Ignore padrange; checking its siblings is sufficient. */
+ continue;
else
return TRUE;
}
return FALSE;
}
+/* This variant only handles lexical aliases. It is called when
+ newASSIGNOP decides that we don’t have any common vars, as lexical ali-
+ ases trump that decision. */
+PERL_STATIC_INLINE bool
+S_aassign_common_vars_aliases_only(pTHX_ OP *o)
+{
+ OP *curop;
+ for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
+ if ((curop->op_type == OP_PADSV ||
+ curop->op_type == OP_PADAV ||
+ curop->op_type == OP_PADHV ||
+ curop->op_type == OP_PADANY)
+ && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
+ return TRUE;
+
+ if (curop->op_flags & OPf_KIDS) {
+ if (S_aassign_common_vars_aliases_only(aTHX_ curop))
+ return TRUE;
+ }
+ }
+ return FALSE;
+}
+
/*
=for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right
}
}
- /* PL_generation sorcery:
- * an assignment like ($a,$b) = ($c,$d) is easier than
- * ($a,$b) = ($c,$a), since there is no need for temporary vars.
- * To detect whether there are common vars, the global var
- * PL_generation is incremented for each assign op we compile.
- * Then, while compiling the assign op, we run through all the
- * variables on both sides of the assignment, setting a spare slot
- * in each of them to PL_generation. If any of them already have
- * that value, we know we've got commonality. We could use a
- * single bit marker, but then we'd have to make 2 passes, first
- * to clear the flag, then to test and set it. To find somewhere
- * to store these values, evil chicanery is done with SvUVX().
- */
-
if (maybe_common_vars) {
- PL_generation++;
- if (aassign_common_vars(o))
+ /* The peephole optimizer will do the full check and pos-
+ sibly turn this off. */
o->op_private |= OPpASSIGN_COMMON;
- LINKLIST(o);
}
if (right && right->op_type == OP_SPLIT) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
PMOP * const pm = (PMOP*)tmpop;
- if (left->op_type == OP_RV2AV &&
- !(left->op_private & OPpLVAL_INTRO) &&
- !(o->op_private & OPpASSIGN_COMMON) )
- {
- tmpop = ((UNOP*)left)->op_first;
- if (tmpop->op_type == OP_GV
+ if (
#ifdef USE_ITHREADS
- && !pm->op_pmreplrootu.op_pmtargetoff
+ !pm->op_pmreplrootu.op_pmtargetoff
#else
- && !pm->op_pmreplrootu.op_pmtargetgv
+ !pm->op_pmreplrootu.op_pmtargetgv
#endif
+ ) {
+ if (left->op_type == OP_RV2AV &&
+ !(left->op_private & OPpLVAL_INTRO) &&
+ (tmpop = ((UNOP*)left)->op_first)->op_type == OP_GV
) {
#ifdef USE_ITHREADS
pm->op_pmreplrootu.op_pmtargetoff
/* detach rest of siblings from o subtree,
* and free subtree */
op_sibling_splice(cUNOPo->op_first, tmpop, -1, NULL);
- right->op_next = tmpop->op_next; /* fix starting loc */
right->op_private |=
left->op_private & OPpOUR_INTRO;
op_free(o); /* blow off assign */
/* "I don't know and I don't care." */
return right;
}
- }
- else {
- if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
- ((LISTOP*)right)->op_last->op_type == OP_CONST)
+ else if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
+ ((LISTOP*)right)->op_last->op_type == OP_CONST)
{
SV ** const svp =
&((SVOP*)((LISTOP*)right)->op_last)->op_sv;
sv->op_targ = 0;
op_free(sv);
sv = NULL;
+ PAD_COMPNAME_GEN_set(padoff, PERL_INT_MAX);
}
else if (sv->op_type == OP_NULL && sv->op_targ == OP_SREFGEN)
NOOP;
settarg:
o->op_targ = varop->op_targ;
varop->op_targ = 0;
+ PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
break;
case OP_RV2AV:
o->op_private = OPpLVREF_AV;
}
break;
+ case OP_AASSIGN:
+ /* We do the common-vars check here, rather than in newASSIGNOP
+ (as formerly), so that all lexical vars that get aliased are
+ marked as such before we do the check. */
+ if (o->op_private & OPpASSIGN_COMMON) {
+ /* See the comment before S_aassign_common_vars concerning
+ PL_generation sorcery. */
+ PL_generation++;
+ if (!aassign_common_vars(o))
+ o->op_private &=~ OPpASSIGN_COMMON;
+ }
+ else if (S_aassign_common_vars_aliases_only(aTHX_ o))
+ o->op_private |= OPpASSIGN_COMMON;
+ break;
+
case OP_CUSTOM: {
Perl_cpeep_t cpeep =
XopENTRYCUSTOM(o, xop_peep);
https://perl5.git.perl.org / perl5.git / blobdiff