remove -Dmad string length restriction

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 3f68d9c..8222aae 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -884,7 +884,7 @@ static const struct body_details bodies_by_type[] = {
     /* The bind placeholder pretends to be an RV for now.
        Also it's marked as "can't upgrade" to stop anyone using it before it's
        implemented.  */
-    { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
+    { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 },
 
     /* IVs are in the head, so the allocation size is 0.  */
     { 0,
@@ -1474,10 +1474,6 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
 
     PERL_ARGS_ASSERT_SV_GROW;
 
-    if (PL_madskills && newlen >= 0x100000) {
-       PerlIO_printf(Perl_debug_log,
-                     "Allocation too large: %"UVxf"\n", (UV)newlen);
-    }
 #ifdef HAS_64K_LIMIT
     if (newlen >= 0x10000) {
        PerlIO_printf(Perl_debug_log,
@@ -1507,6 +1503,18 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
        s = SvPVX_mutable(sv);
     }
 
+#ifdef PERL_NEW_COPY_ON_WRITE
+    /* the new COW scheme uses SvPVX(sv)[SvLEN(sv)-1] (if spare)
+     * to store the COW count. So in general, allocate one more byte than
+     * asked for, to make it likely this byte is always spare: and thus
+     * make more strings COW-able.
+     * If the new size is a big power of two, don't bother: we assume the
+     * caller wanted a nice 2^N sized block and will be annoyed at getting
+     * 2^N+1 */
+    if (newlen & 0xff)
+        newlen++;
+#endif
+
     if (newlen > SvLEN(sv)) {          /* need more room? */
        STRLEN minlen = SvCUR(sv);
        minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10;
@@ -3734,6 +3742,15 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
            );
     }
     else if(mro_changes) mro_method_changed_in(GvSTASH(dstr));
+    if (GvIO(dstr) && dtype == SVt_PVGV) {
+       DEBUG_o(Perl_deb(aTHX_
+                       "glob_assign_glob clearing PL_stashcache\n"));
+       /* It's a cache. It will rebuild itself quite happily.
+          It's a lot of effort to work out exactly which key (or keys)
+          might be invalidated by the creation of the this file handle.
+        */
+       hv_clear(PL_stashcache);
+    }
     return;
 }
 
@@ -4073,7 +4090,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags)
        }
        break;
 
-       /* case SVt_BIND: */
+       /* case SVt_DUMMY: */
     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVMG:
@@ -6136,7 +6153,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
                SvREFCNT_dec(SvSTASH(sv));
        }
        switch (type) {
-           /* case SVt_BIND: */
+           /* case SVt_DUMMY: */
        case SVt_PVIO:
            if (IoIFP(sv) &&
                IoIFP(sv) != PerlIO_stdin() &&
@@ -8982,7 +8999,7 @@ Perl_sv_resetpvn(pTHX_ const char *s, STRLEN len, HV * const stash)
     char todo[PERL_UCHAR_MAX+1];
     const char *send;
 
-    if (!stash)
+    if (!stash || SvTYPE(stash) != SVt_PVHV)
        return;
 
     if (!s) {          /* reset ?? searches */
@@ -9406,7 +9423,7 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
                                    ? "GLOB" : "SCALAR");
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
-       case SVt_BIND:          return "BIND";
+       case SVt_DUMMY:         return "DUMMY";
        case SVt_REGEXP:        return "REGEXP";
        default:                return "UNKNOWN";
        }
@@ -11325,13 +11342,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
 
        have = esignlen + zeros + elen;
        if (have < zeros)
-           croak_memory_wrap();
+           Perl_croak_memory_wrap();
 
        need = (have > width ? have : width);
        gap = need - have;
 
        if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1))
-           croak_memory_wrap();
+           Perl_croak_memory_wrap();
        SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {
@@ -12133,7 +12150,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
-       /* case SVt_BIND: */
+       /* case SVt_DUMMY: */
     default:
        {
            /* These are all the types that need complex bodies allocating.  */
@@ -12349,6 +12366,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                        }
                        daux->xhv_name_count = saux->xhv_name_count;
 
+                       daux->xhv_fill_lazy = saux->xhv_fill_lazy;
                        daux->xhv_riter = saux->xhv_riter;
                        daux->xhv_eiter = saux->xhv_eiter
                            ? he_dup(saux->xhv_eiter,
@@ -12888,43 +12906,6 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            sv = (const SV *)POPPTR(ss,ix);
            TOPPTR(nss,ix) = sv_dup(sv, param);
            break;
-       case SAVEt_RE_STATE:
-           {
-               const struct re_save_state *const old_state
-                   = (struct re_save_state *)
-                   (ss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
-               struct re_save_state *const new_state
-                   = (struct re_save_state *)
-                   (nss + ix - SAVESTACK_ALLOC_FOR_RE_SAVE_STATE);
-
-               Copy(old_state, new_state, 1, struct re_save_state);
-               ix -= SAVESTACK_ALLOC_FOR_RE_SAVE_STATE;
-
-               new_state->re_state_bostr
-                   = pv_dup(old_state->re_state_bostr);
-               new_state->re_state_regeol
-                   = pv_dup(old_state->re_state_regeol);
-#ifdef PERL_ANY_COW
-               new_state->re_state_nrs
-                   = sv_dup(old_state->re_state_nrs, param);
-#endif
-               new_state->re_state_reg_magic
-                   = (MAGIC*) any_dup(old_state->re_state_reg_magic, 
-                              proto_perl);
-               new_state->re_state_reg_oldcurpm
-                   = (PMOP*) any_dup(old_state->re_state_reg_oldcurpm, 
-                             proto_perl);
-               new_state->re_state_reg_curpm
-                   = (PMOP*)  any_dup(old_state->re_state_reg_curpm, 
-                              proto_perl);
-               new_state->re_state_reg_oldsaved
-                   = pv_dup(old_state->re_state_reg_oldsaved);
-               new_state->re_state_reg_poscache
-                   = pv_dup(old_state->re_state_reg_poscache);
-               new_state->re_state_reg_starttry
-                   = pv_dup(old_state->re_state_reg_starttry);
-               break;
-           }
        case SAVEt_COMPILE_WARNINGS:
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
@@ -13182,8 +13163,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #endif
 
     /* RE engine related */
-    Zero(&PL_reg_state, 1, struct re_save_state);
     PL_regmatch_slab   = NULL;
+    PL_reg_curpm       = NULL;
 
     PL_sub_generation  = proto_perl->Isub_generation;
 
@@ -13348,7 +13329,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* regex stuff */
 
-    PL_regdummy                = proto_perl->Iregdummy;
     PL_colorset                = 0;            /* reinits PL_colors[] */
     /*PL_colors[6]     = {0,0,0,0,0,0};*/
 
@@ -13690,7 +13670,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_errors          = sv_dup_inc(proto_perl->Ierrors, param);
 
     PL_sortcop         = (OP*)any_dup(proto_perl->Isortcop, proto_perl);
-    PL_sortstash       = hv_dup(proto_perl->Isortstash, param);
     PL_firstgv         = gv_dup(proto_perl->Ifirstgv, param);
     PL_secondgv                = gv_dup(proto_perl->Isecondgv, param);