move body of pp_concat() to S_do_concat()

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 4b302e7..83a7b76 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -55,6 +55,10 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n)
         Perl_croak(aTHX_ "Out of memory during stack extend");
 
     av_extend(PL_curstack, current + n + extra);
+#ifdef DEBUGGING
+        PL_curstackinfo->si_stack_hwm = current + n + extra;
+#endif
+
     return PL_stack_sp;
 }
 
@@ -90,11 +94,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 +107,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";
@@ -140,23 +146,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 +195,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;
 }
 
@@ -321,6 +330,17 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
     PERL_ARGS_ASSERT_SAVE_GP;
 
+    /* XXX For now, we just upgrade any coderef in the stash to a full GV
+           during localisation.  Maybe at some point we could make localis-
+           ation work without needing the upgrade.  (In which case our
+           callers should probably call a different function, not save_gp.)
+     */
+    if (!isGV(gv)) {
+        assert(isGV_or_RVCV(gv));
+        (void)CvGV(SvRV((SV *)gv)); /* CvGV does the upgrade */
+        assert(isGV(gv));
+    }
+
     save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
 
     if (empty) {
@@ -329,7 +349,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
        bool isa_changed = 0;
 
        if (stash && HvENAME(stash)) {
-           if (GvNAMELEN(gv) == 3 && strnEQ(GvNAME(gv), "ISA", 3))
+           if (memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
                isa_changed = TRUE;
            else if (GvCVu(gv))
                /* taking a method out of circulation ("local")*/
@@ -783,7 +803,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            */
@@ -1071,9 +1091,7 @@ Perl_leave_scope(pTHX_ I32 base)
            gp_free(a0.any_gv);
            GvGP_set(a0.any_gv, (GP*)a1.any_ptr);
            if ((hv=GvSTASH(a0.any_gv)) && HvENAME_get(hv)) {
-               if (   GvNAMELEN(a0.any_gv) == 3
-                    && strnEQ(GvNAME(a0.any_gv), "ISA", 3)
-                )
+               if (memEQs(GvNAME(a0.any_gv), GvNAMELEN(a0.any_gv), "ISA"))
                    mro_isa_changed_in(hv);
                 else if (had_method || GvCVu(a0.any_gv))
                     /* putting a method back into circulation ("local")*/      
@@ -1185,10 +1203,7 @@ Perl_leave_scope(pTHX_ I32 base)
                         break;
                     case SVt_PVCV:
                     {
-                        HEK *hek =
-                             CvNAMED(sv)
-                               ? CvNAME_HEK((CV *)sv)
-                               : GvNAME_HEK(CvGV(sv));
+                        HEK *hek = CvGvNAME_HEK(sv);
                         assert(hek);
                         (void)share_hek_hek(hek);
                         cv_undef((CV *)sv);
@@ -1214,9 +1229,7 @@ Perl_leave_scope(pTHX_ I32 base)
                     case SVt_PVHV:     *svp = MUTABLE_SV(newHV());     break;
                     case SVt_PVCV:
                     {
-                        HEK * const hek = CvNAMED(sv)
-                                             ? CvNAME_HEK((CV *)sv)
-                                             : GvNAME_HEK(CvGV(sv));
+                        HEK * const hek = CvGvNAME_HEK(sv);
 
                         /* Create a stub */
                         *svp = newSV_type(SVt_PVCV);
@@ -1530,7 +1543,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                     PTR2UV(CxITERVAR(cx)));
             PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%" UVxf "\n",
                     PTR2UV(cx->blk_loop.itersave));
-            /* XXX: not accurate for LAZYSV/IV/LIST */
+       }
+       if (CxTYPE(cx) == CXt_LOOP_ARY) {
             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",