X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=2a10ab056dcca3b111f0c83097b38f4808a14af8;hb=aec46f14fac1bc74bf8ad4054a6f9674b324f8d2;hp=79c38f08057fa91ad2f9b43e5496fe0b0d3492e2;hpb=f2a7f2982c10dbcfc2084d281af6ad8b959d5fb9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 79c38f0..2a10ab0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -78,9 +78,7 @@ PP(pp_regcomp) { dSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; - register char *t; SV *tmpstr; - STRLEN len; MAGIC *mg = Null(MAGIC*); /* prevent recompiling under /o and ithreads. */ @@ -129,7 +127,8 @@ PP(pp_regcomp) PM_SETRE(pm, ReREFCNT_inc(re)); } else { - t = SvPV(tmpstr, len); + STRLEN len; + const char *t = SvPV_const(tmpstr, len); /* Check against the last compiled regexp. */ if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp || @@ -151,7 +150,7 @@ PP(pp_regcomp) if (pm->op_pmdynflags & PMdf_UTF8) t = (char*)bytes_to_utf8((U8*)t, &len); } - PM_SETRE(pm, CALLREGCOMP(aTHX_ t, t + len, pm)); + PM_SETRE(pm, CALLREGCOMP(aTHX_ (char *)t, (char *)t + len, pm)); if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8)) Safefree(t); PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed @@ -189,13 +188,13 @@ PP(pp_regcomp) PP(pp_substcont) { dSP; - register PMOP *pm = (PMOP*) cLOGOP->op_other; register PERL_CONTEXT *cx = &cxstack[cxstack_ix]; - register SV *dstr = cx->sb_dstr; + register PMOP * const pm = (PMOP*) cLOGOP->op_other; + register SV * const dstr = cx->sb_dstr; register char *s = cx->sb_s; register char *m = cx->sb_m; char *orig = cx->sb_orig; - register REGEXP *rx = cx->sb_rx; + register REGEXP * const rx = cx->sb_rx; SV *nsv = Nullsv; REGEXP *old = PM_GETRE(pm); if(old != rx) { @@ -205,10 +204,10 @@ PP(pp_substcont) } rxres_restore(&cx->sb_rxres, rx); - RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ)); + RX_MATCH_UTF8_set(rx, DO_UTF8(cx->sb_targ)); if (cx->sb_iters++) { - I32 saviters = cx->sb_iters; + const I32 saviters = cx->sb_iters; if (cx->sb_iters > cx->sb_maxiters) DIE(aTHX_ "Substitution loop"); @@ -234,15 +233,13 @@ PP(pp_substcont) } cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE if (SvIsCOW(targ)) { sv_force_normal_flags(targ, SV_COW_DROP_PV); } else #endif { - SvOOK_off(targ); - if (SvLEN(targ)) - Safefree(SvPVX(targ)); + SvPV_free(targ); } SvPV_set(targ, SvPVX(dstr)); SvCUR_set(targ, SvCUR(dstr)); @@ -287,7 +284,7 @@ PP(pp_substcont) MAGIC *mg; I32 i; if (SvTYPE(sv) < SVt_PVMG) - (void)SvUPGRADE(sv, SVt_PVMG); + SvUPGRADE(sv, SVt_PVMG); if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) { sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0); mg = mg_find(sv, PERL_MAGIC_regex_global); @@ -298,7 +295,7 @@ PP(pp_substcont) mg->mg_len = i; } if (old != rx) - ReREFCNT_inc(rx); + (void)ReREFCNT_inc(rx); cx->sb_rxtainted |= RX_MATCH_TAINTED(rx); rxres_save(&cx->sb_rxres, rx); RETURNOP(pm->op_pmreplstart); @@ -311,13 +308,13 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) U32 i; if (!p || p[1] < rx->nparens) { -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE i = 7 + rx->nparens * 2; #else i = 6 + rx->nparens * 2; #endif if (!p) - New(501, p, i, UV); + Newx(p, i, UV); else Renew(p, i, UV); *rsp = (void*)p; @@ -326,7 +323,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch); RX_MATCH_COPIED_off(rx); -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE *p++ = PTR2UV(rx->saved_copy); rx->saved_copy = Nullsv; #endif @@ -351,7 +348,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx) RX_MATCH_COPIED_set(rx, *p); *p++ = 0; -#ifdef PERL_COPY_ON_WRITE +#ifdef PERL_OLD_COPY_ON_WRITE if (rx->saved_copy) SvREFCNT_dec (rx->saved_copy); rx->saved_copy = INT2PTR(SV*,*p); @@ -374,8 +371,15 @@ Perl_rxres_free(pTHX_ void **rsp) UV *p = (UV*)*rsp; if (p) { +#ifdef PERL_POISON + void *tmp = INT2PTR(char*,*p); + Safefree(tmp); + if (*p) + Poison(*p, 1, sizeof(*p)); +#else Safefree(INT2PTR(char*,*p)); -#ifdef PERL_COPY_ON_WRITE +#endif +#ifdef PERL_OLD_COPY_ON_WRITE if (p[1]) { SvREFCNT_dec (INT2PTR(SV*,p[1])); } @@ -391,17 +395,15 @@ PP(pp_formline) register SV *tmpForm = *++MARK; register U32 *fpc; register char *t; - register char *f; - register char *s; - register char *send; + const char *f; register I32 arg; register SV *sv = Nullsv; - char *item = Nullch; + const char *item = Nullch; I32 itemsize = 0; I32 fieldsize = 0; I32 lines = 0; bool chopspace = (strchr(PL_chopset, ' ') != Nullch); - char *chophere = Nullch; + const char *chophere = Nullch; char *linemark = Nullch; NV value; bool gotsome = FALSE; @@ -431,11 +433,9 @@ PP(pp_formline) targ_is_utf8 = TRUE; t = SvGROW(PL_formtarget, len + fudge + 1); /* XXX SvCUR bad */ t += len; - f = SvPV(tmpForm, len); + f = SvPV_const(tmpForm, len); /* need to jump to the next word */ - s = f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN; - - fpc = (U32*)s; + fpc = (U32*)(f + len + WORD_ALIGN - SvCUR(tmpForm) % WORD_ALIGN); for (;;) { DEBUG_f( { @@ -477,14 +477,14 @@ PP(pp_formline) case FF_LITERAL: arg = *fpc++; if (targ_is_utf8 && !SvUTF8(tmpForm)) { - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); *t = '\0'; sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv); t = SvEND(PL_formtarget); break; } if (!targ_is_utf8 && DO_UTF8(tmpForm)) { - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); *t = '\0'; sv_utf8_upgrade(PL_formtarget); SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); @@ -514,127 +514,134 @@ PP(pp_formline) break; case FF_CHECKNL: - item = s = SvPV(sv, len); - itemsize = len; - if (DO_UTF8(sv)) { - itemsize = sv_len_utf8(sv); - if (itemsize != (I32)len) { - I32 itembytes; - if (itemsize > fieldsize) { - itemsize = fieldsize; - itembytes = itemsize; - sv_pos_u2b(sv, &itembytes, 0); - } - else - itembytes = len; - send = chophere = s + itembytes; - while (s < send) { - if (*s & ~31) - gotsome = TRUE; - else if (*s == '\n') - break; - s++; + { + const char *send; + const char *s = item = SvPV_const(sv, len); + itemsize = len; + if (DO_UTF8(sv)) { + itemsize = sv_len_utf8(sv); + if (itemsize != (I32)len) { + I32 itembytes; + if (itemsize > fieldsize) { + itemsize = fieldsize; + itembytes = itemsize; + sv_pos_u2b(sv, &itembytes, 0); + } + else + itembytes = len; + send = chophere = s + itembytes; + while (s < send) { + if (*s & ~31) + gotsome = TRUE; + else if (*s == '\n') + break; + s++; + } + item_is_utf8 = TRUE; + itemsize = s - item; + sv_pos_b2u(sv, &itemsize); + break; } - item_is_utf8 = TRUE; - itemsize = s - item; - sv_pos_b2u(sv, &itemsize); - break; } + item_is_utf8 = FALSE; + if (itemsize > fieldsize) + itemsize = fieldsize; + send = chophere = s + itemsize; + while (s < send) { + if (*s & ~31) + gotsome = TRUE; + else if (*s == '\n') + break; + s++; + } + itemsize = s - item; + break; } - item_is_utf8 = FALSE; - if (itemsize > fieldsize) - itemsize = fieldsize; - send = chophere = s + itemsize; - while (s < send) { - if (*s & ~31) - gotsome = TRUE; - else if (*s == '\n') - break; - s++; - } - itemsize = s - item; - break; case FF_CHECKCHOP: - item = s = SvPV(sv, len); - itemsize = len; - if (DO_UTF8(sv)) { - itemsize = sv_len_utf8(sv); - if (itemsize != (I32)len) { - I32 itembytes; - if (itemsize <= fieldsize) { - send = chophere = s + itemsize; - while (s < send) { - if (*s == '\r') { - itemsize = s - item; - chophere = s; - break; - } - if (*s++ & ~31) - gotsome = TRUE; - } - } - else { - itemsize = fieldsize; - itembytes = itemsize; - sv_pos_u2b(sv, &itembytes, 0); - send = chophere = s + itembytes; - while (s < send || (s == send && isSPACE(*s))) { - if (isSPACE(*s)) { - if (chopspace) + { + const char *s = item = SvPV_const(sv, len); + itemsize = len; + if (DO_UTF8(sv)) { + itemsize = sv_len_utf8(sv); + if (itemsize != (I32)len) { + I32 itembytes; + if (itemsize <= fieldsize) { + const char *send = chophere = s + itemsize; + while (s < send) { + if (*s == '\r') { + itemsize = s - item; chophere = s; - if (*s == '\r') break; - } - else { - if (*s & ~31) + } + if (*s++ & ~31) gotsome = TRUE; - if (strchr(PL_chopset, *s)) - chophere = s + 1; } - s++; } - itemsize = chophere - item; - sv_pos_b2u(sv, &itemsize); - } - item_is_utf8 = TRUE; - break; - } - } - item_is_utf8 = FALSE; - if (itemsize <= fieldsize) { - send = chophere = s + itemsize; - while (s < send) { - if (*s == '\r') { - itemsize = s - item; - chophere = s; + else { + const char *send; + itemsize = fieldsize; + itembytes = itemsize; + sv_pos_u2b(sv, &itembytes, 0); + send = chophere = s + itembytes; + while (s < send || (s == send && isSPACE(*s))) { + if (isSPACE(*s)) { + if (chopspace) + chophere = s; + if (*s == '\r') + break; + } + else { + if (*s & ~31) + gotsome = TRUE; + if (strchr(PL_chopset, *s)) + chophere = s + 1; + } + s++; + } + itemsize = chophere - item; + sv_pos_b2u(sv, &itemsize); + } + item_is_utf8 = TRUE; break; } - if (*s++ & ~31) - gotsome = TRUE; } - } - else { - itemsize = fieldsize; - send = chophere = s + itemsize; - while (s < send || (s == send && isSPACE(*s))) { - if (isSPACE(*s)) { - if (chopspace) + item_is_utf8 = FALSE; + if (itemsize <= fieldsize) { + const char *const send = chophere = s + itemsize; + while (s < send) { + if (*s == '\r') { + itemsize = s - item; chophere = s; - if (*s == '\r') break; - } - else { - if (*s & ~31) + } + if (*s++ & ~31) gotsome = TRUE; - if (strchr(PL_chopset, *s)) - chophere = s + 1; } - s++; } - itemsize = chophere - item; + else { + const char *send; + itemsize = fieldsize; + send = chophere = s + itemsize; + while (s < send || (s == send && isSPACE(*s))) { + if (isSPACE(*s)) { + if (chopspace) + chophere = s; + if (*s == '\r') + break; + } + else { + if (*s & ~31) + gotsome = TRUE; + if (strchr(PL_chopset, *s)) + chophere = s + 1; + } + s++; + } + itemsize = chophere - item; + } + break; } - break; case FF_SPACE: arg = fieldsize - itemsize; @@ -656,77 +663,81 @@ PP(pp_formline) break; case FF_ITEM: - arg = itemsize; - s = item; - if (item_is_utf8) { - if (!targ_is_utf8) { - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); - *t = '\0'; - sv_utf8_upgrade(PL_formtarget); - SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); - t = SvEND(PL_formtarget); - targ_is_utf8 = TRUE; - } - while (arg--) { - if (UTF8_IS_CONTINUED(*s)) { - STRLEN skip = UTF8SKIP(s); - switch (skip) { - default: - Move(s,t,skip,char); - s += skip; - t += skip; - break; - case 7: *t++ = *s++; - case 6: *t++ = *s++; - case 5: *t++ = *s++; - case 4: *t++ = *s++; - case 3: *t++ = *s++; - case 2: *t++ = *s++; - case 1: *t++ = *s++; - } + { + const char *s = item; + arg = itemsize; + if (item_is_utf8) { + if (!targ_is_utf8) { + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); + *t = '\0'; + sv_utf8_upgrade(PL_formtarget); + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); + t = SvEND(PL_formtarget); + targ_is_utf8 = TRUE; } - else { - if ( !((*t++ = *s++) & ~31) ) - t[-1] = ' '; + while (arg--) { + if (UTF8_IS_CONTINUED(*s)) { + STRLEN skip = UTF8SKIP(s); + switch (skip) { + default: + Move(s,t,skip,char); + s += skip; + t += skip; + break; + case 7: *t++ = *s++; + case 6: *t++ = *s++; + case 5: *t++ = *s++; + case 4: *t++ = *s++; + case 3: *t++ = *s++; + case 2: *t++ = *s++; + case 1: *t++ = *s++; + } + } + else { + if ( !((*t++ = *s++) & ~31) ) + t[-1] = ' '; + } } + break; } - break; - } - if (targ_is_utf8 && !item_is_utf8) { - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); - *t = '\0'; - sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv); - for (; t < SvEND(PL_formtarget); t++) { + if (targ_is_utf8 && !item_is_utf8) { + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); + *t = '\0'; + sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv); + for (; t < SvEND(PL_formtarget); t++) { #ifdef EBCDIC - int ch = *t; - if (iscntrl(ch)) + const int ch = *t; + if (iscntrl(ch)) #else - if (!(*t & ~31)) + if (!(*t & ~31)) #endif - *t = ' '; + *t = ' '; + } + break; } - break; - } - while (arg--) { + while (arg--) { #ifdef EBCDIC - int ch = *t++ = *s++; - if (iscntrl(ch)) + const int ch = *t++ = *s++; + if (iscntrl(ch)) #else - if ( !((*t++ = *s++) & ~31) ) + if ( !((*t++ = *s++) & ~31) ) #endif - t[-1] = ' '; + t[-1] = ' '; + } + break; } - break; case FF_CHOP: - s = chophere; - if (chopspace) { - while (*s && isSPACE(*s)) - s++; + { + const char *s = chophere; + if (chopspace) { + while (*s && isSPACE(*s)) + s++; + } + sv_chop(sv,s); + SvSETMAGIC(sv); + break; } - sv_chop(sv,s); - SvSETMAGIC(sv); - break; case FF_LINESNGL: chopspace = 0; @@ -735,47 +746,49 @@ PP(pp_formline) case FF_LINEGLOB: oneline = FALSE; ff_line: - item = s = SvPV(sv, len); - itemsize = len; - if ((item_is_utf8 = DO_UTF8(sv))) - itemsize = sv_len_utf8(sv); - if (itemsize) { - bool chopped = FALSE; - gotsome = TRUE; - send = s + len; - chophere = s + itemsize; - while (s < send) { - if (*s++ == '\n') { - if (oneline) { - chopped = TRUE; - chophere = s; - break; - } else { - if (s == send) { - itemsize--; - chopped = TRUE; - } else - lines++; + { + const char *s = item = SvPV_const(sv, len); + itemsize = len; + if ((item_is_utf8 = DO_UTF8(sv))) + itemsize = sv_len_utf8(sv); + if (itemsize) { + bool chopped = FALSE; + const char *const send = s + len; + gotsome = TRUE; + chophere = s + itemsize; + while (s < send) { + if (*s++ == '\n') { + if (oneline) { + chopped = TRUE; + chophere = s; + break; + } else { + if (s == send) { + itemsize--; + chopped = TRUE; + } else + lines++; + } } } + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); + if (targ_is_utf8) + SvUTF8_on(PL_formtarget); + if (oneline) { + SvCUR_set(sv, chophere - item); + sv_catsv(PL_formtarget, sv); + SvCUR_set(sv, itemsize); + } else + sv_catsv(PL_formtarget, sv); + if (chopped) + SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1); + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); + t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); + if (item_is_utf8) + targ_is_utf8 = TRUE; } - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); - if (targ_is_utf8) - SvUTF8_on(PL_formtarget); - if (oneline) { - SvCUR_set(sv, chophere - item); - sv_catsv(PL_formtarget, sv); - SvCUR_set(sv, itemsize); - } else - sv_catsv(PL_formtarget, sv); - if (chopped) - SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1); - SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); - t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); - if (item_is_utf8) - targ_is_utf8 = TRUE; + break; } - break; case FF_0DECIMAL: arg = *fpc++; @@ -831,7 +844,7 @@ PP(pp_formline) if (gotsome) { if (arg) { /* repeat until fields exhausted? */ *t = '\0'; - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); lines += FmLINES(PL_formtarget); if (lines == 200) { arg = t - linemark; @@ -852,33 +865,35 @@ PP(pp_formline) break; case FF_MORE: - s = chophere; - send = item + len; - if (chopspace) { - while (*s && isSPACE(*s) && s < send) - s++; - } - if (s < send) { - arg = fieldsize - itemsize; - if (arg) { - fieldsize -= arg; - while (arg-- > 0) - *t++ = ' '; + { + const char *s = chophere; + const char *send = item + len; + if (chopspace) { + while (*s && isSPACE(*s) && s < send) + s++; } - s = t - 3; - if (strnEQ(s," ",3)) { - while (s > SvPVX(PL_formtarget) && isSPACE(s[-1])) - s--; + if (s < send) { + char *s1; + arg = fieldsize - itemsize; + if (arg) { + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + s1 = t - 3; + if (strnEQ(s1," ",3)) { + while (s1 > SvPVX_const(PL_formtarget) && isSPACE(s1[-1])) + s1--; + } + *s1++ = '.'; + *s1++ = '.'; + *s1++ = '.'; } - *s++ = '.'; - *s++ = '.'; - *s++ = '.'; + break; } - break; - case FF_END: *t = '\0'; - SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); if (targ_is_utf8) SvUTF8_on(PL_formtarget); FmLINES(PL_formtarget) += lines; @@ -890,7 +905,7 @@ PP(pp_formline) PP(pp_grepstart) { - dSP; + dVAR; dSP; SV *src; if (PL_stack_base + *PL_markstack_ptr == SP) { @@ -932,8 +947,8 @@ PP(pp_mapstart) PP(pp_mapwhile) { - dSP; - I32 gimme = GIMME_V; + dVAR; dSP; + const I32 gimme = GIMME_V; I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */ I32 count; I32 shift; @@ -1087,7 +1102,7 @@ PP(pp_flip) RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); } } - sv_setpv(TARG, ""); + sv_setpvn(TARG, "", 0); SETs(targ); RETURN; } @@ -1101,7 +1116,7 @@ PP(pp_flip) SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \ - looks_like_number(left)) && SvPOKp(left) && *SvPVX(left) != '0')) \ + looks_like_number(left)) && SvPOKp(left) && *SvPVX_const(left) != '0')) \ && (!SvOK(right) || looks_like_number(right)))) PP(pp_flop) @@ -1110,9 +1125,6 @@ PP(pp_flop) if (GIMME == G_ARRAY) { dPOPPOPssrl; - register IV i, j; - register SV *sv; - IV max; if (SvGMAGICAL(left)) mg_get(left); @@ -1120,6 +1132,8 @@ PP(pp_flop) mg_get(right); if (RANGE_IS_NUMERIC(left,right)) { + register IV i, j; + IV max; if ((SvOK(left) && SvNV(left) < IV_MIN) || (SvOK(right) && SvNV(right) > IV_MAX)) DIE(aTHX_ "Range iterator outside integer range"); @@ -1133,20 +1147,20 @@ PP(pp_flop) else j = 0; while (j--) { - sv = sv_2mortal(newSViv(i++)); + SV * const sv = sv_2mortal(newSViv(i++)); PUSHs(sv); } } else { SV *final = sv_mortalcopy(right); - STRLEN len, n_a; - char *tmps = SvPV(final, len); + STRLEN len; + const char *tmps = SvPV_const(final, len); - sv = sv_mortalcopy(left); - SvPV_force(sv,n_a); + SV *sv = sv_mortalcopy(left); + SvPV_force_nolen(sv); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); - if (strEQ(SvPVX(sv),tmps)) + if (strEQ(SvPVX_const(sv),tmps)) break; sv = sv_2mortal(newSVsv(sv)); sv_inc(sv); @@ -1155,7 +1169,7 @@ PP(pp_flop) } else { dTOPss; - SV *targ = PAD_SV(cUNOP->op_first->op_targ); + SV * const targ = PAD_SV(cUNOP->op_first->op_targ); int flop = 0; sv_inc(targ); @@ -1164,7 +1178,7 @@ PP(pp_flop) flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); } else { - GV *gv = gv_fetchpv(".", TRUE, SVt_PV); + GV * const gv = gv_fetchpv(".", TRUE, SVt_PV); if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv)); } } @@ -1174,7 +1188,7 @@ PP(pp_flop) if (flop) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); - sv_catpv(targ, "E0"); + sv_catpvn(targ, "E0", 2); } SETs(targ); } @@ -1184,7 +1198,7 @@ PP(pp_flop) /* Control. */ -static const char *context_name[] = { +static const char * const context_name[] = { "pseudo-block", "subroutine", "eval", @@ -1200,7 +1214,7 @@ S_dopoptolabel(pTHX_ const char *label) register I32 i; for (i = cxstack_ix; i >= 0; i--) { - register const PERL_CONTEXT *cx = &cxstack[i]; + register const PERL_CONTEXT * const cx = &cxstack[i]; switch (CxTYPE(cx)) { case CXt_SUBST: case CXt_SUB: @@ -1214,8 +1228,7 @@ S_dopoptolabel(pTHX_ const char *label) return -1; break; case CXt_LOOP: - if (!cx->blk_loop.label || - strNE(label, cx->blk_loop.label) ) { + if ( !cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) { DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n", (long)i, cx->blk_loop.label)); continue; @@ -1230,7 +1243,7 @@ S_dopoptolabel(pTHX_ const char *label) I32 Perl_dowantarray(pTHX) { - I32 gimme = block_gimme(); + const I32 gimme = block_gimme(); return (gimme == G_VOID) ? G_SCALAR : gimme; } @@ -1274,11 +1287,11 @@ S_dopoptosub(pTHX_ I32 startingblock) } STATIC I32 -S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) +S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - register const PERL_CONTEXT *cx = &cxstk[i]; + register const PERL_CONTEXT * const cx = &cxstk[i]; switch (CxTYPE(cx)) { default: continue; @@ -1314,7 +1327,7 @@ S_dopoptoloop(pTHX_ I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - register const PERL_CONTEXT *cx = &cxstack[i]; + register const PERL_CONTEXT * const cx = &cxstack[i]; switch (CxTYPE(cx)) { case CXt_SUBST: case CXt_SUB: @@ -1368,6 +1381,7 @@ Perl_dounwind(pTHX_ I32 cxix) } cxstack_ix--; } + PERL_UNUSED_VAR(optype); } void @@ -1385,12 +1399,11 @@ Perl_qerror(pTHX_ SV *err) OP * Perl_die_where(pTHX_ const char *message, STRLEN msglen) { - STRLEN n_a; + dVAR; if (PL_in_eval) { I32 cxix; I32 gimme; - SV **newsp; if (message) { if (PL_in_eval & EVAL_KEEPERR) { @@ -1398,10 +1411,11 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) SV *err = ERRSV; const char *e = Nullch; if (!SvPOK(err)) - sv_setpv(err,""); + sv_setpvn(err,"",0); else if (SvCUR(err) >= sizeof(prefix)+msglen-1) { - e = SvPV(err, n_a); - e += n_a - msglen; + STRLEN len; + e = SvPV_const(err, len); + e += len - msglen; if (*e != *message || strNE(e,message)) e = Nullch; } @@ -1410,8 +1424,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) sv_catpvn(err, prefix, sizeof(prefix)-1); sv_catpvn(err, message, msglen); if (ckWARN(WARN_MISC)) { - STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start); + const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; + Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start); } } } @@ -1430,6 +1444,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) if (cxix >= 0) { I32 optype; register PERL_CONTEXT *cx; + SV **newsp; if (cxix < cxstack_ix) dounwind(cxix); @@ -1437,7 +1452,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) POPBLOCK(cx,PL_curpm); if (CxTYPE(cx) != CXt_EVAL) { if (!message) - message = SvPVx(ERRSV, msglen); + message = SvPVx_const(ERRSV, msglen); PerlIO_write(Perl_error_log, "panic: die ", 11); PerlIO_write(Perl_error_log, message, msglen); my_exit(1); @@ -1457,9 +1472,9 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) PL_curcop = cx->blk_oldcop; if (optype == OP_REQUIRE) { - const char* msg = SvPVx(ERRSV, n_a); - SV *nsv = cx->blk_eval.old_namesv; - (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), + const char* msg = SvPVx_nolen_const(ERRSV); + SV * const nsv = cx->blk_eval.old_namesv; + (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), &PL_sv_undef, 0); DIE(aTHX_ "%sCompilation failed in require", *msg ? msg : "Unknown error\n"); @@ -1469,7 +1484,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen) } } if (!message) - message = SvPVx(ERRSV, msglen); + message = SvPVx_const(ERRSV, msglen); write_to_stderr(message, msglen); my_failure_exit(); @@ -1541,13 +1556,11 @@ PP(pp_caller) { dSP; register I32 cxix = dopoptosub(cxstack_ix); - register PERL_CONTEXT *cx; - register PERL_CONTEXT *ccstack = cxstack; - PERL_SI *top_si = PL_curstackinfo; - I32 dbcxix; + register const PERL_CONTEXT *cx; + register const PERL_CONTEXT *ccstack = cxstack; + const PERL_SI *top_si = PL_curstackinfo; I32 gimme; const char *stashname; - SV *sv; I32 count = 0; if (MAXARG) @@ -1578,7 +1591,7 @@ PP(pp_caller) cx = &ccstack[cxix]; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - dbcxix = dopoptosub_at(ccstack, cxix - 1); + const I32 dbcxix = dopoptosub_at(ccstack, cxix - 1); /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ /* caller() should not report the automatic calls to &DB::sub */ @@ -1613,7 +1626,7 @@ PP(pp_caller) GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv); /* So is ccstack[dbcxix]. */ if (isGV(cvgv)) { - sv = NEWSV(49, 0); + SV * const sv = NEWSV(49, 0); gv_efullname3(sv, cvgv, Nullch); PUSHs(sv_2mortal(sv)); PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs))); @@ -1656,8 +1669,8 @@ PP(pp_caller) if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs && CopSTASH_eq(PL_curcop, PL_debstash)) { - AV *ary = cx->blk_sub.argarray; - const int off = AvARRAY(ary) - AvALLOC(ary); + AV * const ary = cx->blk_sub.argarray; + const int off = AvARRAY(ary) - AvALLOC(ary); if (!PL_dbargs) { GV* tmpgv; @@ -1708,12 +1721,11 @@ PP(pp_reset) { dSP; const char *tmps; - STRLEN n_a; if (MAXARG < 1) tmps = ""; else - tmps = POPpx; + tmps = POPpconstx; sv_reset(tmps, CopSTASH(PL_curcop)); PUSHs(&PL_sv_yes); RETURN; @@ -1728,6 +1740,7 @@ PP(pp_lineseq) PP(pp_dbstate) { + dVAR; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -1739,7 +1752,7 @@ PP(pp_dbstate) dSP; register CV *cv; register PERL_CONTEXT *cx; - I32 gimme = G_ARRAY; + const I32 gimme = G_ARRAY; U8 hasargs; GV *gv; @@ -1765,7 +1778,8 @@ PP(pp_dbstate) PUSHSUB_DB(cx); cx->blk_sub.retop = PL_op->op_next; CvDEPTH(cv)++; - PAD_SET_CUR(CvPADLIST(cv),1); + SAVECOMPPAD(); + PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1); RETURNOP(CvSTART(cv)); } else @@ -1779,9 +1793,9 @@ PP(pp_scope) PP(pp_enteriter) { - dSP; dMARK; + dVAR; dSP; dMARK; register PERL_CONTEXT *cx; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; SV **svp; U32 cxtype = CXt_LOOP; #ifdef USE_ITHREADS @@ -1837,10 +1851,9 @@ PP(pp_enteriter) cx->blk_loop.itermax = SvIV(right); } else { - STRLEN n_a; cx->blk_loop.iterlval = newSVsv(sv); - (void) SvPV_force(cx->blk_loop.iterlval,n_a); - (void) SvPV(right,n_a); + (void) SvPV_force_nolen(cx->blk_loop.iterlval); + (void) SvPV_nolen_const(right); } } else if (PL_op->op_private & OPpITER_REVERSED) { @@ -1866,9 +1879,9 @@ PP(pp_enteriter) PP(pp_enterloop) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1882,7 +1895,7 @@ PP(pp_enterloop) PP(pp_leaveloop) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -1890,6 +1903,7 @@ PP(pp_leaveloop) SV **mark; POPBLOCK(cx,newpm); + assert(CxTYPE(cx) == CXt_LOOP); mark = newsp; newsp = PL_stack_base + cx->blk_loop.resetsp; @@ -1922,7 +1936,7 @@ PP(pp_leaveloop) PP(pp_return) { - dSP; dMARK; + dVAR; dSP; dMARK; I32 cxix; register PERL_CONTEXT *cx; bool popsub2 = FALSE; @@ -1971,8 +1985,8 @@ PP(pp_return) (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { /* Unassume the success we assumed earlier. */ - SV *nsv = cx->blk_eval.old_namesv; - (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD); + SV * const nsv = cx->blk_eval.old_namesv; + (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); DIE(aTHX_ "%"SVf" did not return a true value", nsv); } break; @@ -2031,13 +2045,13 @@ PP(pp_return) LEAVESUB(sv); if (clear_errsv) - sv_setpv(ERRSV,""); + sv_setpvn(ERRSV,"",0); return retop; } PP(pp_last) { - dSP; + dVAR; dSP; I32 cxix; register PERL_CONTEXT *cx; I32 pop2 = 0; @@ -2049,6 +2063,7 @@ PP(pp_last) SV **mark; SV *sv = Nullsv; + if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) @@ -2120,11 +2135,14 @@ PP(pp_last) PL_curpm = newpm; /* ... and pop $1 et al */ LEAVESUB(sv); + PERL_UNUSED_VAR(optype); + PERL_UNUSED_VAR(gimme); return nextop; } PP(pp_next) { + dVAR; I32 cxix; register PERL_CONTEXT *cx; I32 inner; @@ -2148,14 +2166,17 @@ PP(pp_next) TOPBLOCK(cx); if (PL_scopestack_ix < inner) leave_scope(PL_scopestack[PL_scopestack_ix]); + PL_curcop = cx->blk_oldcop; return cx->blk_loop.next_op; } PP(pp_redo) { + dVAR; I32 cxix; register PERL_CONTEXT *cx; I32 oldsave; + OP* redo_op; if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); @@ -2170,17 +2191,25 @@ PP(pp_redo) if (cxix < cxstack_ix) dounwind(cxix); + redo_op = cxstack[cxix].blk_loop.redo_op; + if (redo_op->op_type == OP_ENTER) { + /* pop one less context to avoid $x being freed in while (my $x..) */ + cxstack_ix++; + assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_BLOCK); + redo_op = redo_op->op_next; + } + TOPBLOCK(cx); oldsave = PL_scopestack[PL_scopestack_ix - 1]; LEAVE_SCOPE(oldsave); FREETMPS; - return cx->blk_loop.redo_op; + PL_curcop = cx->blk_oldcop; + return redo_op; } STATIC OP * S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit) { - OP *kid = Nullop; OP **ops = opstack; static const char too_deep[] = "Target of goto is too deeply nested"; @@ -2198,6 +2227,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit) } *ops = 0; if (o->op_flags & OPf_KIDS) { + OP *kid; /* First try all the kids at this level, since that's likeliest. */ for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) && @@ -2232,7 +2262,7 @@ PP(pp_dump) PP(pp_goto) { - dSP; + dVAR; dSP; OP *retop = 0; I32 ix; register PERL_CONTEXT *cx; @@ -2243,8 +2273,7 @@ PP(pp_goto) static const char must_have_label[] = "goto must have label"; if (PL_op->op_flags & OPf_STACKED) { - SV *sv = POPs; - STRLEN n_a; + SV * const sv = POPs; /* This egregious kludge implements goto &subroutine */ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { @@ -2285,8 +2314,14 @@ PP(pp_goto) if (cxix < cxstack_ix) dounwind(cxix); TOPBLOCK(cx); - if (CxREALEVAL(cx)) - DIE(aTHX_ "Can't goto subroutine from an eval-string"); + SPAGAIN; + /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */ + if (CxTYPE(cx) == CXt_EVAL) { + if (CxREALEVAL(cx)) + DIE(aTHX_ "Can't goto subroutine from an eval-string"); + else + DIE(aTHX_ "Can't goto subroutine from an eval-block"); + } if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) { /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; @@ -2303,13 +2338,12 @@ PP(pp_goto) SvREFCNT_dec(av); av = newAV(); av_extend(av, items-1); - AvFLAGS(av) = AVf_REIFY; + AvREIFY_only(av); PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av); } } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ - AV* av; - av = GvAV(PL_defgv); + AV* const av = GvAV(PL_defgv); items = AvFILLp(av) + 1; EXTEND(SP, items+1); /* @_ could have been extended. */ Copy(AvARRAY(av), SP + 1, items, SV*); @@ -2326,6 +2360,7 @@ PP(pp_goto) SAVETMPS; SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ if (CvXSUB(cv)) { + OP* retop = cx->blk_sub.retop; if (reified) { I32 index; for (index=0; indexblk_sub.retop; + return retop; } else { AV* padlist = CvPADLIST(cv); @@ -2381,7 +2417,8 @@ PP(pp_goto) sub_crush_depth(cv); pad_push(padlist, CvDEPTH(cv)); } - PAD_SET_CUR(padlist, CvDEPTH(cv)); + SAVECOMPPAD(); + PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); if (cx->blk_sub.hasargs) { AV* av = (AV*)PAD_SVl(0); @@ -2425,12 +2462,12 @@ PP(pp_goto) * We do not care about using sv to call CV; * it's for informational purposes only. */ - SV *sv = GvSV(PL_DBsub); + SV * const sv = GvSV(PL_DBsub); CV *gotocv; save_item(sv); if (PERLDB_SUB_NN) { - int type = SvTYPE(sv); + const int type = SvTYPE(sv); if (type < SVt_PVIV && type != SVt_IV) sv_upgrade(sv, SVt_PVIV); (void)SvIOK_on(sv); @@ -2449,7 +2486,7 @@ PP(pp_goto) } } else { - label = SvPV(sv,n_a); + label = SvPV_nolen_const(sv); if (!(do_dump || *label)) DIE(aTHX_ must_have_label); } @@ -2604,7 +2641,7 @@ PP(pp_exit) PP(pp_nswitch) { dSP; - NV value = SvNVx(GvSV(cCOP->cop_gv)); + const NV value = SvNVx(GvSV(cCOP->cop_gv)); register I32 match = I_32(value); if (value < 0.0) { @@ -2628,8 +2665,7 @@ PP(pp_cswitch) if (PL_multiline) PL_op = PL_op->op_next; /* can't assume anything */ else { - STRLEN n_a; - match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255; + match = *(SvPVx_nolen_const(GvSV(cCOP->cop_gv))) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; @@ -2646,13 +2682,13 @@ PP(pp_cswitch) STATIC void S_save_lines(pTHX_ AV *array, SV *sv) { - register const char *s = SvPVX(sv); - register const char *send = SvPVX(sv) + SvCUR(sv); - register const char *t; - register I32 line = 1; + const char *s = SvPVX_const(sv); + const char * const send = SvPVX_const(sv) + SvCUR(sv); + I32 line = 1; while (s && s < send) { - SV *tmpstr = NEWSV(85,0); + const char *t; + SV * const tmpstr = NEWSV(85,0); sv_upgrade(tmpstr, SVt_PVMG); t = strchr(s, '\n'); @@ -2667,11 +2703,11 @@ S_save_lines(pTHX_ AV *array, SV *sv) } } -STATIC void * +STATIC void S_docatch_body(pTHX) { CALLRUNOPS(aTHX); - return NULL; + return; } STATIC OP * @@ -2679,8 +2715,6 @@ S_docatch(pTHX_ OP *o) { int ret; OP * const oldop = PL_op; - OP *retop; - volatile PERL_SI *cursi = PL_curstackinfo; dJMPENV; #ifdef DEBUGGING @@ -2688,32 +2722,32 @@ S_docatch(pTHX_ OP *o) #endif PL_op = o; - /* Normally, the leavetry at the end of this block of ops will - * pop an op off the return stack and continue there. By setting - * the op to Nullop, we force an exit from the inner runops() - * loop. DAPM. - */ - assert(cxstack_ix >= 0); - assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL); - retop = cxstack[cxstack_ix].blk_eval.retop; - cxstack[cxstack_ix].blk_eval.retop = Nullop; - JMPENV_PUSH(ret); switch (ret) { case 0: + assert(cxstack_ix >= 0); + assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL); + cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env; redo_body: docatch_body(); break; case 3: /* die caught by an inner eval - continue inner loop */ - if (PL_restartop && cursi == PL_curstackinfo) { + + /* NB XXX we rely on the old popped CxEVAL still being at the top + * of the stack; the way die_where() currently works, this + * assumption is valid. In theory The cur_top_env value should be + * returned in another global, the way retop (aka PL_restartop) + * is. */ + assert(CxTYPE(&cxstack[cxstack_ix+1]) == CXt_EVAL); + + if (PL_restartop + && cxstack[cxstack_ix+1].blk_eval.cur_top_env == PL_top_env) + { PL_op = PL_restartop; PL_restartop = 0; goto redo_body; } - /* a die in this eval - continue in outer loop */ - if (!PL_restartop) - break; /* FALL THROUGH */ default: JMPENV_POP; @@ -2723,7 +2757,7 @@ S_docatch(pTHX_ OP *o) } JMPENV_POP; PL_op = oldop; - return retop; + return Nullop; } OP * @@ -2732,10 +2766,10 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) /* startop op_free() this to undo. */ /* code Short string id of the caller. */ { - dSP; /* Make POPBLOCK work. */ + dVAR; dSP; /* Make POPBLOCK work. */ PERL_CONTEXT *cx; SV **newsp; - I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */ + I32 gimme = G_VOID; I32 optype; OP dummy; OP *rop; @@ -2755,7 +2789,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) CopSTASH_set(&PL_compiling, PL_curstash); } if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { - SV *sv = sv_newmortal(); + SV * const sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]", code, (unsigned long)++PL_evalseq, CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); @@ -2810,6 +2844,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) #ifdef OP_IN_REGISTER op = PL_opsave; #endif + PERL_UNUSED_VAR(newsp); + PERL_UNUSED_VAR(optype); + return rop; } @@ -2838,7 +2875,7 @@ Perl_find_runcv(pTHX_ U32 *db_seqp) for (ix = si->si_cxix; ix >= 0; ix--) { const PERL_CONTEXT *cx = &(si->si_cxstack[ix]); if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - CV *cv = cx->blk_sub.cv; + CV * const cv = cx->blk_sub.cv; /* skip DB:: code */ if (db_seqp && PL_debstash && CvSTASH(cv) == PL_debstash) { *db_seqp = cx->blk_oldcop->cop_seq; @@ -2864,8 +2901,8 @@ Perl_find_runcv(pTHX_ U32 *db_seqp) STATIC OP * S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) { - dSP; - OP *saveop = PL_op; + dVAR; dSP; + OP * const saveop = PL_op; PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE) ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL)) @@ -2910,12 +2947,12 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) if (saveop && saveop->op_flags & OPf_SPECIAL) PL_in_eval |= EVAL_KEEPERR; else - sv_setpv(ERRSV,""); + sv_setpvn(ERRSV,"",0); if (yyparse() || PL_error_count || !PL_eval_root) { SV **newsp; /* Used by POPBLOCK. */ - PERL_CONTEXT *cx = &cxstack[cxstack_ix]; + PERL_CONTEXT *cx = &cxstack[cxstack_ix]; I32 optype = 0; /* Might be reset by POPEVAL. */ - STRLEN n_a; + const char *msg; PL_op = saveop; if (PL_eval_root) { @@ -2929,28 +2966,27 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) } lex_end(); LEAVE; + + msg = SvPVx_nolen_const(ERRSV); if (optype == OP_REQUIRE) { - const char* msg = SvPVx(ERRSV, n_a); - SV *nsv = cx->blk_eval.old_namesv; - (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), + const SV * const nsv = cx->blk_eval.old_namesv; + (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), &PL_sv_undef, 0); DIE(aTHX_ "%sCompilation failed in require", *msg ? msg : "Unknown error\n"); } else if (startop) { - const char* msg = SvPVx(ERRSV, n_a); - POPBLOCK(cx,PL_curpm); POPEVAL(cx); Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n")); } else { - const char* msg = SvPVx(ERRSV, n_a); if (!*msg) { sv_setpv(ERRSV, "Compilation error"); } } + PERL_UNUSED_VAR(newsp); RETPUSHUNDEF; } CopLINE_set(&PL_compiling, 0); @@ -2978,7 +3014,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) /* Register with debugger: */ if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) { - CV *cv = get_cv("DB::postponed", FALSE); + CV * const cv = get_cv("DB::postponed", FALSE); if (cv) { dSP; PUSHMARK(SP); @@ -3002,18 +3038,18 @@ STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode) { #ifndef PERL_DISABLE_PMC - STRLEN namelen = strlen(name); + const STRLEN namelen = strlen(name); PerlIO *fp; if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) { - SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c'); - const char * const pmc = SvPV_nolen(pmcsv); - Stat_t pmstat; + SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c'); + const char * const pmc = SvPV_nolen_const(pmcsv); Stat_t pmcstat; if (PerlLIO_stat(pmc, &pmcstat) < 0) { fp = PerlIO_open(name, mode); } else { + Stat_t pmstat; if (PerlLIO_stat(name, &pmstat) < 0 || pmstat.st_mtime < pmcstat.st_mtime) { @@ -3036,17 +3072,16 @@ S_doopen_pm(pTHX_ const char *name, const char *mode) PP(pp_require) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; SV *sv; - char *name; + const char *name; STRLEN len; - char *tryname = Nullch; + const char *tryname = Nullch; SV *namesv = Nullsv; SV** svp; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; PerlIO *tryrsfp = 0; - STRLEN n_a; int filter_has_file = 0; GV *filter_child_proc = 0; SV *filter_state = 0; @@ -3065,12 +3100,12 @@ PP(pp_require) if (!sv_derived_from(PL_patchlevel, "version")) (void *)upg_version(PL_patchlevel); if ( vcmp(sv,PL_patchlevel) > 0 ) - DIE(aTHX_ "Perl v%"SVf" required--this is only v%"SVf", stopped", - vstringify(sv), vstringify(PL_patchlevel)); + DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped", + vnormal(sv), vnormal(PL_patchlevel)); RETPUSHYES; } - name = SvPV(sv, len); + name = SvPV_const(sv, len); if (!(name && len > 0 && *name)) DIE(aTHX_ "Null filename used"); TAINT_PROPER("require"); @@ -3123,7 +3158,7 @@ PP(pp_require) Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s", PTR2UV(SvRV(dirsv)), name); - tryname = SvPVX(namesv); + tryname = SvPVX_const(namesv); tryrsfp = 0; ENTER; @@ -3231,7 +3266,7 @@ PP(pp_require) || (*name == ':' && name[1] != ':' && strchr(name+2, ':')) #endif ) { - char *dir = SvPVx(dirsv, n_a); + const char *dir = SvPVx_nolen_const(dirsv); #ifdef MACOS_TRADITIONAL char buf1[256]; char buf2[256]; @@ -3239,18 +3274,32 @@ PP(pp_require) MacPerl_CanonDir(name, buf2, 1); Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':')); #else -#ifdef VMS +# ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) continue; sv_setpv(namesv, unixdir); sv_catpv(namesv, unixname); -#else +# else +# ifdef SYMBIAN + if (PL_origfilename[0] && + PL_origfilename[1] == ':' && + !(dir[0] && dir[1] == ':')) + Perl_sv_setpvf(aTHX_ namesv, + "%c:%s\\%s", + PL_origfilename[0], + dir, name); + else + Perl_sv_setpvf(aTHX_ namesv, + "%s\\%s", + dir, name); +# else Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); -#endif +# endif +# endif #endif TAINT_PROPER("require"); - tryname = SvPVX(namesv); + tryname = SvPVX_const(namesv); tryrsfp = doopen_pm(tryname, PERL_SCRIPT_MODE); if (tryrsfp) { if (tryname[0] == '.' && tryname[1] == '/') @@ -3267,26 +3316,26 @@ PP(pp_require) SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { - char *msgstr = name; + const char *msgstr = name; if (namesv) { /* did we lookup @INC? */ SV *msg = sv_2mortal(newSVpv(msgstr,0)); SV *dirmsgsv = NEWSV(0, 0); AV *ar = GvAVn(PL_incgv); I32 i; sv_catpvn(msg, " in @INC", 8); - if (instr(SvPVX(msg), ".h ")) + if (instr(SvPVX_const(msg), ".h ")) sv_catpv(msg, " (change .h to .ph maybe?)"); - if (instr(SvPVX(msg), ".ph ")) + if (instr(SvPVX_const(msg), ".ph ")) sv_catpv(msg, " (did you run h2ph?)"); sv_catpv(msg, " (@INC contains:"); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a); + const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE)); Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir); sv_catsv(msg, dirmsgsv); } sv_catpvn(msg, ")", 1); SvREFCNT_dec(dirmsgsv); - msgstr = SvPV_nolen(msg); + msgstr = SvPV_nolen_const(msg); } DIE(aTHX_ "Can't locate %s", msgstr); } @@ -3328,7 +3377,7 @@ PP(pp_require) PL_compiling.cop_io = Nullsv; if (filter_sub || filter_child_proc) { - SV *datasv = filter_add(run_user_filter, Nullsv); + SV * const datasv = filter_add(run_user_filter, Nullsv); IoLINES(datasv) = filter_has_file; IoFMT_GV(datasv) = (GV *)filter_child_proc; IoTOP_GV(datasv) = (GV *)filter_state; @@ -3364,10 +3413,11 @@ PP(pp_dofile) PP(pp_entereval) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; dPOPss; - I32 gimme = GIMME_V, was = PL_sub_generation; + const I32 gimme = GIMME_V; + const I32 was = PL_sub_generation; char tbuf[TYPE_DIGITS(long) + 12]; char *tmpbuf = tbuf; char *safestr; @@ -3376,7 +3426,7 @@ PP(pp_entereval) CV* runcv; U32 seq; - if (!SvPV(sv,len)) + if (!SvPV_const(sv,len)) RETPUSHUNDEF; TAINT_PROPER("eval"); @@ -3387,7 +3437,7 @@ PP(pp_entereval) /* switch to eval mode */ if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { - SV *sv = sv_newmortal(); + SV * const sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]", (unsigned long)++PL_evalseq, CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); @@ -3448,7 +3498,7 @@ PP(pp_entereval) PP(pp_leaveeval) { - dSP; + dVAR; dSP; register SV **mark; SV **newsp; PMOP *newpm; @@ -3500,15 +3550,15 @@ PP(pp_leaveeval) !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp)) { /* Unassume the success we assumed earlier. */ - SV *nsv = cx->blk_eval.old_namesv; - (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD); + SV * const nsv = cx->blk_eval.old_namesv; + (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); retop = Perl_die(aTHX_ "%"SVf" did not return a true value", nsv); /* die_where() did LEAVE, or we won't be here */ } else { LEAVE; if (!(save_flags & OPf_SPECIAL)) - sv_setpv(ERRSV,""); + sv_setpvn(ERRSV,"",0); } RETURNOP(retop); @@ -3516,9 +3566,9 @@ PP(pp_leaveeval) PP(pp_entertry) { - dSP; + dVAR; dSP; register PERL_CONTEXT *cx; - I32 gimme = GIMME_V; + const I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -3528,25 +3578,24 @@ PP(pp_entertry) cx->blk_eval.retop = cLOGOP->op_other->op_next; PL_in_eval = EVAL_INEVAL; - sv_setpv(ERRSV,""); + sv_setpvn(ERRSV,"",0); PUTBACK; return DOCATCH(PL_op->op_next); } PP(pp_leavetry) { - dSP; + dVAR; dSP; register SV **mark; SV **newsp; PMOP *newpm; - OP* retop; I32 gimme; register PERL_CONTEXT *cx; I32 optype; POPBLOCK(cx,newpm); POPEVAL(cx); - retop = cx->blk_eval.retop; + PERL_UNUSED_VAR(optype); TAINT_NOT; if (gimme == G_VOID) @@ -3577,8 +3626,8 @@ PP(pp_leavetry) PL_curpm = newpm; /* Don't pop $1 et al till now */ LEAVE; - sv_setpv(ERRSV,""); - RETURNOP(retop); + sv_setpvn(ERRSV,"",0); + RETURN; } STATIC OP * @@ -3611,7 +3660,7 @@ S_doparseform(pTHX_ SV *sv) s = base; base = Nullch; - New(804, fops, maxops, U32); + Newx(fops, maxops, U32); fpc = fops; if (s < send) { @@ -3829,8 +3878,9 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize) static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) { + dVAR; SV *datasv = FILTER_DATA(idx); - int filter_has_file = IoLINES(datasv); + const int filter_has_file = IoLINES(datasv); GV *filter_child_proc = (GV *)IoFMT_GV(datasv); SV *filter_state = (SV *)IoTOP_GV(datasv); SV *filter_sub = (SV *)IoBOTTOM_GV(datasv); @@ -3922,5 +3972,5 @@ S_path_is_absolute(pTHX_ const char *name) * indent-tabs-mode: t * End: * - * vim: shiftwidth=4: -*/ + * ex: set ts=8 sts=4 sw=4 noet: + */