This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_sv_vcatpvfn_flags: fix arg to SNPRINTF_G()
[perl5.git] / scope.c
diff --git a/scope.c b/scope.c
index 716151d..a7c17e8 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -36,7 +36,7 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
 
     if (UNLIKELY(n < 0))
         Perl_croak(aTHX_
-            "panic: stack_grow() negative count (%"IVdf")", (IV)n);
+            "panic: stack_grow() negative count (%" IVdf ")", (IV)n);
 
     PL_stack_sp = sp;
     extra =
@@ -90,11 +90,12 @@ I32
 Perl_cxinc(pTHX)
 {
     const IV old_max = cxstack_max;
-    cxstack_max = GROW(cxstack_max);
-    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
+    const IV new_max = GROW(cxstack_max);
+    Renew(cxstack, new_max + 1, PERL_CONTEXT);
+    cxstack_max = new_max;
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
-    PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
+    PoisonNew(cxstack + old_max + 1, new_max - old_max, PERL_CONTEXT);
     return cxstack_ix + 1;
 }
 
@@ -102,11 +103,12 @@ void
 Perl_push_scope(pTHX)
 {
     if (UNLIKELY(PL_scopestack_ix == PL_scopestack_max)) {
-       PL_scopestack_max = GROW(PL_scopestack_max);
-       Renew(PL_scopestack, PL_scopestack_max, I32);
+        const IV new_max = GROW(PL_scopestack_max);
+       Renew(PL_scopestack, new_max, I32);
 #ifdef DEBUGGING
-       Renew(PL_scopestack_name, PL_scopestack_max, const char*);
+       Renew(PL_scopestack_name, new_max, const char*);
 #endif
+       PL_scopestack_max = new_max;
     }
 #ifdef DEBUGGING
     PL_scopestack_name[PL_scopestack_ix] = "unknown";
@@ -132,7 +134,7 @@ Perl_markstack_grow(pTHX)
     PL_markstack_max = PL_markstack + newmax;
     PL_markstack_ptr = PL_markstack + oldmax;
     DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
-            "MARK grow %p %"IVdf" by %"IVdf"\n",
+            "MARK grow %p %" IVdf " by %" IVdf "\n",
             PL_markstack_ptr, (IV)*PL_markstack_ptr, (IV)oldmax)));
     return PL_markstack_ptr;
 }
@@ -140,23 +142,26 @@ Perl_markstack_grow(pTHX)
 void
 Perl_savestack_grow(pTHX)
 {
+    IV new_max;
 #ifdef STRESS_REALLOC
-    PL_savestack_max += SS_MAXPUSH;
+    new_max = PL_savestack_max + SS_MAXPUSH;
 #else
-    PL_savestack_max = GROW(PL_savestack_max);
+    new_max = GROW(PL_savestack_max);
 #endif
     /* Note that we allocate SS_MAXPUSH slots higher than ss_max
      * so that SS_ADD_END(), SSGROW() etc can do a simper check */
-    Renew(PL_savestack, PL_savestack_max + SS_MAXPUSH, ANY);
+    Renew(PL_savestack, new_max + SS_MAXPUSH, ANY);
+    PL_savestack_max = new_max;
 }
 
 void
 Perl_savestack_grow_cnt(pTHX_ I32 need)
 {
-    PL_savestack_max = PL_savestack_ix + need;
+    const IV new_max = PL_savestack_ix + need;
     /* Note that we allocate SS_MAXPUSH slots higher than ss_max
      * so that SS_ADD_END(), SSGROW() etc can do a simper check */
-    Renew(PL_savestack, PL_savestack_max + SS_MAXPUSH, ANY);
+    Renew(PL_savestack, new_max + SS_MAXPUSH, ANY);
+    PL_savestack_max = new_max;
 }
 
 #undef GROW
@@ -186,8 +191,8 @@ Perl_tmps_grow_p(pTHX_ SSize_t ix)
     if (ix - PL_tmps_max < 128)
        extend_to += (PL_tmps_max < 512) ? 128 : 512;
 #endif
+    Renew(PL_tmps_stack, extend_to + 1, SV*);
     PL_tmps_max = extend_to + 1;
