Map the HE arena onto SV type 0 (SVt_NULL).

Abolish PL_he_root and PL_he_arenaroot.

p4raw-id: //depot/perl@26171

diff --git a/embedvar.h b/embedvar.h
index bdd9518..ee65be4 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -257,8 +257,6 @@
 #define PL_globalstash         (vTHX->Iglobalstash)
 #define PL_hash_seed           (vTHX->Ihash_seed)
 #define PL_hash_seed_set       (vTHX->Ihash_seed_set)
-#define PL_he_arenaroot                (vTHX->Ihe_arenaroot)
-#define PL_he_root             (vTHX->Ihe_root)
 #define PL_hintgv              (vTHX->Ihintgv)
 #define PL_hints               (vTHX->Ihints)
 #define PL_in_clean_all                (vTHX->Iin_clean_all)
@@ -538,8 +536,6 @@
 #define PL_Iglobalstash                PL_globalstash
 #define PL_Ihash_seed          PL_hash_seed
 #define PL_Ihash_seed_set      PL_hash_seed_set
-#define PL_Ihe_arenaroot       PL_he_arenaroot
-#define PL_Ihe_root            PL_he_root
 #define PL_Ihintgv             PL_hintgv
 #define PL_Ihints              PL_hints
 #define PL_Iin_clean_all       PL_in_clean_all

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 7905a93..873db7e 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -1,3 +1,4 @@
+#define PERL_IN_XS_APITEST
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -30,10 +31,10 @@ test_freeent(freeent_function *f) {
 
     /* We need to "inline" new_he here as it's static, and the functions we
        test expect to be able to call del_HE on the HE  */
-    if (!PL_he_root)
+    if (!PL_body_roots[HE_SVSLOT])
        croak("PL_he_root is 0");
-    victim = PL_he_root;
-    PL_he_root = HeNEXT(victim);
+    victim = PL_body_roots[HE_SVSLOT];
+    PL_body_roots[HE_SVSLOT] = HeNEXT(victim);
 #endif
 
     victim->hent_hek = Perl_share_hek(aTHX_ "", 0, 0);

diff --git a/hv.c b/hv.c
index afccf85..1de2e01 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 **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
 

diff --git a/intrpvar.h b/intrpvar.h
index 7c14985..9b95aad 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -249,8 +249,6 @@ PERLVAR(Isighandlerp,       Sighandler_t)
 
 PERLVARA(Ibody_roots,  SVt_LAST, void*) /* array of body roots */
 
-PERLVAR(Ihe_root,      HE *)           /* free he list */
-
 PERLVAR(Inice_chunk,   char *)         /* a nice chunk of memory to reuse */
 PERLVAR(Inice_chunk_size,      U32)    /* how nice the chunk of memory is */
 
@@ -417,8 +415,6 @@ PERLVARI(Ibeginav_save, AV*, Nullav)        /* save BEGIN{}s when compiling */
 
 PERLVARA(Ibody_arenaroots, SVt_LAST, void*) /* consolidated body-arena pointers */
 
-PERLVAR(Ihe_arenaroot, HE *)           /* list of allocated he areas */
-
      /* 5.6.0 stopped here */
 
 PERLVAR(Ipsig_pend, int *)             /* per-signal "count" of pending */

diff --git a/perlapi.h b/perlapi.h
index d5ebdd7..6f027b5 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -312,10 +312,6 @@ END_EXTERN_C
 #define PL_hash_seed           (*Perl_Ihash_seed_ptr(aTHX))
 #undef  PL_hash_seed_set
 #define PL_hash_seed_set       (*Perl_Ihash_seed_set_ptr(aTHX))
-#undef  PL_he_arenaroot
-#define PL_he_arenaroot                (*Perl_Ihe_arenaroot_ptr(aTHX))
-#undef  PL_he_root
-#define PL_he_root             (*Perl_Ihe_root_ptr(aTHX))
 #undef  PL_hintgv
 #define PL_hintgv              (*Perl_Ihintgv_ptr(aTHX))
 #undef  PL_hints

diff --git a/sv.c b/sv.c
index b8bada3..7f8a6b3 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -112,8 +112,7 @@ list, and call more_xiv() etc to add a new arena if the list is empty.
 
 At the time of very final cleanup, sv_free_arenas() is called from
 perl_destruct() to physically free all the arenas allocated since the
-start of the interpreter.  Note that this also clears PL_he_arenaroot,
-which is otherwise dealt with in hv.c.
+start of the interpreter.
 
 Manipulation of any of the PL_*root pointers is protected by enclosing
 LOCK_SV_MUTEX; ... UNLOCK_SV_MUTEX calls which should Do the Right Thing
@@ -596,8 +595,6 @@ Perl_sv_free_arenas(pTHX)
        PL_body_roots[i] = 0;
     }
 
-    free_arena(he);
-
     Safefree(PL_nice_chunk);
     PL_nice_chunk = Nullch;
     PL_nice_chunk_size = 0;
@@ -10846,9 +10843,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     Zero(&PL_body_arenaroots, 1, PL_body_arenaroots);
     Zero(&PL_body_roots, 1, PL_body_roots);
     
-    PL_he_arenaroot    = NULL;
-    PL_he_root         = NULL;
-
     PL_nice_chunk      = NULL;
     PL_nice_chunk_size = 0;
     PL_sv_count                = 0;

diff --git a/sv.h b/sv.h
index a40d3b5..75cf82d 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -66,6 +66,9 @@ typedef enum {
 #ifdef PERL_IN_SV_C
 #define PTE_SVSLOT     SVt_RV
 #endif
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
+#define HE_SVSLOT      SVt_NULL
+#endif
 
 /* typedefs to eliminate some typing */
 typedef struct he HE;