[perl #77930] cx_stack reallocation during sort

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 9f9da42..95fe5f7 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -77,7 +77,7 @@ Perl_cxinc(pTHX)
     dVAR;
     const IV old_max = cxstack_max;
     cxstack_max = GROW(cxstack_max);
-    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
+    Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);
     /* 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);
@@ -392,10 +392,16 @@ void
 Perl_save_int(pTHX_ int *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_INT;
 
-    save_pushi32ptr(*intp, intp, SAVEt_INT);
+    if ((int)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+       SSCHECK(2);
+       SSPUSHPTR(intp);
+       SSPUSHUV(SAVEt_INT_SMALL | shifted);
+    } else
+       save_pushi32ptr(*intp, intp, SAVEt_INT);
 }
 
 void
@@ -417,17 +423,25 @@ Perl_save_I16(pTHX_ I16 *intp)
 
     PERL_ARGS_ASSERT_SAVE_I16;
 
-    save_pushi32ptr(*intp, intp, SAVEt_I16);
+    SSCHECK(2);
+    SSPUSHPTR(intp);
+    SSPUSHUV(SAVEt_I16 | ((UV)*intp << 8));
 }
 
 void
 Perl_save_I32(pTHX_ I32 *intp)
 {
     dVAR;
+    const UV shifted = (UV)*intp << SAVE_TIGHT_SHIFT;
 
     PERL_ARGS_ASSERT_SAVE_I32;
 
-    save_pushi32ptr(*intp, intp, SAVEt_I32);
+    if ((I32)(shifted >> SAVE_TIGHT_SHIFT) == *intp) {
+       SSCHECK(2);
+       SSPUSHPTR(intp);
+       SSPUSHUV(SAVEt_I32_SMALL | shifted);
+    } else
+       save_pushi32ptr(*intp, intp, SAVEt_I32);
 }
 
 /* Cannot use save_sptr() to store a char* since the SV** cast will
@@ -594,7 +608,7 @@ Perl_save_hints(pTHX)
     if (PL_hints & HINT_LOCALIZE_HH) {
        save_pushptri32ptr(GvHV(PL_hintgv), PL_hints,
                           PL_compiling.cop_hints_hash, SAVEt_HINTS);
-       GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv));
+       GvHV(PL_hintgv) = hv_copy_hints_hv(GvHV(PL_hintgv));
     } else {
        save_pushi32ptr(PL_hints, PL_compiling.cop_hints_hash, SAVEt_HINTS);
     }
@@ -764,9 +778,15 @@ Perl_leave_scope(pTHX_ I32 base)
                *(char**)ptr = str;
            }
            break;
+       case SAVEt_GVSV:                        /* scalar slot in GV */
+           value = MUTABLE_SV(SSPOPPTR);
+           gv = MUTABLE_GV(SSPOPPTR);
+           ptr = &GvSV(gv);
+           goto restore_svp;
        case SAVEt_GENERIC_SVREF:               /* generic sv */
            value = MUTABLE_SV(SSPOPPTR);
            ptr = SSPOPPTR;
+       restore_svp:
            sv = *(SV**)ptr;
            *(SV**)ptr = value;
            SvREFCNT_dec(sv);
@@ -794,6 +814,10 @@ Perl_leave_scope(pTHX_ I32 base)
                PL_localizing = 0;
            }
            break;
+       case SAVEt_INT_SMALL:
+           ptr = SSPOPPTR;
+           *(int*)ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
+           break;
        case SAVEt_INT:                         /* int reference */
            ptr = SSPOPPTR;
            *(int*)ptr = (int)SSPOPINT;
@@ -802,6 +826,10 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(bool*)ptr = cBOOL(uv >> 8);
            break;
+       case SAVEt_I32_SMALL:
+           ptr = SSPOPPTR;
+           *(I32*)ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
+           break;
        case SAVEt_I32:                         /* I32 reference */
            ptr = SSPOPPTR;
 #ifdef PERL_DEBUG_READONLY_OPS
@@ -1086,7 +1114,7 @@ Perl_leave_scope(pTHX_ I32 base)
 
        case SAVEt_I16:                         /* I16 reference */
            ptr = SSPOPPTR;
-           *(I16*)ptr = (I16)SSPOPINT;
+           *(I16*)ptr = (I16)(uv >> 8);
            break;
        case SAVEt_I8:                          /* I8 reference */
            ptr = SSPOPPTR;
@@ -1210,8 +1238,6 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                (long)cx->blk_loop.resetsp);
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.my_op));
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
-               PTR2UV(CX_LOOP_NEXTOP_GET(cx)));
        /* XXX: not accurate for LAZYSV/IV */
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.state_u.ary.ary));