Nicholas Clark
2010-08-20 16:41:48 UTC
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/26359cfa9ac0b8c63aa387ca92e7fa1b20d22d39?hp=7526101e3b4b792395b41754651bdbbea6b8cf55>
- Log -----------------------------------------------------------------
commit 26359cfa9ac0b8c63aa387ca92e7fa1b20d22d39
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 17:05:12 2010 +0100
In sv.c, tidy up body allocation code.
Move the definition of del_body() closer to where it is used.
Inline del_body_allocated() into its only remaining user, del_XPVGV().
Coalesce adjacent C comments.
M sv.c
commit 99816f8d139964323f633255e898adc59784cbe9
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 15:54:28 2010 +0100
Inline S_get_arena() into Perl_more_bodies(), its only caller.
M sv.c
commit 1e30fcd5eb66123dc2adb29941506280426aefaf
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 15:31:42 2010 +0100
Expose more_bodies(), and use it to replace S_more_he().
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.
M embed.fnc
M embed.h
M hv.c
M proto.h
M sv.c
commit 029821316c3d1268a765152507ac4ffb64746558
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 14:14:34 2010 +0100
In sv.c, pass in values to S_more_bodies, instead of using bodies_by_type.
Also fix one value passed to the debugging *_printf() in the #else block.
M embed.fnc
M embed.h
M proto.h
M sv.c
commit 29657bb6c05aaef4172308097542f56a92e02a08
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 11:25:50 2010 +0100
Refactor the loop of S_more_bodies() to be (hopefully) clearer.
M sv.c
commit eaeb1e7f3008ef8680fd7726bb124dac46e2f98c
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 10:44:40 2010 +0100
Correct the size calculations for FIT_ARENA for SVt_REGEXP.
This should have been done as part of commit 601dfd0af0604fa7. Its omission
did not cause bugs; it merely resulted in slightly less effective arena sizing.
M sv.c
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 9 +---
embed.h | 6 +--
hv.c | 20 +--------
proto.h | 7 +---
sv.c | 149 +++++++++++++++++++++++++++----------------------------------
5 files changed, 73 insertions(+), 118 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 1e27e88..c79628d 100644
--- 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,9 @@ 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
+: 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 \
|const int dtype
diff --git a/embed.h b/embed.h
index 51be599..499808b 100644
--- a/embed.h
+++ b/embed.h
@@ -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) S_more_bodies(aTHX_ a)
#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
--- 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 17c3212..2a9dc57 100644
--- 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);
+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 4918449..9f2fde4 100644
--- a/sv.c
+++ b/sv.c
@@ -704,61 +704,6 @@ Perl_sv_free_arenas(pTHX)
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)
-{
- dVAR;
- struct arena_desc* adesc;
- struct arena_set *aroot = (struct arena_set*) PL_body_arenas;
- unsigned int curr;
-
- /* shouldnt need this
- if (!arena_size) arena_size = PERL_ARENA_SIZE;
- */
-
- /* may need new arena-set to hold new arena */
- if (!aroot || aroot->curr >= aroot->set_size) {
- struct arena_set *newroot;
- Newxz(newroot, 1, struct arena_set);
- newroot->set_size = ARENAS_PER_SET;
- newroot->next = aroot;
- aroot = newroot;
- PL_body_arenas = (void *) newroot;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)aroot));
- }
-
- /* ok, now have arena-set with at least 1 empty/available arena-desc */
- curr = aroot->curr++;
- adesc = &(aroot->set[curr]);
- assert(!adesc->arena);
-
- Newx(adesc->arena, arena_size, char);
- adesc->size = arena_size;
- adesc->utype = bodytype;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n",
- curr, (void*)adesc->arena, (UV)arena_size));
-
- return adesc->arena;
-}
-
-
-/* return a thing to the free list */
-
-#define del_body(thing, root) \
- STMT_START { \
- void ** const thing_copy = (void **)thing;\
- *thing_copy = *root; \
- *root = (void*)thing_copy; \
- } STMT_END
-
-/*
=head1 SV-Body Allocation
@@ -805,11 +750,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 allocates a new 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.
@@ -817,10 +762,6 @@ supporting the multiple body-types.
If PURIFY is defined, or PERL_ARENA_SIZE=0, arenas are not used, and
the (new|del)_X*V macros are mapped directly to malloc/free.
-*/
-
-/*
-
For each sv-type, struct body_details bodies_by_type[] carries
parameters which control these aspects of SV handling:
@@ -948,7 +889,7 @@ static const struct body_details bodies_by_type[] = {
sizeof(regexp),
0,
SVt_REGEXP, FALSE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur))
+ FIT_ARENA(0, sizeof(regexp))
},
/* 48 */
@@ -996,8 +937,14 @@ static const struct body_details bodies_by_type[] = {
(void *)((char *)S_new_body(aTHX_ sv_type) \
- bodies_by_type[sv_type].offset)
-#define del_body_allocated(p, sv_type) \
- del_body(p + bodies_by_type[sv_type].offset, &PL_body_roots[sv_type])
+/* return a thing to the free list */
+
+#define del_body(thing, root) \
+ STMT_START { \
+ void ** const thing_copy = (void **)thing; \
+ *thing_copy = *root; \
+ *root = (void*)thing_copy; \
+ } STMT_END
#ifdef PURIFY
@@ -1013,7 +960,8 @@ static const struct body_details bodies_by_type[] = {
#define new_XPVNV() new_body_allocated(SVt_PVNV)
#define new_XPVMG() new_body_allocated(SVt_PVMG)
-#define del_XPVGV(p) del_body_allocated(p, SVt_PVGV)
+#define del_XPVGV(p) del_body(p + bodies_by_type[SVt_PVGV].offset, \
+ &PL_body_roots[SVt_PVGV])
#endif /* PURIFY */
@@ -1024,16 +972,18 @@ 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)
+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];
- const struct body_details * const bdp = &bodies_by_type[sv_type];
- const size_t body_size = bdp->body_size;
+ struct arena_desc *adesc;
+ struct arena_set *aroot = (struct arena_set *) PL_body_arenas;
+ unsigned int curr;
char *start;
const char *end;
- const size_t arena_size = Perl_malloc_good_size(bdp->arena_size);
+ const size_t good_arena_size = Perl_malloc_good_size(arena_size);
#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
static bool done_sanity_check;
@@ -1049,37 +999,68 @@ S_more_bodies (pTHX_ const svtype sv_type)
}
#endif
- assert(bdp->arena_size);
+ assert(arena_size);
- start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type);
+ /* may need new arena-set to hold new arena */
+ if (!aroot || aroot->curr >= aroot->set_size) {
+ struct arena_set *newroot;
+ Newxz(newroot, 1, struct arena_set);
+ newroot->set_size = ARENAS_PER_SET;
+ newroot->next = aroot;
+ aroot = newroot;
+ PL_body_arenas = (void *) newroot;
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)aroot));
+ }
+
+ /* ok, now have arena-set with at least 1 empty/available arena-desc */
+ curr = aroot->curr++;
+ adesc = &(aroot->set[curr]);
+ assert(!adesc->arena);
+
+ Newx(adesc->arena, good_arena_size, char);
+ adesc->size = good_arena_size;
+ adesc->utype = sv_type;
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n",
+ curr, (void*)adesc->arena, (UV)good_arena_size));
- end = start + arena_size - 2 * body_size;
+ start = (char *) adesc->arena;
+
+ /* Get the address of the byte after the end of the last body we can fit.
+ Remember, this is integer division: */
+ end = start + good_arena_size / body_size * body_size;
/* computed count doesnt reflect the 1st slot reservation */
#if defined(MYMALLOC) || defined(HAS_MALLOC_GOOD_SIZE)
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d (from %d) type %d "
"size %d ct %d\n",
- (void*)start, (void*)end, (int)arena_size,
- (int)bdp->arena_size, sv_type, (int)body_size,
- (int)arena_size / (int)body_size));
+ (void*)start, (void*)end, (int)good_arena_size,
+ (int)arena_size, sv_type, (int)body_size,
+ (int)good_arena_size / (int)body_size));
#else
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d type %d size %d ct %d\n",
(void*)start, (void*)end,
- (int)bdp->arena_size, sv_type, (int)body_size,
- (int)bdp->arena_size / (int)body_size));
+ (int)arena_size, sv_type, (int)body_size,
+ (int)good_arena_size / (int)body_size));
#endif
*root = (void *)start;
- while (start <= end) {
+ while (1) {
+ /* Where the next body would start: */
char * const next = start + body_size;
+
+ if (next >= end) {
+ /* This is the last body: */
+ assert(next == end);
+
+ *(void **)start = 0;
+ return *root;
+ }
+
*(void**) start = (void *)next;
start = next;
}
- *(void **)start = 0;
-
- return *root;
}
/* grab a new thing from the free list, allocating more if necessary.
@@ -1090,7 +1071,9 @@ S_more_bodies (pTHX_ const svtype sv_type)
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); \
} STMT_END
--
Perl5 Master Repository
<http://perl5.git.perl.org/perl.git/commitdiff/26359cfa9ac0b8c63aa387ca92e7fa1b20d22d39?hp=7526101e3b4b792395b41754651bdbbea6b8cf55>
- Log -----------------------------------------------------------------
commit 26359cfa9ac0b8c63aa387ca92e7fa1b20d22d39
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 17:05:12 2010 +0100
In sv.c, tidy up body allocation code.
Move the definition of del_body() closer to where it is used.
Inline del_body_allocated() into its only remaining user, del_XPVGV().
Coalesce adjacent C comments.
M sv.c
commit 99816f8d139964323f633255e898adc59784cbe9
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 15:54:28 2010 +0100
Inline S_get_arena() into Perl_more_bodies(), its only caller.
M sv.c
commit 1e30fcd5eb66123dc2adb29941506280426aefaf
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 15:31:42 2010 +0100
Expose more_bodies(), and use it to replace S_more_he().
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.
M embed.fnc
M embed.h
M hv.c
M proto.h
M sv.c
commit 029821316c3d1268a765152507ac4ffb64746558
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 14:14:34 2010 +0100
In sv.c, pass in values to S_more_bodies, instead of using bodies_by_type.
Also fix one value passed to the debugging *_printf() in the #else block.
M embed.fnc
M embed.h
M proto.h
M sv.c
commit 29657bb6c05aaef4172308097542f56a92e02a08
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 11:25:50 2010 +0100
Refactor the loop of S_more_bodies() to be (hopefully) clearer.
M sv.c
commit eaeb1e7f3008ef8680fd7726bb124dac46e2f98c
Author: Nicholas Clark <***@ccl4.org>
Date: Fri Aug 20 10:44:40 2010 +0100
Correct the size calculations for FIT_ARENA for SVt_REGEXP.
This should have been done as part of commit 601dfd0af0604fa7. Its omission
did not cause bugs; it merely resulted in slightly less effective arena sizing.
M sv.c
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 9 +---
embed.h | 6 +--
hv.c | 20 +--------
proto.h | 7 +---
sv.c | 149 +++++++++++++++++++++++++++----------------------------------
5 files changed, 73 insertions(+), 118 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 1e27e88..c79628d 100644
--- 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,9 @@ 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
+: 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 \
|const int dtype
diff --git a/embed.h b/embed.h
index 51be599..499808b 100644
--- a/embed.h
+++ b/embed.h
@@ -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) S_more_bodies(aTHX_ a)
#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
--- 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 17c3212..2a9dc57 100644
--- 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);
+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 4918449..9f2fde4 100644
--- a/sv.c
+++ b/sv.c
@@ -704,61 +704,6 @@ Perl_sv_free_arenas(pTHX)
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)
-{
- dVAR;
- struct arena_desc* adesc;
- struct arena_set *aroot = (struct arena_set*) PL_body_arenas;
- unsigned int curr;
-
- /* shouldnt need this
- if (!arena_size) arena_size = PERL_ARENA_SIZE;
- */
-
- /* may need new arena-set to hold new arena */
- if (!aroot || aroot->curr >= aroot->set_size) {
- struct arena_set *newroot;
- Newxz(newroot, 1, struct arena_set);
- newroot->set_size = ARENAS_PER_SET;
- newroot->next = aroot;
- aroot = newroot;
- PL_body_arenas = (void *) newroot;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)aroot));
- }
-
- /* ok, now have arena-set with at least 1 empty/available arena-desc */
- curr = aroot->curr++;
- adesc = &(aroot->set[curr]);
- assert(!adesc->arena);
-
- Newx(adesc->arena, arena_size, char);
- adesc->size = arena_size;
- adesc->utype = bodytype;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n",
- curr, (void*)adesc->arena, (UV)arena_size));
-
- return adesc->arena;
-}
-
-
-/* return a thing to the free list */
-
-#define del_body(thing, root) \
- STMT_START { \
- void ** const thing_copy = (void **)thing;\
- *thing_copy = *root; \
- *root = (void*)thing_copy; \
- } STMT_END
-
-/*
=head1 SV-Body Allocation
@@ -805,11 +750,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 allocates a new 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.
@@ -817,10 +762,6 @@ supporting the multiple body-types.
If PURIFY is defined, or PERL_ARENA_SIZE=0, arenas are not used, and
the (new|del)_X*V macros are mapped directly to malloc/free.
-*/
-
-/*
-
For each sv-type, struct body_details bodies_by_type[] carries
parameters which control these aspects of SV handling:
@@ -948,7 +889,7 @@ static const struct body_details bodies_by_type[] = {
sizeof(regexp),
0,
SVt_REGEXP, FALSE, NONV, HASARENA,
- FIT_ARENA(0, sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur))
+ FIT_ARENA(0, sizeof(regexp))
},
/* 48 */
@@ -996,8 +937,14 @@ static const struct body_details bodies_by_type[] = {
(void *)((char *)S_new_body(aTHX_ sv_type) \
- bodies_by_type[sv_type].offset)
-#define del_body_allocated(p, sv_type) \
- del_body(p + bodies_by_type[sv_type].offset, &PL_body_roots[sv_type])
+/* return a thing to the free list */
+
+#define del_body(thing, root) \
+ STMT_START { \
+ void ** const thing_copy = (void **)thing; \
+ *thing_copy = *root; \
+ *root = (void*)thing_copy; \
+ } STMT_END
#ifdef PURIFY
@@ -1013,7 +960,8 @@ static const struct body_details bodies_by_type[] = {
#define new_XPVNV() new_body_allocated(SVt_PVNV)
#define new_XPVMG() new_body_allocated(SVt_PVMG)
-#define del_XPVGV(p) del_body_allocated(p, SVt_PVGV)
+#define del_XPVGV(p) del_body(p + bodies_by_type[SVt_PVGV].offset, \
+ &PL_body_roots[SVt_PVGV])
#endif /* PURIFY */
@@ -1024,16 +972,18 @@ 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)
+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];
- const struct body_details * const bdp = &bodies_by_type[sv_type];
- const size_t body_size = bdp->body_size;
+ struct arena_desc *adesc;
+ struct arena_set *aroot = (struct arena_set *) PL_body_arenas;
+ unsigned int curr;
char *start;
const char *end;
- const size_t arena_size = Perl_malloc_good_size(bdp->arena_size);
+ const size_t good_arena_size = Perl_malloc_good_size(arena_size);
#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
static bool done_sanity_check;
@@ -1049,37 +999,68 @@ S_more_bodies (pTHX_ const svtype sv_type)
}
#endif
- assert(bdp->arena_size);
+ assert(arena_size);
- start = (char*) Perl_get_arena(aTHX_ arena_size, sv_type);
+ /* may need new arena-set to hold new arena */
+ if (!aroot || aroot->curr >= aroot->set_size) {
+ struct arena_set *newroot;
+ Newxz(newroot, 1, struct arena_set);
+ newroot->set_size = ARENAS_PER_SET;
+ newroot->next = aroot;
+ aroot = newroot;
+ PL_body_arenas = (void *) newroot;
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)aroot));
+ }
+
+ /* ok, now have arena-set with at least 1 empty/available arena-desc */
+ curr = aroot->curr++;
+ adesc = &(aroot->set[curr]);
+ assert(!adesc->arena);
+
+ Newx(adesc->arena, good_arena_size, char);
+ adesc->size = good_arena_size;
+ adesc->utype = sv_type;
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %"UVuf"\n",
+ curr, (void*)adesc->arena, (UV)good_arena_size));
- end = start + arena_size - 2 * body_size;
+ start = (char *) adesc->arena;
+
+ /* Get the address of the byte after the end of the last body we can fit.
+ Remember, this is integer division: */
+ end = start + good_arena_size / body_size * body_size;
/* computed count doesnt reflect the 1st slot reservation */
#if defined(MYMALLOC) || defined(HAS_MALLOC_GOOD_SIZE)
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d (from %d) type %d "
"size %d ct %d\n",
- (void*)start, (void*)end, (int)arena_size,
- (int)bdp->arena_size, sv_type, (int)body_size,
- (int)arena_size / (int)body_size));
+ (void*)start, (void*)end, (int)good_arena_size,
+ (int)arena_size, sv_type, (int)body_size,
+ (int)good_arena_size / (int)body_size));
#else
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d type %d size %d ct %d\n",
(void*)start, (void*)end,
- (int)bdp->arena_size, sv_type, (int)body_size,
- (int)bdp->arena_size / (int)body_size));
+ (int)arena_size, sv_type, (int)body_size,
+ (int)good_arena_size / (int)body_size));
#endif
*root = (void *)start;
- while (start <= end) {
+ while (1) {
+ /* Where the next body would start: */
char * const next = start + body_size;
+
+ if (next >= end) {
+ /* This is the last body: */
+ assert(next == end);
+
+ *(void **)start = 0;
+ return *root;
+ }
+
*(void**) start = (void *)next;
start = next;
}
- *(void **)start = 0;
-
- return *root;
}
/* grab a new thing from the free list, allocating more if necessary.
@@ -1090,7 +1071,9 @@ S_more_bodies (pTHX_ const svtype sv_type)
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); \
} STMT_END
--
Perl5 Master Repository