-    Renew(PL_tmps_stack, PL_tmps_max, SV*);
     return ix;
 }
 
@@ -584,7 +589,7 @@ Perl_save_clearsv(pTHX_ SV **svp)
     ASSERT_CURPAD_ACTIVE("save_clearsv");
     SvPADSTALE_off(*svp); /* mark lexical as active */
     if (UNLIKELY((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)) {
-       Perl_croak(aTHX_ "panic: pad offset %"UVuf" out of range (%p-%p)",
+       Perl_croak(aTHX_ "panic: pad offset %" UVuf " out of range (%p-%p)",
                   offset, svp, PL_curpad);
     }
 
@@ -772,7 +777,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
 
     if (UNLIKELY((elems_shifted >> SAVE_TIGHT_SHIFT) != elems))
        Perl_croak(aTHX_
-            "panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")",
+            "panic: save_alloc elems %" UVuf " out of range (%" IVdf "-%" IVdf ")",
                   elems, (IV)size, (IV)pad);
 
     SSGROW(elems + 1);
@@ -783,7 +788,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
 }
 
 
-static U8 arg_counts[] = {
+static const U8 arg_counts[] = {
     0, /* SAVEt_ALLOC              */
     0, /* SAVEt_CLEARPADRANGE      */
     0, /* SAVEt_CLEARSV            */
@@ -854,8 +859,6 @@ Perl_leave_scope(pTHX_ I32 base)
     while (PL_savestack_ix > base) {
        UV uv;
        U8 type;
-        SV **svp;
-        I32 i;
         ANY *ap; /* arg pointer */
         ANY a0, a1, a2; /* up to 3 args */
 
@@ -888,18 +891,18 @@ Perl_leave_scope(pTHX_ I32 base)
               function, S_save_scalar_at(), so has to stay in this file.  */
        case SAVEt_SVREF:                       /* scalar reference */
             a0 = ap[0]; a1 = ap[1];
-           svp = a0.any_svp;
+           a2.any_svp = a0.any_svp;
            a0.any_sv = NULL; /* what to refcnt_dec */
            goto restore_sv;
 
        case SAVEt_SV:                          /* scalar reference */
             a0 = ap[0]; a1 = ap[1];
-           svp = &GvSV(a0.any_gv);
+           a2.any_svp = &GvSV(a0.any_gv);
        restore_sv:
         {
-            /* do *svp = a1 and free a0 */
-           SV * const sv = *svp;
-           *svp = a1.any_sv;
+            /* do *a2.any_svp = a1 and free a0 */
+           SV * const sv = *a2.any_svp;
+           *a2.any_svp = a1.any_sv;
            SvREFCNT_dec(sv);
             if (UNLIKELY(SvSMAGICAL(a1.any_sv))) {
                 /* mg_set could die, skipping the freeing of a0 and
@@ -942,17 +945,16 @@ Perl_leave_scope(pTHX_ I32 base)
 
        case SAVEt_GVSV:                        /* scalar slot in GV */
             a0 = ap[0]; a1 = ap[1];
-           svp = &GvSV(a0.any_gv);
+           a0.any_svp = &GvSV(a0.any_gv);
            goto restore_svp;
 
        case SAVEt_GENERIC_SVREF:               /* generic sv */
             a0 = ap[0]; a1 = ap[1];
-            svp = a0.any_svp;
        restore_svp:
         {
-            /* do *svp = a1 */
-           SV * const sv = *svp;
-           *svp = a1.any_sv;
+            /* do *a0.any_svp = a1 */
+           SV * const sv = *a0.any_svp;
+           *a0.any_svp = a1.any_sv;
            SvREFCNT_dec(sv);
            SvREFCNT_dec(a1.any_sv);
            break;
@@ -963,19 +965,19 @@ Perl_leave_scope(pTHX_ I32 base)
             HV * hv;
             a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
             hv = GvSTASH(a0.any_gv);
-           svp = a1.any_svp;
            if (hv && HvENAME(hv) && (
                    (a2.any_sv && SvTYPE(a2.any_sv) == SVt_PVCV)
-                || (*svp && SvTYPE(*svp) == SVt_PVCV)
+                || (*a1.any_svp && SvTYPE(*a1.any_svp) == SVt_PVCV)
               ))
            {
-               if ((char *)svp < (char *)GvGP(a0.any_gv)
-                || (char *)svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp)
+               if ((char *)a1.any_svp < (char *)GvGP(a0.any_gv)
+                || (char *)a1.any_svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp)
                 || GvREFCNT(a0.any_gv) > 2) /* "> 2" to ignore savestack's ref */
                    PL_sub_generation++;
                else mro_method_changed_in(hv);
            }
-            a1.any_sv = a2.any_sv;
+            a0.any_svp = a1.any_svp;
+            a1.any_sv  = a2.any_sv;
            goto restore_svp;
         }
 
@@ -1055,24 +1057,12 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
 
        case SAVEt_SPTR:                        /* SV* reference */
-            a0 = ap[0]; a1 = ap[1];
-           *a1.any_svp= a0.any_sv;
-           break;
-
        case SAVEt_VPTR:                        /* random* reference */
        case SAVEt_PPTR:                        /* char* reference */
-            a0 = ap[0]; a1 = ap[1];
-           *a1.any_pvp = a0.any_pv;
-           break;
-
        case SAVEt_HPTR:                        /* HV* reference */
-            a0 = ap[0]; a1 = ap[1];
-           *(HV**)a1.any_ptr = a0.any_hv;
-           break;
-
        case SAVEt_APTR:                        /* AV* reference */
             a0 = ap[0]; a1 = ap[1];
-           *(AV**)a1.any_ptr = a0.any_av;
+           *a1.any_svp= a0.any_sv;
            break;
 
        case SAVEt_GP:                          /* scalar reference */
@@ -1121,7 +1111,7 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_FREEOP:
             a0 = ap[0];
            ASSERT_CURPAD_LEGAL("SAVEt_FREEOP");
-           op_free((OP*)a0.any_ptr);
+           op_free(a0.any_op);
            break;
 
        case SAVEt_FREEPV:
@@ -1130,8 +1120,11 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
 
         case SAVEt_CLEARPADRANGE:
+        {
+            I32 i;
+           SV **svp;
             i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
-           svp = &PL_curpad[uv >>
+            svp = &PL_curpad[uv >>
                     (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
             goto clearsv;
        case SAVEt_CLEARSV:
@@ -1142,7 +1135,7 @@ Perl_leave_scope(pTHX_ I32 base)
                 SV *sv = *svp;
 
                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-             "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
+             "Pad 0x%" UVxf "[0x%" UVxf "] clearsv: %ld sv=0x%" UVxf "<%" IVdf "> %s\n",
                     PTR2UV(PL_comppad), PTR2UV(PL_curpad),
                     (long)(svp-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
                     (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
@@ -1248,6 +1241,7 @@ Perl_leave_scope(pTHX_ I32 base)
                 }
             }
            break;
+        }
 
        case SAVEt_DELETE:
             a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
@@ -1279,6 +1273,8 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
 
        case SAVEt_AELEM:               /* array element */
+        {
+            SV **svp;
             a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
            svp = av_fetch(a0.any_av, a1.any_iv, 1);
            if (UNLIKELY(!AvREAL(a0.any_av) && AvREIFY(a0.any_av))) /* undo reify guard */
@@ -1288,13 +1284,15 @@ Perl_leave_scope(pTHX_ I32 base)
                if (LIKELY(sv && sv != &PL_sv_undef)) {
                    if (UNLIKELY(SvTIED_mg((const SV *)a0.any_av, PERL_MAGIC_tied)))
                        SvREFCNT_inc_void_NN(sv);
-                    a1.any_sv = a2.any_sv;
+                    a1.any_sv  = a2.any_sv;
+                    a2.any_svp = svp;
                    goto restore_sv;
                }
            }
            SvREFCNT_dec(a0.any_av);
            SvREFCNT_dec(a2.any_sv);
            break;
+        }
 
        case SAVEt_HELEM:               /* hash element */
         {
@@ -1306,10 +1304,11 @@ Perl_leave_scope(pTHX_ I32 base)
            if (LIKELY(he)) {
                const SV * const oval = HeVAL(he);
                if (LIKELY(oval && oval != &PL_sv_undef)) {
-                   svp = &HeVAL(he);
+                    SV **svp = &HeVAL(he);
                    if (UNLIKELY(SvTIED_mg((const SV *)a0.any_hv, PERL_MAGIC_tied)))
                        SvREFCNT_inc_void(*svp);
-                    a1.any_sv = a2.any_sv;
+                    a1.any_sv  = a2.any_sv;
+                    a2.any_svp = svp;
                    goto restore_sv;
                }
            }
@@ -1317,6 +1316,7 @@ Perl_leave_scope(pTHX_ I32 base)
            SvREFCNT_dec(a2.any_sv);
            break;
         }
+
        case SAVEt_OP:
             a0 = ap[0];
            PL_op = (OP*)a0.any_ptr;
@@ -1439,7 +1439,8 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
 
        default:
-           Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
+           Perl_croak(aTHX_ "panic: leave_scope inconsistency %u",
+                    (U8)uv & SAVE_MASK);
        }
     }
 
@@ -1456,12 +1457,12 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
     if (CxTYPE(cx) != CXt_SUBST) {
        const char *gimme_text;
        PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
-       PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%" UVxf "\n",
                      PTR2UV(cx->blk_oldcop));
        PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDSAVEIX = %ld\n", (long)cx->blk_oldsaveix);
-       PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%" UVxf "\n",
                      PTR2UV(cx->blk_oldpm));
        switch (cx->blk_gimme) {
            case G_VOID:
@@ -1484,26 +1485,26 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
     case CXt_BLOCK:
        break;
     case CXt_FORMAT:
-       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%" UVxf "\n",
                PTR2UV(cx->blk_format.cv));
-       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%" UVxf "\n",
                PTR2UV(cx->blk_format.gv));
-       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%" UVxf "\n",
                PTR2UV(cx->blk_format.dfoutgv));
        PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n",
                      (int)CxHASARGS(cx));
