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) {
}
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++) {
const I32 saviters = cx->sb_iters;
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);
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;
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));
+#endif
#ifdef PERL_OLD_COPY_ON_WRITE
if (p[1]) {
SvREFCNT_dec (INT2PTR(SV*,p[1]));
sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv);
for (; t < SvEND(PL_formtarget); t++) {
#ifdef EBCDIC
- int ch = *t;
+ const int ch = *t;
if (iscntrl(ch))
#else
if (!(*t & ~31))
}
while (arg--) {
#ifdef EBCDIC
- int ch = *t++ = *s++;
+ const int ch = *t++ = *s++;
if (iscntrl(ch))
#else
if ( !((*t++ = *s++) & ~31) )
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
- register IV i, j;
- register SV *sv;
- IV max;
if (SvGMAGICAL(left))
mg_get(left);
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");
else
j = 0;
while (j--) {
- sv = sv_2mortal(newSViv(i++));
+ SV * const sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
}
STRLEN len;
const char *tmps = SvPV_const(final, len);
- sv = sv_mortalcopy(left);
+ SV *sv = sv_mortalcopy(left);
SvPV_force_nolen(sv);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
}
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);
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));
}
}
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);
}
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:
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;
}
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;
{
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:
}
cxstack_ix--;
}
+ PERL_UNUSED_VAR(optype);
}
void
if (PL_in_eval) {
I32 cxix;
I32 gimme;
- SV **newsp;
if (message) {
if (PL_in_eval & EVAL_KEEPERR) {
if (cxix >= 0) {
I32 optype;
register PERL_CONTEXT *cx;
+ SV **newsp;
if (cxix < cxstack_ix)
dounwind(cxix);
if (optype == OP_REQUIRE) {
const char* msg = SvPVx_nolen_const(ERRSV);
- SV *nsv = cx->blk_eval.old_namesv;
+ 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",
{
dSP;
register I32 cxix = dopoptosub(cxstack_ix);
- register PERL_CONTEXT *cx;
- register PERL_CONTEXT *ccstack = cxstack;
- PERL_SI *top_si = PL_curstackinfo;
+ register const PERL_CONTEXT *cx;
+ register const PERL_CONTEXT *ccstack = cxstack;
+ const PERL_SI *top_si = PL_curstackinfo;
I32 gimme;
const char *stashname;
I32 count = 0;
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
DIE(aTHX_ "Range iterator outside integer range");
cx->blk_loop.iterix = SvIV(sv);
cx->blk_loop.itermax = SvIV(right);
+#ifdef DEBUGGING
+ /* for correct -Dstv display */
+ cx->blk_oldsp = sp - PL_stack_base;
+#endif
}
else {
cx->blk_loop.iterlval = newSVsv(sv);
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
{
/* Unassume the success we assumed earlier. */
- SV *nsv = cx->blk_eval.old_namesv;
+ 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);
}
SV **mark;
SV *sv = Nullsv;
+
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
+ PERL_UNUSED_VAR(optype);
+ PERL_UNUSED_VAR(gimme);
return nextop;
}
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";
}
*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) &&
static const char must_have_label[] = "goto must have label";
if (PL_op->op_flags & OPf_STACKED) {
- SV *sv = POPs;
+ SV * const sv = POPs;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
}
}
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*);
PUSHMARK(mark);
PUTBACK;
(void)(*CvXSUB(cv))(aTHX_ cv);
+ /* Put these at the bottom since the vars are set but not used */
+ PERL_UNUSED_VAR(newsp);
+ PERL_UNUSED_VAR(gimme);
}
LEAVE;
return retop;
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);
* 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);
S_save_lines(pTHX_ AV *array, SV *sv)
{
const char *s = SvPVX_const(sv);
- const char *send = SvPVX_const(sv) + SvCUR(sv);
+ const char * const send = SvPVX_const(sv) + SvCUR(sv);
I32 line = 1;
while (s && s < send) {
const char *t;
- SV *tmpstr = NEWSV(85,0);
+ SV * const tmpstr = NEWSV(85,0);
sv_upgrade(tmpstr, SVt_PVMG);
t = strchr(s, '\n');
}
}
-STATIC void *
+STATIC void
S_docatch_body(pTHX)
{
CALLRUNOPS(aTHX);
- return NULL;
+ return;
}
STATIC OP *
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;
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));
#ifdef OP_IN_REGISTER
op = PL_opsave;
#endif
+ PERL_UNUSED_VAR(newsp);
+ PERL_UNUSED_VAR(optype);
+
return rop;
}
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;
S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
dVAR; dSP;
- OP *saveop = PL_op;
+ OP * const saveop = PL_op;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
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. */
+ const char *msg;
PL_op = saveop;
if (PL_eval_root) {
}
lex_end();
LEAVE;
+
+ msg = SvPVx_nolen_const(ERRSV);
if (optype == OP_REQUIRE) {
- 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);
*msg ? msg : "Unknown error\n");
}
else if (startop) {
- const char* msg = SvPVx_nolen_const(ERRSV);
-
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
else {
- const char* msg = SvPVx_nolen_const(ERRSV);
if (!*msg) {
sv_setpv(ERRSV, "Compilation error");
}
}
+ PERL_UNUSED_VAR(newsp);
RETPUSHUNDEF;
}
CopLINE_set(&PL_compiling, 0);
/* 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);
PerlIO *fp;
if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
- SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
+ SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
const char * const pmc = SvPV_nolen_const(pmcsv);
- Stat_t pmstat;
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)
{
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;
}
I32 i;
#ifdef VMS
char *unixname;
- if ((unixname = tounixspec(name, Nullch)) != Nullch)
+ if ((unixname = tounixspec((char *)name, Nullch)) != Nullch)
#endif
{
namesv = NEWSV(806, 0);
#else
# ifdef VMS
char *unixdir;
- if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
+ if ((unixdir = tounixpath((char *)dir, Nullch)) == Nullch)
continue;
sv_setpv(namesv, unixdir);
sv_catpv(namesv, unixname);
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;
dVAR; dSP;
register PERL_CONTEXT *cx;
dPOPss;
- const 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;
/* 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));
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
- SV *nsv = cx->blk_eval.old_namesv;
+ 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 */
POPBLOCK(cx,newpm);
POPEVAL(cx);
+ PERL_UNUSED_VAR(optype);
TAINT_NOT;
if (gimme == G_VOID)
s = base;
base = Nullch;
- New(804, fops, maxops, U32);
+ Newx(fops, maxops, U32);
fpc = fops;
if (s < send) {