On OS X to use perl's malloc need to USE_PERL_SBRK and emulate sbrk()

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 8355b58..d0e2ef6 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -188,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) {
@@ -295,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);
@@ -371,7 +371,14 @@ 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));
+#endif
 #ifdef PERL_OLD_COPY_ON_WRITE
        if (p[1]) {
            SvREFCNT_dec (INT2PTR(SV*,p[1]));
@@ -699,7 +706,7 @@ PP(pp_formline)
                    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))
@@ -710,7 +717,7 @@ PP(pp_formline)
                }
                while (arg--) {
 #ifdef EBCDIC
-                   int ch = *t++ = *s++;
+                   const int ch = *t++ = *s++;
                    if (iscntrl(ch))
 #else
                        if ( !((*t++ = *s++) & ~31) )
@@ -1118,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);
@@ -1128,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");
@@ -1141,7 +1147,7 @@ PP(pp_flop)
            else
                j = 0;
            while (j--) {
-               sv = sv_2mortal(newSViv(i++));
+               SV * const sv = sv_2mortal(newSViv(i++));
                PUSHs(sv);
            }
        }
@@ -1150,7 +1156,7 @@ PP(pp_flop)
            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);
@@ -1163,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);
 
@@ -1172,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));
            }
        }
@@ -1182,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);
     }
@@ -1208,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:
@@ -1222,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;
@@ -1282,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;
@@ -1322,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:
@@ -1376,6 +1381,7 @@ Perl_dounwind(pTHX_ I32 cxix)
        }
        cxstack_ix--;
     }
+    PERL_UNUSED_VAR(optype);
 }
 
 void
@@ -1398,7 +1404,6 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
     if (PL_in_eval) {
        I32 cxix;
        I32 gimme;
-       SV **newsp;
 
        if (message) {
            if (PL_in_eval & EVAL_KEEPERR) {
@@ -1439,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);
@@ -1467,7 +1473,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 
            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",
@@ -1550,9 +1556,9 @@ 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;
+    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;
@@ -1978,7 +1984,7 @@ PP(pp_return)
            (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);
        }
@@ -2055,6 +2061,7 @@ PP(pp_last)
     PMOP *newpm;
     SV **mark;
     SV *sv = Nullsv;
+    PERL_UNUSED_VAR(optype);
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
@@ -2070,6 +2077,7 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
+    PERL_UNUSED_VAR(optype);
     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
@@ -2382,6 +2390,9 @@ PP(pp_goto)
                    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;
@@ -2690,11 +2701,11 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
-STATIC void *
+STATIC void
 S_docatch_body(pTHX)
 {
     CALLRUNOPS(aTHX);
-    return NULL;
+    return;
 }
 
 STATIC OP *
@@ -2859,7 +2870,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;
@@ -3084,8 +3095,8 @@ 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;
     }
@@ -3533,7 +3544,7 @@ PP(pp_leaveeval)
        !(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 */