Expose more_bodies(), and use it to replace S_more_he().
authorNicholas Clark <nick@ccl4.org>
Fri, 20 Aug 2010 14:31:42 +0000 (15:31 +0100)
committerNicholas Clark <nick@ccl4.org>
Fri, 20 Aug 2010 16:34:39 +0000 (17:34 +0100)
Convert get_arena() to be static, as now its only user is Perl_more_bodies().

Perl_get_arena() was not in the public API, and neither Google codesearch
nor an upacked CPAN show anything to be using it.

embed.fnc
embed.h
hv.c
proto.h
sv.c

index 76cd2f8..c79628d 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1494,11 +1494,6 @@ s        |HV*    |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
                                |NN const char *methpv|const U32 flags
 #endif
 
-: #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
-: Used in hv.c
-paRxoM |void*  |get_arena      |const size_t arenasize |const svtype bodytype
-: #endif
-
 #if defined(PERL_IN_HV_C)
 s      |void   |hsplit         |NN HV *hv
 s      |void   |hfreeentries   |NN HV *hv
@@ -1907,7 +1902,8 @@ sn        |char * |F0convert      |NV nv|NN char *const endbuf|NN STRLEN *const len
 sM     |void   |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after
 #  endif
 s      |SV *   |more_sv
-s      |void * |more_bodies    |const svtype sv_type|const size_t body_size \
+: Used in sv.c and hv.c
+po     |void * |more_bodies    |const svtype sv_type|const size_t body_size \
                                |const size_t arena_size
 s      |bool   |sv_2iuv_common |NN SV *const sv
 s      |void   |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \
diff --git a/embed.h b/embed.h
index d45e8bb..499808b 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  endif
 #ifdef PERL_CORE
 #define more_sv                        S_more_sv
-#define more_bodies            S_more_bodies
+#endif
+#ifdef PERL_CORE
 #define sv_2iuv_common         S_sv_2iuv_common
 #define glob_assign_glob       S_glob_assign_glob
 #define glob_assign_ref                S_glob_assign_ref
 #define require_tie_mod(a,b,c,d,e)     S_require_tie_mod(aTHX_ a,b,c,d,e)
 #endif
 #endif
-#ifdef PERL_CORE
-#endif
 #if defined(PERL_IN_HV_C)
 #ifdef PERL_CORE
 #define hsplit(a)              S_hsplit(aTHX_ a)
 #  endif
 #ifdef PERL_CORE
 #define more_sv()              S_more_sv(aTHX)
-#define more_bodies(a,b,c)     S_more_bodies(aTHX_ a,b,c)
 #define sv_2iuv_common(a)      S_sv_2iuv_common(aTHX_ a)
 #define glob_assign_glob(a,b,c)        S_glob_assign_glob(aTHX_ a,b,c)
 #define glob_assign_ref(a,b)   S_glob_assign_ref(aTHX_ a,b)
diff --git a/hv.c b/hv.c
index e221499..d29c49c 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -40,24 +40,6 @@ holds the key and hash value.
 static const char S_strtab_error[]
     = "Cannot modify shared string table in hv_%s";
 
-STATIC void
-S_more_he(pTHX)
-{
-    dVAR;
-    /* We could generate this at compile time via (another) auxiliary C
-       program?  */
-    const size_t arena_size = Perl_malloc_good_size(PERL_ARENA_SIZE);
-    HE* he = (HE*) Perl_get_arena(aTHX_ arena_size, HE_SVSLOT);
-    HE * const heend = &he[arena_size / sizeof(HE) - 1];
-
-    PL_body_roots[HE_SVSLOT] = he;
-    while (he < heend) {
-       HeNEXT(he) = (HE*)(he + 1);
-       he++;
-    }
-    HeNEXT(he) = 0;
-}
-
 #ifdef PURIFY
 
 #define new_HE() (HE*)safemalloc(sizeof(HE))
@@ -73,7 +55,7 @@ S_new_he(pTHX)
     void ** const root = &PL_body_roots[HE_SVSLOT];
 
     if (!*root)
-       S_more_he(aTHX);
+       Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE);
     he = (HE*) *root;
     assert(he);
     *root = HeNEXT(he);
diff --git a/proto.h b/proto.h
index 9aba97f..2a9dc57 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4488,11 +4488,6 @@ STATIC HV*       S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const
 
 #endif
 
-PERL_CALLCONV void*    Perl_get_arena(pTHX_ const size_t arenasize, const svtype bodytype)
-                       __attribute__malloc__
-                       __attribute__warn_unused_result__;
-
-
 #if defined(PERL_IN_HV_C)
 STATIC void    S_hsplit(pTHX_ HV *hv)
                        __attribute__nonnull__(pTHX_1);
@@ -5886,7 +5881,7 @@ STATIC void       S_sv_release_COW(pTHX_ SV *sv, const char *pvx, SV *after)
 
 #  endif
 STATIC SV *    S_more_sv(pTHX);
-STATIC void *  S_more_bodies(pTHX_ const svtype sv_type, const size_t body_size, const size_t arena_size);
+PERL_CALLCONV void *   Perl_more_bodies(pTHX_ const svtype sv_type, const size_t body_size, const size_t arena_size);
 STATIC bool    S_sv_2iuv_common(pTHX_ SV *const sv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SV_2IUV_COMMON        \
diff --git a/sv.c b/sv.c
index 1430c10..4555a22 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -703,16 +703,10 @@ Perl_sv_free_arenas(pTHX)
   because the leading fields arent accessed.  Pointers to such bodies
   are decremented to point at the unused 'ghost' memory, knowing that
   the pointers are used with offsets to the real memory.
-
-  HE, HEK arenas are managed separately, with separate code, but may
-  be merge-able later..
 */
 
-/* get_arena(size): this creates custom-sized arenas
-   TBD: export properly for hv.c: S_more_he().
-*/
-void*
-Perl_get_arena(pTHX_ const size_t arena_size, const svtype bodytype)
+static void *
+S_get_arena(pTHX_ const size_t arena_size, const svtype bodytype)
 {
     dVAR;
     struct arena_desc* adesc;
@@ -805,11 +799,11 @@ they are no longer allocated.
 
 In turn, the new_body_* allocators call S_new_body(), which invokes
 new_body_inline macro, which takes a lock, and takes a body off the
-linked list at PL_body_roots[sv_type], calling S_more_bodies() if
+linked list at PL_body_roots[sv_type], calling Perl_more_bodies() if
 necessary to refresh an empty list.  Then the lock is released, and
 the body is returned.
 
-S_more_bodies calls get_arena(), and carves it up into an array of N
+Perl_more_bodies calls get_arena(), and carves it up into an array of N
 bodies, which it strings into a linked list.  It looks up arena-size
 and body-size from the body_details table described below, thus
 supporting the multiple body-types.
@@ -1024,9 +1018,9 @@ static const struct body_details bodies_by_type[] = {
 #define new_NOARENAZ(details) \
        safecalloc((details)->body_size + (details)->offset, 1)
 
-STATIC void *
-S_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
-              const size_t arena_size)
+void *
+Perl_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
+                 const size_t arena_size)
 {
     dVAR;
     void ** const root = &PL_body_roots[sv_type];
@@ -1050,7 +1044,7 @@ S_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
 
     assert(arena_size);
 
-    start = (char*) Perl_get_arena(aTHX_ good_arena_size, sv_type);
+    start = (char*) S_get_arena(aTHX_ good_arena_size, sv_type);
 
     /* Get the address of the byte after the end of the last body we can fit.
        Remember, this is integer division:  */
@@ -1098,7 +1092,7 @@ S_more_bodies (pTHX_ const svtype sv_type, const size_t body_size,
     STMT_START { \
        void ** const r3wt = &PL_body_roots[sv_type]; \
        xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt))      \
-         ? *((void **)(r3wt)) : more_bodies(sv_type, \
+         ? *((void **)(r3wt)) : Perl_more_bodies(aTHX_ sv_type, \
                                             bodies_by_type[sv_type].body_size,\
                                             bodies_by_type[sv_type].arena_size)); \
        *(r3wt) = *(void**)(xpv); \