-       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%" UVxf "\n",
                PTR2UV(cx->blk_format.retop));
        break;
     case CXt_SUB:
-       PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%" UVxf "\n",
                PTR2UV(cx->blk_sub.cv));
        PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
                (long)cx->blk_sub.olddepth);
        PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
                (int)CxHASARGS(cx));
        PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx));
-       PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%" UVxf "\n",
                PTR2UV(cx->blk_sub.retop));
        break;
     case CXt_EVAL:
@@ -1515,9 +1516,9 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
        if (cx->blk_eval.old_namesv)
            PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
                          SvPVX_const(cx->blk_eval.old_namesv));
-       PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%" UVxf "\n",
                PTR2UV(cx->blk_eval.old_eval_root));
-       PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%" UVxf "\n",
                PTR2UV(cx->blk_eval.retop));
        break;
 
@@ -1527,15 +1528,15 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
     case CXt_LOOP_LIST:
     case CXt_LOOP_ARY:
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%" UVxf "\n",
                PTR2UV(cx->blk_loop.my_op));
         if (CxTYPE(cx) != CXt_LOOP_PLAIN) {
-            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
+            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%" UVxf "\n",
                     PTR2UV(CxITERVAR(cx)));
-            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n",
+            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%" UVxf "\n",
                     PTR2UV(cx->blk_loop.itersave));
             /* XXX: not accurate for LAZYSV/IV/LIST */
-            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
+            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%" UVxf "\n",
                     PTR2UV(cx->blk_loop.state_u.ary.ary));
             PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
                     (long)cx->blk_loop.state_u.ary.ix);
@@ -1553,17 +1554,17 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                (long)CxONCE(cx));
        PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
                cx->sb_orig);
-       PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%" UVxf "\n",
                PTR2UV(cx->sb_dstr));
-       PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%" UVxf "\n",
                PTR2UV(cx->sb_targ));
-       PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_S = 0x%" UVxf "\n",
                PTR2UV(cx->sb_s));
-       PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_M = 0x%" UVxf "\n",
                PTR2UV(cx->sb_m));
-       PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%" UVxf "\n",
                PTR2UV(cx->sb_strend));
-       PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
+       PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%" UVxf "\n",
                PTR2UV(cx->sb_rxres));
        break;
     }