diff options
-rw-r--r-- | embedvar.h | 4 | ||||
-rw-r--r-- | ext/XS/APItest/APItest.xs | 7 | ||||
-rw-r--r-- | hv.c | 18 | ||||
-rw-r--r-- | intrpvar.h | 4 | ||||
-rw-r--r-- | perlapi.h | 4 | ||||
-rw-r--r-- | sv.c | 8 | ||||
-rw-r--r-- | sv.h | 3 |
7 files changed, 18 insertions, 30 deletions
diff --git a/embedvar.h b/embedvar.h index bdd9518e2e..ee65be4167 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 7905a93574..873db7e4b3 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); @@ -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 7c14985aaf..9b95aad287 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 */ @@ -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 @@ -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; @@ -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; |