diff options
| -rw-r--r-- | embed.fnc | 8 | ||||
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | hv.c | 20 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rw-r--r-- | sv.c | 24 |
5 files changed, 15 insertions, 50 deletions
@@ -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 \ @@ -1614,7 +1614,8 @@ # 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 @@ -3686,8 +3687,6 @@ #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) @@ -4070,7 +4069,6 @@ # 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) @@ -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); @@ -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 \ @@ -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); \ |