Make the original versions of relocated paths available from

[perl5.git] / hv.c

diff --git a/hv.c b/hv.c
index 0ab2558..1f9cd29 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -42,12 +42,11 @@ S_more_he(pTHX)
     dVAR;
     HE* he;
     HE* heend;
-    Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
-    HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
-    PL_body_arenaroots[HE_SVSLOT] = he;
+
+    he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE);
 
     heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
-    PL_body_roots[HE_SVSLOT] = ++he;
+    PL_body_roots[HE_SVSLOT] = he;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
@@ -92,7 +91,7 @@ S_new_he(pTHX)
 #endif
 
 STATIC HEK *
-S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
+S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
 {
     const int flags_masked = flags & HVhek_MASK;
     char *k;
@@ -125,7 +124,7 @@ Perl_free_tied_hv_pool(pTHX)
        he = HeNEXT(he);
        del_HE(ohe);
     }
-    PL_hv_fetch_ent_mh = Nullhe;
+    PL_hv_fetch_ent_mh = NULL;
 }
 
 #if defined(USE_ITHREADS)
@@ -155,7 +154,7 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
     HE *ret;
 
     if (!e)
-       return Nullhe;
+       return NULL;
     /* look for it in the table first */
     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
     if (ret)
@@ -372,7 +371,7 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
     }
     hek = hv_fetch_common (hv, NULL, key, klen, flags,
                           lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV,
-                          Nullsv, 0);
+                          NULL, 0);
     return hek ? &HeVAL(hek) : NULL;
 }
 
@@ -417,7 +416,7 @@ HE *
 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 {
     return hv_fetch_common(hv, keysv, NULL, 0, 0, 
-                          (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash);
+                          (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 }
 
 STATIC HE *
@@ -474,7 +473,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    Newx(k, HEK_BASESIZE + sizeof(SV*), char);
                    HeKEY_hek(entry) = (HEK*)k;
                }
-               HeNEXT(entry) = Nullhe;
+               HeNEXT(entry) = NULL;
                HeSVKEY_set(entry, keysv);
                HeVAL(entry) = sv;
                sv_upgrade(sv, SVt_PVLV);
@@ -498,10 +497,10 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        const char * const nkey = strupr(savepvn(key,klen));
                        /* Note that this fetch is for nkey (the uppercased
                           key) whereas the store is for key (the original)  */
-                       entry = hv_fetch_common(hv, Nullsv, nkey, klen,
+                       entry = hv_fetch_common(hv, NULL, nkey, klen,
                                                HVhek_FREEKEY, /* free nkey */
                                                0 /* non-LVAL fetch */,
-                                               Nullsv /* no value */,
+                                               NULL /* no value */,
                                                0 /* compute hash */);
                        if (!entry && (action & HV_FETCH_LVALUE)) {
                            /* This call will free key if necessary.
@@ -586,7 +585,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                if (!HvARRAY(hv) && !needs_store) {
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
-                   return Nullhe;
+                   return NULL;
                }
 #ifdef ENV_IS_CASELESS
                else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -637,7 +636,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
 
     if (is_utf8) {
-       char * const keysave = (char * const)key;
+       char * const keysave = (char *)key;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
@@ -669,7 +668,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     masked_flags = (flags & HVhek_MASK);
 
 #ifdef DYNAMIC_ENV_FETCH
-    if (!HvARRAY(hv)) entry = Null(HE*);
+    if (!HvARRAY(hv)) entry = NULL;
     else
 #endif
     {
@@ -858,7 +857,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 }
 
 STATIC void
-S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
+S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
 {
     const MAGIC *mg = SvMAGIC(hv);
     *needs_copy = FALSE;
@@ -962,7 +961,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     int masked_flags;
 
     if (!hv)
-       return Nullsv;
+       return NULL;
 
     if (keysv) {
        if (k_flags & HVhek_FREEKEY)
@@ -983,7 +982,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            SV *sv;
            entry = hv_fetch_common(hv, keysv, key, klen,
                                    k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE,
-                                   Nullsv, hash);
+                                   NULL, hash);
            sv = entry ? HeVAL(entry) : NULL;
            if (sv) {
                if (SvMAGICAL(sv)) {
@@ -995,7 +994,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        sv_unmagic(sv, PERL_MAGIC_tiedelem);
                        return sv;
                    }           
-                   return Nullsv;              /* element cannot be deleted */
+                   return NULL;                /* element cannot be deleted */
                }
 #ifdef ENV_IS_CASELESS
                else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -1015,7 +1014,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!HvARRAY(hv))
-       return Nullsv;
+       return NULL;
 
     if (is_utf8) {
        const char * const keysave = key;
@@ -1082,7 +1081,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
             Safefree(key);
 
        if (d_flags & G_DISCARD)
-           sv = Nullsv;
+           sv = NULL;
        else {
            sv = sv_2mortal(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
@@ -1123,7 +1122,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (k_flags & HVhek_FREEKEY)
        Safefree(key);
-    return Nullsv;
+    return NULL;
 }
 
 STATIC void
@@ -1719,7 +1718,7 @@ S_hfreeentries(pTHX_ HV *hv)
                hv_free_ent(hv, entry);
            }
            iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
-           iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+           iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
 
            /* There are now no allocated pointers in the aux structure.  */
 
@@ -1808,7 +1807,7 @@ Perl_hv_undef(pTHX_ HV *hv)
     if ((name = HvNAME_get(hv))) {
         if(PL_stashcache)
            hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
-       hv_name_set(hv, Nullch, 0, 0);
+       hv_name_set(hv, NULL, 0, 0);
     }
     SvFLAGS(hv) &= ~SVf_OOK;
     Safefree(HvARRAY(hv));
@@ -1821,7 +1820,7 @@ Perl_hv_undef(pTHX_ HV *hv)
 }
 
 static struct xpvhv_aux*
-S_hv_auxinit(pTHX_ HV *hv) {
+S_hv_auxinit(HV *hv) {
     struct xpvhv_aux *iter;
     char *array;
 
@@ -1839,7 +1838,7 @@ S_hv_auxinit(pTHX_ HV *hv) {
     iter = HvAUX(hv);
 
     iter->xhv_riter = -1;      /* HvRITER(hv) = -1 */
-    iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+    iter->xhv_eiter = NULL;    /* HvEITER(hv) = NULL */
     iter->xhv_name = 0;
     iter->xhv_backreferences = 0;
     return iter;
@@ -1874,7 +1873,7 @@ Perl_hv_iterinit(pTHX_ HV *hv)
            hv_free_ent(hv, entry);
        }
        iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
-       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
     } else {
        hv_auxinit(hv);
     }
@@ -1944,7 +1943,7 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
 }
 
 void
-Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
+Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {
     dVAR;
     struct xpvhv_aux *iter;
@@ -1952,6 +1951,9 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 
     PERL_UNUSED_ARG(flags);
 
+    if (len > I32_MAX)
+       Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
+
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
        if (iter->xhv_name) {
@@ -1970,6 +1972,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 AV **
 Perl_hv_backreferences_p(pTHX_ HV *hv) {
     struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
+    PERL_UNUSED_CONTEXT;
     return &(iter->xhv_backreferences);
 }
 
@@ -2062,15 +2065,15 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        magic_nextpack((SV*) hv,mg,key);
        if (SvOK(key)) {
            /* force key to stay around until next time */
-           HeSVKEY_set(entry, SvREFCNT_inc(key));
+           HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
            return entry;               /* beware, hent_val is not set */
        }
        if (HeVAL(entry))
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        del_HE(entry);
-       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
-       return Null(HE*);
+       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+       return NULL;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
     if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -2301,7 +2304,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 
     /* what follows was the moral equivalent of:
     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
-       if (--*Svp == Nullsv)
+       if (--*Svp == NULL)
            hv_delete(PL_strtab, str, len, G_DISCARD, hash);
     } */
     xhv = (XPVHV*)SvANY(PL_strtab);
@@ -2397,7 +2400,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     /* what follows is the moral equivalent of:
 
     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
-       hv_store(PL_strtab, str, len, Nullsv, hash);
+       hv_store(PL_strtab, str, len, NULL, hash);
 
        Can't rehash the shared string table, so not sure if it's worth
        counting the number of entries in the linked list
@@ -2542,7 +2545,7 @@ Perl_hv_assert(pTHX_ HV *hv)
     }
     /* sanity check the keys */
     if (HeSVKEY(entry)) {
-      /* Don't know what to check on SV keys.  */
+      /*EMPTY*/ /* Don't know what to check on SV keys.  */
     } else if (HeKUTF8(entry)) {
       withflags++;
        if (HeKWASUTF8(entry)) {