X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=81df30e20793ad2373f3ad3ce6cb1128926f2355;hb=1a67a97c0300941ac67bfb1dd421467b8c59e21c;hp=25b17dc1e1a6906e9d5be3482c4cc1e418147d8d;hpb=eac055e92e0ec1f73bd09a2bf54dc6b090cbdb78;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 25b17dc..81df30e 100644 --- a/op.c +++ b/op.c @@ -142,7 +142,7 @@ Perl_pad_allocmy(pTHX_ char *name) (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) || name[1] == '_' && (int)strlen(name) > 2)) { - if (!isPRINT(name[1])) { + if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) { /* 1999-02-27 mjd@plover.com */ char *p; p = strchr(name, '\0'); @@ -192,7 +192,7 @@ Perl_pad_allocmy(pTHX_ char *name) PL_sv_objcount++; } av_store(PL_comppad_name, off, sv); - SvNVX(sv) = (double)PAD_MAX; + SvNVX(sv) = (NV)PAD_MAX; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ if (!PL_min_intro_pending) PL_min_intro_pending = off; @@ -255,7 +255,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, sv_upgrade(namesv, SVt_PVNV); sv_setpv(namesv, name); av_store(PL_comppad_name, newoff, namesv); - SvNVX(namesv) = (double)PL_curcop->cop_seq; + SvNVX(namesv) = (NV)PL_curcop->cop_seq; SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ if (SvOBJECT(sv)) { /* A typed var */ @@ -686,10 +686,7 @@ Perl_op_free(pTHX_ OP *o) break; case OP_NEXTSTATE: case OP_DBSTATE: - Safefree(cCOPo->cop_label); - SvREFCNT_dec(cCOPo->cop_filegv); - if (cCOPo->cop_warnings != WARN_NONE && cCOPo->cop_warnings != WARN_ALL) - SvREFCNT_dec(cCOPo->cop_warnings); + cop_free((COP*)o); break; case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); @@ -730,6 +727,15 @@ Perl_op_free(pTHX_ OP *o) } STATIC void +S_cop_free(pTHX_ COP* cop) +{ + Safefree(cop->cop_label); + SvREFCNT_dec(cop->cop_filegv); + if (cop->cop_warnings != WARN_NONE && cop->cop_warnings != WARN_ALL) + SvREFCNT_dec(cop->cop_warnings); +} + +STATIC void S_null(pTHX_ OP *o) { if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0) @@ -805,6 +811,10 @@ Perl_scalar(pTHX_ OP *o) || o->op_type == OP_RETURN) return o; + if ((o->op_private & OPpTARGET_MY) + && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + return scalar(o); /* As if inside SASSIGN */ + o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR; switch (o->op_type) { @@ -884,6 +894,10 @@ Perl_scalarvoid(pTHX_ OP *o) || o->op_type == OP_RETURN) return o; + if ((o->op_private & OPpTARGET_MY) + && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + return scalar(o); /* As if inside SASSIGN */ + o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID; switch (o->op_type) { @@ -1083,6 +1097,10 @@ Perl_list(pTHX_ OP *o) || o->op_type == OP_RETURN) return o; + if ((o->op_private & OPpTARGET_MY) + && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + return o; /* As if inside SASSIGN */ + o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST; switch (o->op_type) { @@ -1190,6 +1208,10 @@ Perl_mod(pTHX_ OP *o, I32 type) if (!o || PL_error_count) return o; + if ((o->op_private & OPpTARGET_MY) + && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + return o; + switch (o->op_type) { case OP_UNDEF: PL_modcount++; @@ -1662,7 +1684,7 @@ Perl_scope(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_SCOPE]; kid = ((LISTOP*)o)->op_first; if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){ - SvREFCNT_dec(((COP*)kid)->cop_filegv); + cop_free((COP*)kid); null(kid); } } @@ -1830,7 +1852,7 @@ Perl_fold_constants(pTHX_ register OP *o) if (PL_opargs[type] & OA_RETSCALAR) scalar(o); - if (PL_opargs[type] & OA_TARGET) + if (PL_opargs[type] & OA_TARGET && !o->op_targ) o->op_targ = pad_alloc(type, SVs_PADTMP); /* integerize op, unless it happens to be C<-foo>. @@ -1899,7 +1921,7 @@ Perl_fold_constants(pTHX_ register OP *o) type != OP_NEGATE) { IV iv = SvIV(sv); - if ((double)iv == SvNV(sv)) { + if ((NV)iv == SvNV(sv)) { SvREFCNT_dec(sv); sv = newSViv(iv); } @@ -2191,7 +2213,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) } binop = (BINOP*)CHECKOP(type, binop); - if (binop->op_next) + if (binop->op_next || binop->op_type != type) return (OP*)binop; binop->op_last = binop->op_first->op_sibling; @@ -2849,8 +2871,8 @@ S_list_assignment(pTHX_ register OP *o) o = cUNOPo->op_first; if (o->op_type == OP_COND_EXPR) { - I32 t = list_assignment(cCONDOPo->op_first->op_sibling); - I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling); + I32 t = list_assignment(cLOGOPo->op_first->op_sibling); + I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling); if (t && f) return TRUE; @@ -3083,7 +3105,7 @@ Perl_intro_my(pTHX) for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) { if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) { SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */ - SvNVX(sv) = (double)PL_cop_seqmax; + SvNVX(sv) = (NV)PL_cop_seqmax; } } PL_min_intro_pending = 0; @@ -3208,7 +3230,8 @@ OP * Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) { dTHR; - CONDOP *condop; + LOGOP *logop; + OP *start; OP *o; if (!falseop) @@ -3233,27 +3256,27 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) list(trueop); scalar(falseop); } - NewOp(1101, condop, 1, CONDOP); + NewOp(1101, logop, 1, LOGOP); + logop->op_type = OP_COND_EXPR; + logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR]; + logop->op_first = first; + logop->op_flags = flags | OPf_KIDS; + logop->op_private = 1 | (flags >> 8); + logop->op_other = LINKLIST(trueop); + logop->op_next = LINKLIST(falseop); - condop->op_type = OP_COND_EXPR; - condop->op_ppaddr = PL_ppaddr[OP_COND_EXPR]; - condop->op_first = first; - condop->op_flags = flags | OPf_KIDS; - condop->op_true = LINKLIST(trueop); - condop->op_false = LINKLIST(falseop); - condop->op_private = 1 | (flags >> 8); /* establish postfix order */ - condop->op_next = LINKLIST(first); - first->op_next = (OP*)condop; + start = LINKLIST(first); + first->op_next = (OP*)logop; first->op_sibling = trueop; trueop->op_sibling = falseop; - o = newUNOP(OP_NULL, 0, (OP*)condop); + o = newUNOP(OP_NULL, 0, (OP*)logop); - trueop->op_next = o; - falseop->op_next = o; + trueop->op_next = falseop->op_next = o; + o->op_next = start; return o; } @@ -3261,34 +3284,36 @@ OP * Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) { dTHR; - CONDOP *condop; + LOGOP *range; OP *flip; OP *flop; + OP *leftstart; OP *o; - NewOp(1101, condop, 1, CONDOP); + NewOp(1101, range, 1, LOGOP); - condop->op_type = OP_RANGE; - condop->op_ppaddr = PL_ppaddr[OP_RANGE]; - condop->op_first = left; - condop->op_flags = OPf_KIDS; - condop->op_true = LINKLIST(left); - condop->op_false = LINKLIST(right); - condop->op_private = 1 | (flags >> 8); + range->op_type = OP_RANGE; + range->op_ppaddr = PL_ppaddr[OP_RANGE]; + range->op_first = left; + range->op_flags = OPf_KIDS; + leftstart = LINKLIST(left); + range->op_other = LINKLIST(right); + range->op_private = 1 | (flags >> 8); left->op_sibling = right; - condop->op_next = (OP*)condop; - flip = newUNOP(OP_FLIP, flags, (OP*)condop); + range->op_next = (OP*)range; + flip = newUNOP(OP_FLIP, flags, (OP*)range); flop = newUNOP(OP_FLOP, 0, flip); o = newUNOP(OP_NULL, 0, flop); linklist(flop); + range->op_next = leftstart; left->op_next = flip; right->op_next = flop; - condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); - sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV); + range->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); + sv_upgrade(PAD_SV(range->op_targ), SVt_PVNV); flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV); @@ -3498,7 +3523,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo * treated as min/max values by 'pp_iterinit'. */ UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; - CONDOP* range = (CONDOP*) flip->op_first; + LOGOP* range = (LOGOP*) flip->op_first; OP* left = range->op_first; OP* right = left->op_sibling; LISTOP* listop; @@ -3507,8 +3532,8 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo range->op_first = Nullop; listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right); - listop->op_first->op_next = range->op_true; - left->op_next = range->op_false; + listop->op_first->op_next = range->op_next; + left->op_next = range->op_other; right->op_next = (OP*)listop; listop->op_next = listop->op_first; @@ -5084,6 +5109,38 @@ Perl_ck_fun_locale(pTHX_ OP *o) } OP * +Perl_ck_sassign(pTHX_ OP *o) +{ + OP *kid = cLISTOPo->op_first; + /* has a disposable target? */ + if ((PL_opargs[kid->op_type] & OA_TARGLEX) + && !(kid->op_flags & OPf_STACKED)) + { + OP *kkid = kid->op_sibling; + + /* Can just relocate the target. */ + if (kkid && kkid->op_type == OP_PADSV) { + /* Concat has problems if target is equal to right arg. */ + if (kid->op_type == OP_CONCAT + && kLISTOP->op_first->op_sibling->op_type == OP_PADSV + && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ) + { + return o; + } + kid->op_targ = kkid->op_targ; + /* Now we do not need PADSV and SASSIGN. */ + kid->op_sibling = o->op_sibling; /* NULL */ + cLISTOPo->op_first = NULL; + op_free(o); + op_free(kkid); + kid->op_private |= OPpTARGET_MY; /* Used for context settings */ + return kid; + } + } + return o; +} + +OP * Perl_ck_scmp(pTHX_ OP *o) { o->op_private = 0; @@ -5592,8 +5649,24 @@ Perl_peep(pTHX_ register OP *o) case OP_LC: case OP_LCFIRST: case OP_QUOTEMETA: - if (o->op_next && o->op_next->op_type == OP_STRINGIFY) + if (o->op_next && o->op_next->op_type == OP_STRINGIFY) { + if (o->op_next->op_private & OPpTARGET_MY) { + if ((o->op_type == OP_CONST) /* no target */ + || (o->op_flags & OPf_STACKED) /* chained concats */ + || (o->op_type == OP_CONCAT + /* Concat has problems if target is equal to right arg. */ + && (((LISTOP*)o)->op_first->op_sibling->op_type + == OP_PADSV) + && (((LISTOP*)o)->op_first->op_sibling->op_targ + == o->op_next->op_targ))) { + goto ignore_optimization; + } else { + o->op_targ = o->op_next->op_targ; + } + } null(o->op_next); + } + ignore_optimization: o->op_seq = PL_op_seqmax++; break; case OP_STUB: @@ -5658,18 +5731,14 @@ Perl_peep(pTHX_ register OP *o) case OP_GREPWHILE: case OP_AND: case OP_OR: + case OP_COND_EXPR: + case OP_RANGE: o->op_seq = PL_op_seqmax++; while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; peep(cLOGOP->op_other); break; - case OP_COND_EXPR: - o->op_seq = PL_op_seqmax++; - peep(cCONDOP->op_true); - peep(cCONDOP->op_false); - break; - case OP_ENTERLOOP: o->op_seq = PL_op_seqmax++; peep(cLOOP->op_redoop);