From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 19 Nov 2005 00:21:58 +0000 (+0000)
Subject: Map the HE arena onto SV type 0 (SVt_NULL).
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a93a7e5bbd9f0bd3bf729ac738270ae82ef9448;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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;