{
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. */
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 ||
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
RX_MATCH_UTF8_set(rx, SvUTF8(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");
}
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);
}
- SvPVX(targ) = SvPVX(dstr);
+ SvPV_set(targ, SvPVX(dstr));
SvCUR_set(targ, SvCUR(dstr));
SvLEN_set(targ, SvLEN(dstr));
if (DO_UTF8(dstr))
SvUTF8_on(targ);
- SvPVX(dstr) = 0;
+ SvPV_set(dstr, (char*)0);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
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);
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;
*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
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);
if (p) {
Safefree(INT2PTR(char*,*p));
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
if (p[1]) {
SvREFCNT_dec (INT2PTR(SV*,p[1]));
}
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;
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( {
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);
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;
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))
+ 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))
+ 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;
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++;
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;
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;
PP(pp_grepstart)
{
- dSP;
+ dVAR; dSP;
SV *src;
if (PL_stack_base + *PL_markstack_ptr == SP) {
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;
RETURNOP(((LOGOP*)cUNOP->op_first)->op_other);
}
}
- sv_setpv(TARG, "");
+ sv_setpvn(TARG, "", 0);
SETs(targ);
RETURN;
}
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)
}
else {
SV *final = sv_mortalcopy(right);
- STRLEN len, n_a;
- char *tmps = SvPV(final, len);
+ STRLEN len;
+ const char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- SvPV_force(sv,n_a);
+ 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);
/* Control. */
-static const char *context_name[] = {
+static const char * const context_name[] = {
"pseudo-block",
"subroutine",
"eval",
I32
Perl_dowantarray(pTHX)
{
- I32 gimme = block_gimme();
+ const I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
OP *
Perl_die_where(pTHX_ const char *message, STRLEN msglen)
{
- STRLEN n_a;
+ dVAR;
if (PL_in_eval) {
I32 cxix;
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(err, len);
+ e += len - msglen;
if (*e != *message || strNE(e,message))
e = Nullch;
}
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);
}
}
}
PL_curcop = cx->blk_oldcop;
if (optype == OP_REQUIRE) {
- const char* msg = SvPVx(ERRSV, n_a);
+ const char* msg = SvPVx_nolen_const(ERRSV);
SV *nsv = cx->blk_eval.old_namesv;
- (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+ (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");
register PERL_CONTEXT *cx;
register PERL_CONTEXT *ccstack = cxstack;
PERL_SI *top_si = PL_curstackinfo;
- I32 dbcxix;
I32 gimme;
const char *stashname;
- SV *sv;
I32 count = 0;
if (MAXARG)
}
RETURN;
}
- if (PL_DBsub && cxix >= 0 &&
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
count++;
if (!count--)
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. */
- if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
cx = &ccstack[dbcxix];
}
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)));
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;
{
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;
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;
dSP;
register CV *cv;
register PERL_CONTEXT *cx;
- I32 gimme = G_ARRAY;
+ const I32 gimme = G_ARRAY;
U8 hasargs;
GV *gv;
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
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) {
PP(pp_enterloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
PP(pp_leaveloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
SV **mark;
POPBLOCK(cx,newpm);
+ assert(CxTYPE(cx) == CXt_LOOP);
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
PP(pp_return)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
{
/* 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);
+ (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
DIE(aTHX_ "%"SVf" did not return a true value", nsv);
}
break;
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;
PP(pp_next)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 inner;
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);
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 *
PP(pp_goto)
{
- dSP;
+ dVAR; dSP;
OP *retop = 0;
I32 ix;
register PERL_CONTEXT *cx;
if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
- STRLEN n_a;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
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;
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);
}
}
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; index<items; index++)
SV **newsp;
I32 gimme;
+ /* XS subs don't have a CxSUB, so pop it */
+ POPBLOCK(cx, PL_curpm);
/* Push a mark for the start of arglist */
PUSHMARK(mark);
PUTBACK;
(void)(*CvXSUB(cv))(aTHX_ cv);
- /* Pop the current context like a decent sub should */
- POPBLOCK(cx, PL_curpm);
- /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
}
LEAVE;
- assert(CxTYPE(cx) == CXt_SUB);
- return cx->blk_sub.retop;
+ return retop;
}
else {
AV* padlist = CvPADLIST(cv);
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (items >= AvMAX(av) + 1) {
AvMAX(av) = items - 1;
Renew(ary,items+1,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
++mark;
SV *sv = GvSV(PL_DBsub);
CV *gotocv;
+ save_item(sv);
if (PERLDB_SUB_NN) {
- (void)SvUPGRADE(sv, SVt_PVIV);
+ int type = SvTYPE(sv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SAVEIV(SvIVX(sv));
SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
} else {
- save_item(sv);
gv_efullname3(sv, CvGV(cv), Nullch);
}
if ( PERLDB_GOTO
}
}
else {
- label = SvPV(sv,n_a);
+ label = SvPV_nolen_const(sv);
if (!(do_dump || *label))
DIE(aTHX_ must_have_label);
}
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) {
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;
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 *send = SvPVX_const(sv) + SvCUR(sv);
+ I32 line = 1;
while (s && s < send) {
+ const char *t;
SV *tmpstr = NEWSV(85,0);
sv_upgrade(tmpstr, SVt_PVMG);
{
int ret;
OP * const oldop = PL_op;
- OP *retop;
- volatile PERL_SI *cursi = PL_curstackinfo;
dJMPENV;
#ifdef DEBUGGING
#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;
}
JMPENV_POP;
PL_op = oldop;
- return retop;
+ return Nullop;
}
OP *
/* 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 */
STATIC OP *
S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
- dSP;
+ dVAR; dSP;
OP *saveop = PL_op;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
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];
I32 optype = 0; /* Might be reset by POPEVAL. */
- STRLEN n_a;
PL_op = saveop;
if (PL_eval_root) {
lex_end();
LEAVE;
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* const msg = SvPVx_nolen_const(ERRSV);
+ 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);
+ const char* msg = SvPVx_nolen_const(ERRSV);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
(*msg ? msg : "Unknown error\n"));
}
else {
- const char* msg = SvPVx(ERRSV, n_a);
+ const char* msg = SvPVx_nolen_const(ERRSV);
if (!*msg) {
sv_setpv(ERRSV, "Compilation error");
}
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")) {
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;
RETPUSHYES;
}
- name = SvPV(sv, len);
+ name = SvPV_const(sv, len);
if (!(name && len > 0 && *name))
DIE(aTHX_ "Null filename used");
TAINT_PROPER("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];
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);
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);
}
PP(pp_entereval)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
dPOPss;
- I32 gimme = GIMME_V, was = PL_sub_generation;
+ const I32 gimme = GIMME_V, was = PL_sub_generation;
char tbuf[TYPE_DIGITS(long) + 12];
char *tmpbuf = tbuf;
char *safestr;
CV* runcv;
U32 seq;
- if (!SvPV(sv,len))
+ if (!SvPV_const(sv,len))
RETPUSHUNDEF;
TAINT_PROPER("eval");
PP(pp_leaveeval)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
{
/* 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);
+ (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);
PP(pp_entertry)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
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;
TAINT_NOT;
if (gimme == G_VOID)
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpv(ERRSV,"");
- RETURNOP(retop);
+ sv_setpvn(ERRSV,"",0);
+ RETURN;
}
STATIC OP *
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);
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff