Move the rest of the data munging into the test preparation loop.

[p5sagit/p5-mst-13.2.git] / hv.c

diff --git a/hv.c b/hv.c
index 147efcc..6f5dd2e 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -42,11 +42,11 @@ S_more_he(pTHX)
     HE* he;
     HE* heend;
     Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
-    HeNEXT(he) = PL_he_arenaroot;
-    PL_he_arenaroot = he;
+    HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
+    PL_body_arenaroots[HE_SVSLOT] = he;
 
     heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
-    PL_he_root = ++he;
+    PL_body_roots[HE_SVSLOT] = ++he;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
@@ -65,11 +65,13 @@ STATIC HE*
 S_new_he(pTHX)
 {
     HE* he;
+    void ** const root = &PL_body_roots[HE_SVSLOT];
+
     LOCK_SV_MUTEX;
-    if (!PL_he_root)
+    if (!*root)
        S_more_he(aTHX);
-    he = PL_he_root;
-    PL_he_root = HeNEXT(he);
+    he = *root;
+    *root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
     return he;
 }
@@ -78,8 +80,8 @@ S_new_he(pTHX)
 #define del_HE(p) \
     STMT_START { \
        LOCK_SV_MUTEX; \
-       HeNEXT(p) = (HE*)PL_he_root; \
-       PL_he_root = p; \
+       HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]);    \
+       PL_body_roots[HE_SVSLOT] = p; \
        UNLOCK_SV_MUTEX; \
     } STMT_END
 
@@ -107,7 +109,7 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     return hek;
 }
 
-/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+/* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
  * for tied hashes */
 
 void
@@ -145,7 +147,7 @@ Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
 }
 
 HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
+Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
 {
     HE *ret;
 
@@ -488,7 +490,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
-                       const char *nkey = strupr(savepvn(key,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,
@@ -859,9 +861,7 @@ S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
     while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
-           switch (mg->mg_type) {
-           case PERL_MAGIC_tied:
-           case PERL_MAGIC_sig:
+           if (mg->mg_type == PERL_MAGIC_tied) {
                *needs_store = FALSE;
                return; /* We've set all there is to set. */
            }
@@ -881,13 +881,13 @@ Evaluates the hash in scalar context and returns the result. Handles magic when
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
-    MAGIC *mg;
     SV *sv;
-    
-    if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
-        sv = magic_scalarpack(hv, mg);
-        return sv;
-    } 
+
+    if (SvRMAGICAL(hv)) {
+       MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+       if (mg)
+           return magic_scalarpack(hv, mg);
+    }
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
@@ -1785,14 +1785,12 @@ value, you can get it through the macro C<HvFILL(tb)>.
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
-    HE *entry;
-
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (SvOOK(hv)) {
        struct xpvhv_aux *iter = HvAUX(hv);
-       entry = iter->xhv_eiter; /* HvEITER(hv) */
+       HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
        if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
            HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
@@ -1891,6 +1889,8 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 }
 
 /*
+hv_iternext is implemented as a macro in hv.h
+
 =for apidoc hv_iternext
 
 Returns entries from a hash iterator.  See C<hv_iterinit>.
@@ -1903,16 +1903,6 @@ to free the entry on the next call to C<hv_iternext>, so you must not discard
 your iterator immediately else the entry will leak - call C<hv_iternext> to
 trigger the resource deallocation.
 
-=cut
-*/
-
-HE *
-Perl_hv_iternext(pTHX_ HV *hv)
-{
-    return hv_iternext_flags(hv, 0);
-}
-
-/*
 =for apidoc hv_iternext_flags
 
 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
@@ -1952,7 +1942,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
-       SV *key = sv_newmortal();
+       SV * const key = sv_newmortal();
        if (entry) {
            sv_setsv(key, HeSVKEY_force(entry));
            SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
@@ -2061,7 +2051,7 @@ Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
 {
     if (HeKLEN(entry) == HEf_SVKEY) {
        STRLEN len;
-       char *p = SvPV(HeKEY_sv(entry), len);
+       char * const p = SvPV(HeKEY_sv(entry), len);
        *retlen = len;
        return p;
     }
@@ -2102,7 +2092,7 @@ Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
 {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
-           SV* sv = sv_newmortal();
+           SV* const sv = sv_newmortal();
            if (HeKLEN(entry) == HEf_SVKEY)
                mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
            else
@@ -2125,14 +2115,18 @@ operation.
 SV *
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
-    HE *he;
-    if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+    HE * const he = hv_iternext_flags(hv, 0);
+
+    if (!he)
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
 }
 
 /*
+
+Now a macro in hv.h
+
 =for apidoc hv_magic
 
 Adds magic to a hash.  See C<sv_magic>.
@@ -2140,22 +2134,6 @@ Adds magic to a hash.  See C<sv_magic>.
 =cut
 */
 
-void
-Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
-{
-    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
-}
-
-#if 0 /* use the macro from hv.h instead */
-
-char*  
-Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
-{
-    return HEK_KEY(share_hek(sv, len, hash));
-}
-
-#endif
-
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
@@ -2180,7 +2158,7 @@ STATIC void
 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
     register XPVHV* xhv;
-    register HE *entry;
+    HE *entry;
     register HE **oentry;
     HE **first;
     bool found = 0;