Save the regexp engine state as 1 block on the save stack.

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 234dd9f..d7e4d5e 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -62,7 +62,7 @@ Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
     Newx(si->si_cxstack, cxitems, PERL_CONTEXT);
     /* Without any kind of initialising PUSHSUBST()
      * in pp_subst() will read uninitialised heap. */
-    Poison(si->si_cxstack, cxitems, PERL_CONTEXT);
+    PoisonNew(si->si_cxstack, cxitems, PERL_CONTEXT);
     return si;
 }
 
@@ -75,7 +75,7 @@ Perl_cxinc(pTHX)
     Renew(cxstack, cxstack_max + 1, PERL_CONTEXT);     /* XXX should fix CXINC macro */
     /* Without any kind of initialising deep enough recursion
      * will end up reading uninitialised PERL_CONTEXTs. */
-    Poison(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
+    PoisonNew(cxstack + old_max + 1, cxstack_max - old_max, PERL_CONTEXT);
     return cxstack_ix + 1;
 }
 
@@ -165,6 +165,12 @@ S_save_scalar_at(pTHX_ SV **sptr)
     SV * const osv = *sptr;
     register SV * const sv = *sptr = newSV(0);
 
+#ifdef PERL_MAD
+    /* FIXME for MAD - this is causing ext/Safe/t/safeops.t to abort.  */
+    if (PL_formfeed && sv == PL_formfeed)
+       abort();
+#endif
+
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
        if (SvGMAGICAL(osv)) {
            const bool oldtainted = PL_tainted;
@@ -182,6 +188,10 @@ Perl_save_scalar(pTHX_ GV *gv)
 {
     dVAR;
     SV ** const sptr = &GvSVn(gv);
+#ifdef PERL_MAD
+    if (PL_formfeed && *sptr == PL_formfeed)
+       abort();
+#endif
     PL_localizing = 1;
     SvGETMAGIC(*sptr);
     PL_localizing = 0;
@@ -198,6 +208,10 @@ void
 Perl_save_generic_svref(pTHX_ SV **sptr)
 {
     dVAR;
+#ifdef PERL_MAD
+    if (PL_formfeed && *sptr == PL_formfeed)
+       abort();
+#endif
     SSCHECK(3);
     SSPUSHPTR(sptr);
     SSPUSHPTR(SvREFCNT_inc(*sptr));
@@ -324,6 +338,11 @@ Perl_save_item(pTHX_ register SV *item)
     dVAR;
     register SV * const sv = newSVsv(item);
 
+#ifdef PERL_MAD
+    if (PL_formfeed && item == PL_formfeed)
+       abort();
+#endif
+
     SSCHECK(3);
     SSPUSHPTR(item);           /* remember the pointer */
     SSPUSHPTR(sv);             /* remember the value */
@@ -542,6 +561,10 @@ SV*
 Perl_save_svref(pTHX_ SV **sptr)
 {
     dVAR;
+#ifdef PERL_MAD
+    if (PL_formfeed && *sptr == PL_formfeed)
+       abort();
+#endif
     SvGETMAGIC(*sptr);
     SSCHECK(3);
     SSPUSHPTR(sptr);
@@ -567,9 +590,7 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
                                - (char*)PL_savestack);
     register const I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
 
-    /* SSCHECK may not be good enough */
-    while (PL_savestack_ix + elems + 2 > PL_savestack_max)
-       savestack_grow();
+    SSGROW(elems + 2);
 
     PL_savestack_ix += elems;
     SSPUSHINT(elems);
@@ -803,7 +824,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            hv = (HV*)ptr;
            ptr = SSPOPPTR;
-           (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
+           (void)hv_delete(hv, (char*)ptr, (I32)SSPOPINT, G_DISCARD);
            SvREFCNT_dec(hv);
            Safefree(ptr);
            break;
@@ -867,11 +888,33 @@ Perl_leave_scope(pTHX_ I32 base)
                GvHV(PL_hintgv) = NULL;
            }
            *(I32*)&PL_hints = (I32)SSPOPINT;
+           Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
+           PL_compiling.cop_hints = (struct refcounted_he *) SSPOPPTR;
            if (PL_hints & HINT_LOCALIZE_HH) {
                SvREFCNT_dec((SV*)GvHV(PL_hintgv));
                GvHV(PL_hintgv) = (HV*)SSPOPPTR;
+               assert(GvHV(PL_hintgv));
+           } else if (!GvHV(PL_hintgv)) {
+               /* Need to add a new one manually, else gv_fetchpv() can
+                  add one in this code:
+                  
+                  if (SvTYPE(gv) == SVt_PVGV) {
+                      if (add) {
+                      GvMULTI_on(gv);
+                      gv_init_sv(gv, sv_type);
+                      if (*name=='!' && sv_type == SVt_PVHV && len==1)
+                          require_errno(gv);
+                      }
+                      return gv;
+                  }
+
+                  and it won't have the magic set.  */
+
+               HV *const hv = newHV();
+               hv_magic(hv, NULL, PERL_MAGIC_hints);
+               GvHV(PL_hintgv) = hv;
            }
-                   
+           assert(GvHV(PL_hintgv));
            break;
        case SAVEt_COMPPAD:
            PL_comppad = (PAD*)SSPOPPTR;
@@ -936,6 +979,64 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            (*SSPOPDPTR)(ptr);
            break;
+       case SAVEt_COP_ARYBASE:
+           ptr = SSPOPPTR;
+           i = SSPOPINT;
+           CopARYBASE_set((COP *)ptr, i);
+           break;
+       case SAVEt_RE_STATE:
+           {
+               const struct re_save_state *const state
+                   = (struct re_save_state *)
+                   (PL_savestack + PL_savestack_ix
+                    - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
+               PL_savestack_ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
+
+               PL_reg_flags = state->re_state_reg_flags;
+               PL_bostr = state->re_state_bostr;
+               PL_reginput = state->re_state_reginput;
+               PL_regbol = state->re_state_regbol;
+               PL_regeol = state->re_state_regeol;
+               PL_regstartp = state->re_state_regstartp;
+               PL_regendp = state->re_state_regendp;
+               PL_reglastparen = state->re_state_reglastparen;
+               PL_reglastcloseparen = state->re_state_reglastcloseparen;
+               PL_regtill = state->re_state_regtill;
+               if (PL_reg_start_tmp != state->re_state_reg_start_tmp) {
+                   Safefree(PL_reg_start_tmp);
+                   PL_reg_start_tmp = state->re_state_reg_start_tmp;
+               }
+               PL_reg_start_tmpl = state->re_state_reg_start_tmpl;
+               PL_reg_eval_set = state->re_state_reg_eval_set;
+               PL_regnarrate = state->re_state_regnarrate;
+               PL_regindent = state->re_state_regindent;
+               PL_reg_call_cc = state->re_state_reg_call_cc;
+               PL_reg_re = state->re_state_reg_re;
+               PL_reg_ganch = state->re_state_reg_ganch;
+               PL_reg_sv = state->re_state_reg_sv;
+               PL_reg_match_utf8 = state->re_state_reg_match_utf8;
+               PL_reg_magic = state->re_state_reg_magic;
+               PL_reg_oldpos = state->re_state_reg_oldpos;
+               PL_reg_oldcurpm = state->re_state_reg_oldcurpm;
+               PL_reg_curpm = state->re_state_reg_curpm;
+               PL_reg_oldsaved = state->re_state_reg_oldsaved;
+               PL_reg_oldsavedlen = state->re_state_reg_oldsavedlen;
+               PL_reg_maxiter = state->re_state_reg_maxiter;
+               PL_reg_leftiter = state->re_state_reg_leftiter;
+               if (PL_reg_poscache != state->re_state_reg_poscache) {
+                   Safefree(PL_reg_poscache);
+                   PL_reg_poscache = state->re_state_reg_poscache;
+               }
+               PL_reg_poscache_size = state->re_state_reg_poscache_size;
+               PL_regsize = state->re_state_regsize;
+#ifdef DEBUGGING
+               PL_reg_starttry = state->re_state_reg_starttry;
+#endif
+#ifdef PERL_OLD_COPY_ON_WRITE
+               PL_nrs = state->re_state_nrs;
+#endif
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }