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");
} else
#endif
{
- SvOOK_off(targ);
- if (SvLEN(targ))
- Safefree(SvPVX(targ));
+ SvPV_free(targ);
}
SvPV_set(targ, SvPVX(dstr));
SvCUR_set(targ, SvCUR(dstr));
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);
s = item;
if (item_is_utf8) {
if (!targ_is_utf8) {
- 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;
}
if (targ_is_utf8 && !item_is_utf8) {
- 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, s, arg, nsv);
for (; t < SvEND(PL_formtarget); t++) {
}
}
}
- 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);
if (oneline) {
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;
}
s = t - 3;
if (strnEQ(s," ",3)) {
- while (s > SvPVX(PL_formtarget) && isSPACE(s[-1]))
+ while (s > SvPVX_const(PL_formtarget) && isSPACE(s[-1]))
s--;
}
*s++ = '.';
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_mapwhile)
{
dVAR; dSP;
- I32 gimme = GIMME_V;
+ 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);
+ const char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
SvPV_force(sv,n_a);
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);
I32
Perl_dowantarray(pTHX)
{
- I32 gimme = block_gimme();
+ const I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
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;
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);
+ Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX_const(err)+start);
}
}
}
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),
+ (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)
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 */
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)));
dSP;
register CV *cv;
register PERL_CONTEXT *cx;
- I32 gimme = G_ARRAY;
+ const I32 gimme = G_ARRAY;
U8 hasargs;
GV *gv;
{
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
{
dVAR; dSP;
register PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
SV **mark;
POPBLOCK(cx,newpm);
+ assert(CxTYPE(cx) == CXt_LOOP);
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
{
/* 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;
}
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;
}
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 *
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
- if (CxREALEVAL(cx))
- DIE(aTHX_ "Can't goto subroutine from an eval-string");
+ SPAGAIN;
+ 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);
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) {
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 const char *s = SvPVX_const(sv);
+ register const char *send = SvPVX_const(sv) + SvCUR(sv);
register 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 *
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];
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),
+ (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");
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")) {
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;
|| (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
#endif
) {
+ STRLEN n_a;
char *dir = SvPVx(dirsv, n_a);
#ifdef MACOS_TRADITIONAL
char buf1[256];
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);
+ STRLEN n_a;
+ const char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
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;
{
/* 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);
{
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);
}
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 *
* 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