Further conversion of overload.t

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 44cb50a..e5e997c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -587,18 +587,6 @@ struct arena_set {
     struct arena_desc set[ARENAS_PER_SET];
 };
 
-#if !ARENASETS
-
-static void 
-S_free_arena(pTHX_ void **root) {
-    while (root) {
-       void ** const next = *(void **)root;
-       Safefree(root);
-       root = next;
-    }
-}
-#endif
-
 /*
 =for apidoc sv_free_arenas
 
@@ -627,7 +615,6 @@ Perl_sv_free_arenas(pTHX)
            Safefree(sva);
     }
 
-#if ARENASETS
     {
        struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
        
@@ -641,9 +628,6 @@ Perl_sv_free_arenas(pTHX)
            Safefree(aroot);
        }
     }
-#else
-    S_free_arena(aTHX_ (void**) PL_body_arenas);
-#endif
     PL_body_arenas = 0;
 
     for (i=0; i<PERL_ARENA_ROOTS_SIZE; i++)
@@ -691,24 +675,12 @@ Perl_sv_free_arenas(pTHX)
   contexts below (line ~10k)
 */
 
-/* get_arena(size): when ARENASETS is enabled, this creates
-   custom-sized arenas, otherwize it uses PERL_ARENA_SIZE, as
-   previously done.
+/* get_arena(size): this creates custom-sized arenas
    TBD: export properly for hv.c: S_more_he().
 */
 void*
 Perl_get_arena(pTHX_ int arena_size)
 {
-#if !ARENASETS
-    union arena* arp;
-
-    /* allocate and attach arena */
-    Newx(arp, arena_size, char);
-    arp->next = PL_body_arenas;
-    PL_body_arenas = arp;
-    return arp;
-
-#else
     struct arena_desc* adesc;
     struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
     int curr;
@@ -737,7 +709,6 @@ Perl_get_arena(pTHX_ int arena_size)
                          curr, adesc->arena, arena_size));
 
     return adesc->arena;
-#endif
 }
 
 
@@ -1081,7 +1052,7 @@ S_more_bodies (pTHX_ svtype sv_type)
 
 #ifdef DEBUGGING
     if (!done_sanity_check) {
-       int i = SVt_LAST;
+       unsigned int i = SVt_LAST;
 
        done_sanity_check = TRUE;
 
@@ -1094,17 +1065,11 @@ S_more_bodies (pTHX_ svtype sv_type)
 
     end = start + bdp->arena_size - body_size;
 
-#if !ARENASETS
-    /* The initial slot is used to link the arenas together, so it isn't to be
-       linked into the list of ready-to-use bodies.  */
-    start += body_size;
-#else
     /* computed count doesnt reflect the 1st slot reservation */
     DEBUG_m(PerlIO_printf(Perl_debug_log,
                          "arena %p end %p arena-size %d type %d size %d ct %d\n",
                          start, end, bdp->arena_size, sv_type, body_size,
                          bdp->arena_size / body_size));
-#endif
 
     *root = (void *)start;
 
@@ -1444,6 +1409,10 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen)
 {
     register char *s;
 
+    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,
@@ -3216,8 +3185,7 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
            Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
-       GvNAME(dstr) = savepvn(name, len);
-       GvNAMELEN(dstr) = len;
+       gv_name_set((GV *)dstr, name, len, GV_ADD);
        SvFAKE_on(dstr);        /* can coerce to non-glob */
     }
 
@@ -5112,7 +5080,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
-       Safefree(GvNAME(sv));
+       if (GvNAME_HEK(sv)) {
+           unshare_hek(GvNAME_HEK(sv));
+       }
        /* If we're in a stash, we don't own a reference to it. However it does
           have a back reference to us, which needs to be cleared.  */
        if (GvSTASH(sv))
@@ -6981,10 +6951,10 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef)
  */
 
 SV *
-Perl_newRV(pTHX_ SV *tmpRef)
+Perl_newRV(pTHX_ SV *sv)
 {
     dVAR;
-    return newRV_noinc(SvREFCNT_inc_simple(tmpRef));
+    return newRV_noinc(SvREFCNT_inc_simple_NN(sv));
 }
 
 /*
@@ -7716,7 +7686,9 @@ S_sv_unglob(pTHX_ SV *sv)
        GvSTASH(sv) = NULL;
     }
     GvMULTI_off(sv);
-    Safefree(GvNAME(sv));
+    if (GvNAME_HEK(sv)) {
+       unshare_hek(GvNAME_HEK(sv));
+    }
     SvSCREAM_off(sv);
 
     /* need to keep SvANY(sv) in the right arena */
@@ -9214,6 +9186,7 @@ ptr_table_* functions.
 
 
 #define sv_dup_inc(s,t)        SvREFCNT_inc(sv_dup(s,t))
+#define sv_dup_inc_NN(s,t)     SvREFCNT_inc_NN(sv_dup(s,t))
 #define av_dup(s,t)    (AV*)sv_dup((SV*)s,t)
 #define av_dup_inc(s,t)        (AV*)SvREFCNT_inc(sv_dup((SV*)s,t))
 #define hv_dup(s,t)    (HV*)sv_dup((SV*)s,t)
@@ -9836,7 +9809,9 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
                break;
            case SVt_PVGV:
-               GvNAME(dstr)    = SAVEPVN(GvNAME(dstr), GvNAMELEN(dstr));
+               if (GvNAME_HEK(dstr))
+                   GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
+
                /* Don't call sv_add_backref here as it's going to be created
                   as part of the magic cloning of the symbol table.  */
                GvSTASH(dstr)   = hv_dup(GvSTASH(dstr), param);
@@ -10756,8 +10731,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        const I32 len = av_len((AV*)proto_perl->Iregex_padav);
        SV* const * const regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
        IV i;
-       av_push(PL_regex_padav,
-               sv_dup_inc(regexen[0],param));
+       av_push(PL_regex_padav, sv_dup_inc_NN(regexen[0],param));
        for(i = 1; i <= len; i++) {
            const SV * const regex = regexen[i];
            SV * const sv =
@@ -10934,9 +10908,26 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods);
     PL_lex_casestack   = SAVEPVN(proto_perl->Ilex_casestack,i);
 
+#ifdef PERL_MAD
+    Copy(proto_perl->Inexttoke, PL_nexttoke, 5, NEXTTOKE);
+    PL_lasttoke                = proto_perl->Ilasttoke;
+    PL_realtokenstart  = proto_perl->Irealtokenstart;
+    PL_faketokens      = proto_perl->Ifaketokens;
+    PL_thismad         = proto_perl->Ithismad;
+    PL_thistoken       = proto_perl->Ithistoken;
+    PL_thisopen                = proto_perl->Ithisopen;
+    PL_thisstuff       = proto_perl->Ithisstuff;
+    PL_thisclose       = proto_perl->Ithisclose;
+    PL_thiswhite       = proto_perl->Ithiswhite;
+    PL_nextwhite       = proto_perl->Inextwhite;
+    PL_skipwhite       = proto_perl->Iskipwhite;
+    PL_endwhite                = proto_perl->Iendwhite;
+    PL_curforce                = proto_perl->Icurforce;
+#else
     Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE);
     Copy(proto_perl->Inexttype, PL_nexttype, 5,        I32);
     PL_nexttoke                = proto_perl->Inexttoke;
+#endif
 
     /* XXX This is probably masking the deeper issue of why
      * SvANY(proto_perl->Ilinestr) can be NULL at this point. For test case: