Change 29882 by [EMAIL PROTECTED] on 2007/01/19 17:36:10
Add a parameter to Perl_get_arena() to pass in the SV type, and record
this in the arena description. Change all sizes to unsigned values.
Make Perl_sv_free_arenas() loop downwards to free memory, simplifying
the logic. Remove my erroneous comment added in change 29881.
Affected files ...
... //depot/perl/embed.fnc#452 edit
... //depot/perl/hv.c#336 edit
... //depot/perl/proto.h#790 edit
... //depot/perl/sv.c#1361 edit
Differences ...
==== //depot/perl/embed.fnc#452 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#451~29879~ 2007-01-18 16:13:02.000000000 -0800
+++ perl/embed.fnc 2007-01-19 09:36:10.000000000 -0800
@@ -1106,7 +1106,7 @@
#endif
: #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT)
-paRxo |void* |get_arena |size_t svtype
+paRxo |void* |get_arena |size_t svtype|U32 misc
: #endif
#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
==== //depot/perl/hv.c#336 (text) ====
Index: perl/hv.c
--- perl/hv.c#335~29790~ 2007-01-13 10:21:19.000000000 -0800
+++ perl/hv.c 2007-01-19 09:36:10.000000000 -0800
@@ -43,7 +43,7 @@
HE* he;
HE* heend;
- he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE);
+ he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT);
heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
PL_body_roots[HE_SVSLOT] = he;
==== //depot/perl/proto.h#790 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#789~29879~ 2007-01-18 16:13:02.000000000 -0800
+++ perl/proto.h 2007-01-19 09:36:10.000000000 -0800
@@ -2958,7 +2958,7 @@
#endif
-PERL_CALLCONV void* Perl_get_arena(pTHX_ size_t svtype)
+PERL_CALLCONV void* Perl_get_arena(pTHX_ size_t svtype, U32 misc)
__attribute__malloc__
__attribute__warn_unused_result__;
==== //depot/perl/sv.c#1361 (text) ====
Index: perl/sv.c
--- perl/sv.c#1360~29881~ 2007-01-19 03:45:24.000000000 -0800
+++ perl/sv.c 2007-01-19 09:36:10.000000000 -0800
@@ -555,9 +555,6 @@
the meta-info from the arena, we recover the 1st slot, formerly
borrowed for list management. The arena_set is about the size of an
arena, avoiding the needless malloc overhead of a naive linked-list.
- The arena_sets are themselves stored in an arena, but as arenas
- themselves are never freed at run time, there is no need to chain the
- arena_sets onto an arena_set root.
The cost is 1 arena-set malloc per ~320 arena-mallocs, + the unused
memory in the last arena-set (1/2 on average). In trade, we get
@@ -568,10 +565,7 @@
struct arena_desc {
char *arena; /* the raw storage, allocated aligned */
size_t size; /* its size ~4k typ */
- int unit_type; /* useful for arena audits */
- /* info for sv-heads (eventually)
- int count, flags;
- */
+ U32 misc; /* type, and in future other things. */
};
struct arena_set;
@@ -585,8 +579,8 @@
struct arena_set {
struct arena_set* next;
- int set_size; /* ie ARENAS_PER_SET */
- int curr; /* index of next available arena-desc */
+ unsigned int set_size; /* ie ARENAS_PER_SET */
+ unsigned int curr; /* index of next available arena-desc */
struct arena_desc set[ARENAS_PER_SET];
};
@@ -604,7 +598,7 @@
dVAR;
SV* sva;
SV* svanext;
- int i;
+ unsigned int i;
/* Free arenas here, but be careful about fake ones. (We assume
contiguity of the fake ones with the corresponding real ones.) */
@@ -619,21 +613,23 @@
}
{
- struct arena_set *next, *aroot = (struct arena_set*) PL_body_arenas;
-
- for (; aroot; aroot = next) {
- const int max = aroot->curr;
- for (i=0; i<max; i++) {
+ struct arena_set *aroot = (struct arena_set*) PL_body_arenas;
+
+ while (aroot) {
+ struct arena_set *current = aroot;
+ i = aroot->curr;
+ while (i--) {
assert(aroot->set[i].arena);
Safefree(aroot->set[i].arena);
}
- next = aroot->next;
- Safefree(aroot);
+ aroot = aroot->next;
+ Safefree(current);
}
}
PL_body_arenas = 0;
- for (i=0; i<PERL_ARENA_ROOTS_SIZE; i++)
+ i = PERL_ARENA_ROOTS_SIZE;
+ while (i--)
PL_body_roots[i] = 0;
Safefree(PL_nice_chunk);
@@ -682,12 +678,12 @@
TBD: export properly for hv.c: S_more_he().
*/
void*
-Perl_get_arena(pTHX_ size_t arena_size)
+Perl_get_arena(pTHX_ size_t arena_size, U32 misc)
{
dVAR;
struct arena_desc* adesc;
struct arena_set *aroot = (struct arena_set*) PL_body_arenas;
- int curr;
+ unsigned int curr;
/* shouldnt need this
if (!arena_size) arena_size = PERL_ARENA_SIZE;
@@ -711,6 +707,7 @@
Newx(adesc->arena, arena_size, char);
adesc->size = arena_size;
+ adesc->misc = misc;
DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %d\n",
curr, (void*)adesc->arena, arena_size));
@@ -1067,7 +1064,7 @@
assert(bdp->arena_size);
- start = (char*) Perl_get_arena(aTHX_ bdp->arena_size);
+ start = (char*) Perl_get_arena(aTHX_ bdp->arena_size, sv_type);
end = start + bdp->arena_size - body_size;
End of Patch.
