Nicholas Clark wrote:
On Sat, Aug 20, 2005 at 10:03:50AM -0600, Jim Cromie wrote:
ALSO (near the top, so everyone reads it)
please note the comment below. I think Im missing something, perhaps an old
bug / suboptimality.
static int sizeof_body_by_svtype[] = {
0, /* SVt_NULLs, SVt_IVs, SVt_NVs, SVt_RVs have no body */
0,
sizeof(XPVNV), /* 20: seems wrong, but matches old code */
0,
...
Is wrong. NVs (with IVs) were the original allocation hack, where only
sizeof(NV) [or sizeof(IV)] got allocated, but the pointer to the allocated
bit of memory was manipulated downwards, so that it pointed into somewhere
else, but (pointer + structure offset of NV slot) pointed to the allocated
NV-sized piece of memory.
And this is probably invasive enough as it is.
Needs a good smoking.
I'd go with that - smoke this first, then see what's next.
Ok. heres a version that fixes the above wrongness.
As ever, it may introduce new / improved wrongness.
it uses xpv-allocated for SVt_NV, since thats what holds them,
but it has no offset, since nv is the 1st member in that struct.
+static int sizeof_body_by_svtype[] = {
+ 0, /* SVt_NULLs, SVt_IVs, SVt_NVs, SVt_RVs have no body */
+ 0,
+ sizeof(xpv_allocated), /* 8 byts on 686 */
+ 0,
+ sizeof(xpv_allocated), /* 8 byts on 686 */
Im kinda guessing here, I dont have sufficient time to really grok the code.
It almost passes tests, failing 1 in threaded, 2 in nonthreaded
t/op/sprintf..............................FAILED at test 239
lib/Benchmark.............................# Failed test
(../lib/Benchmark.t at line 80)
FAILED at test 13
diff -ruN -X exclude-diffs ../bleadperl/intrpvar.h arena-4/intrpvar.h
--- ../bleadperl/intrpvar.h 2005-06-29 02:41:56.000000000 -0600
+++ arena-4/intrpvar.h 2005-09-06 10:47:14.000000000 -0600
@@ -245,18 +245,10 @@
PERLVAR(Isighandlerp, Sighandler_t)
-PERLVAR(Ixnv_root, NV *) /* free xnv list */
-PERLVAR(Ixpv_root, xpv_allocated *) /* free xpv list */
-PERLVAR(Ixpviv_root, xpviv_allocated *) /* free xpviv list */
-PERLVAR(Ixpvnv_root, XPVNV *) /* free xpvnv list */
-PERLVAR(Ixpvcv_root, XPVCV *) /* free xpvcv list */
-PERLVAR(Ixpvav_root, xpvav_allocated *) /* free xpvav list */
-PERLVAR(Ixpvhv_root, xpvhv_allocated *) /* free xpvhv list */
-PERLVAR(Ixpvmg_root, XPVMG *) /* free xpvmg list */
-PERLVAR(Ixpvgv_root, XPVGV *) /* free xpvgv list */
-PERLVAR(Ixpvlv_root, XPVLV *) /* free xpvlv list */
-PERLVAR(Ixpvbm_root, XPVBM *) /* free xpvbm list */
+PERLVARA(Ibody_roots, SVt_LAST, void*) /* array of body roots */
+
PERLVAR(Ihe_root, HE *) /* free he list */
+
#if defined(USE_ITHREADS)
PERLVAR(Ipte_root, struct ptr_tbl_ent *) /* free ptr_tbl_ent list */
#endif
@@ -424,21 +416,14 @@
#endif
PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */
-PERLVAR(Ixnv_arenaroot, XPV*) /* list of allocated xnv areas
*/
-PERLVAR(Ixpv_arenaroot, xpv_allocated *) /* list of allocated
xpv areas */
-PERLVAR(Ixpviv_arenaroot,xpviv_allocated*) /* list of allocated xpviv
areas */
-PERLVAR(Ixpvnv_arenaroot,XPVNV*) /* list of allocated xpvnv areas */
-PERLVAR(Ixpvcv_arenaroot,XPVCV*) /* list of allocated xpvcv areas */
-PERLVAR(Ixpvav_arenaroot,xpvav_allocated*) /* list of allocated xpvav
areas */
-PERLVAR(Ixpvhv_arenaroot,xpvhv_allocated*) /* list of allocated xpvhv
areas */
-PERLVAR(Ixpvmg_arenaroot,XPVMG*) /* list of allocated xpvmg areas */
-PERLVAR(Ixpvgv_arenaroot,XPVGV*) /* list of allocated xpvgv areas */
-PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */
-PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */
+PERLVARA(Ibody_arenaroots, SVt_LAST, void*) /* consolidated body-arena
pointers */
+
PERLVAR(Ihe_arenaroot, HE *) /* list of allocated he areas */
#if defined(USE_ITHREADS)
PERLVAR(Ipte_arenaroot, struct ptr_tbl_ent *) /* list of allocated pte
areas */
+
#endif
+
/* 5.6.0 stopped here */
PERLVAR(Ipsig_pend, int *) /* per-signal "count" of pending */
diff -ruN -X exclude-diffs ../bleadperl/sv.c arena-4/sv.c
--- ../bleadperl/sv.c 2005-08-25 09:19:41.000000000 -0600
+++ arena-4/sv.c 2005-09-06 10:47:14.000000000 -0600
@@ -76,11 +76,11 @@
PL_sv_arenaroot pointer to list of SV arenas
PL_sv_root pointer to list of free SV structures
- PL_foo_arenaroot pointer to list of foo arenas,
- PL_foo_root pointer to list of free foo bodies
- ... for foo in xiv, xnv, xrv, xpv etc.
+ PL_body_arenaroots[] array of pointers to list of arenas, 1 per svtype
+ PL_body_roots[] array of pointers to list of free bodies of svtype
+ arrays are indexed by the svtype needed
-Note that some of the larger and more rarely used body types (eg xpvio)
+Note some of the larger and more rarely used body types (eg xpvio)
are not allocated using arenas, but are instead just malloc()/free()ed as
required. Also, if PURIFY is defined, arenas are abandoned altogether,
with all items individually malloc()ed. In addition, a few SV heads are
@@ -551,7 +551,6 @@
=cut
*/
-
#define free_arena(name) \
STMT_START { \
S_free_arena(aTHX_ (void**) PL_ ## name ## _arenaroot); \
@@ -564,6 +563,7 @@
{
SV* sva;
SV* svanext;
+ int i;
/* Free arenas here, but be careful about fake ones. (We assume
contiguity of the fake ones with the corresponding real ones.) */
@@ -576,18 +576,13 @@
if (!SvFAKE(sva))
Safefree(sva);
}
-
- free_arena(xnv);
- free_arena(xpv);
- free_arena(xpviv);
- free_arena(xpvnv);
- free_arena(xpvcv);
- free_arena(xpvav);
- free_arena(xpvhv);
- free_arena(xpvmg);
- free_arena(xpvgv);
- free_arena(xpvlv);
- free_arena(xpvbm);
+
+ for (i=0; i<SVt_LAST; i++) {
+ S_free_arena(aTHX_ (void**) PL_body_arenaroots[i]);
+ PL_body_arenaroots[i] = 0;
+ PL_body_roots[i] = 0;
+ }
+
free_arena(he);
#if defined(USE_ITHREADS)
free_arena(pte);
@@ -1081,18 +1076,60 @@
"", "", "");
}
+/*
+ Here are mid-level routines that manage the allocation of bodies out
+ of the various arenas. There are 5 kinds of arenas:
+
+ 1. SV-head arenas, which are discussed and handled above
+ 2. regular body arenas
+ 3. arenas for reduced-size bodies
+ 4. Hash-Entry arenas
+ 5. pte arenas (thread related)
+
+ Arena types 2 & 3 are chained by body-type off an array of
+ arena-root pointers, which is indexed by svtype. Some of the
+ larger/less used body types are malloced singly, since a large
+ unused block of them is wasteful. Also, several svtypes dont have
+ bodies; the data fits into the sv-head itself. The arena-root
+ pointer thus has a few unused root-pointers (which may be hijacked
+ later for arena types 4,5)
+
+ 3 differs from 2 as an optimization; some body types have several
+ unused fields in the front of the structure (which are kept in-place
+ for consistency). These bodies can be allocated in smaller chunks,
+ 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.
+
+ Arena types 4 & 5 are chained off of separate root-pointers. They
+ may be unified someday with 2 & 3, but they are not sv-body types,
+ and their usage patterns are different, so need to be considered
+ separately.
+*/
+
STATIC void *
-S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
+S_more_bodies (pTHX_ size_t size, svtype sv_type)
{
+ void **arena_root = &PL_body_arenaroots[sv_type];
+ void **root = &PL_body_roots[sv_type];
char *start;
const char *end;
- const size_t count = PERL_ARENA_SIZE/size;
+ const size_t count = (PL_nice_chunk) /* tbc: add per svtype arena
sizing */
+ ? (PL_nice_chunk_size/size)
+ : (PERL_ARENA_SIZE/size);
+
Newx(start, count*size, char);
*((void **) start) = *arena_root;
*arena_root = (void *)start;
end = start + (count-1) * size;
+ /* marking arena with size may allow combining multiple same-sized
+ svtypes in single arena. But not yet..
+ (size_t)((SV*)start)->sv_u.svu_uv = size;
+ */
+ SvFLAGS((SV*)start) = sv_type;
+
/* The initial slot is used to link the arenas together, so it isn't to be
linked into the list of ready-to-use bodies. */
@@ -1114,11 +1151,11 @@
/* 1st, the inline version */
-#define new_body_inline(xpv, arena_root, root, size) \
+#define new_body_inline(xpv, root, size, sv_type) \
STMT_START { \
LOCK_SV_MUTEX; \
xpv = *((void **)(root)) \
- ? *((void **)(root)) : S_more_bodies(aTHX_ arena_root, root, size); \
+ ? *((void **)(root)) : S_more_bodies(aTHX_ size, sv_type); \
*(root) = *(void**)(xpv); \
UNLOCK_SV_MUTEX; \
} STMT_END
@@ -1126,10 +1163,10 @@
/* now use the inline version in the proper function */
STATIC void *
-S_new_body(pTHX_ void **arena_root, void **root, size_t size)
+S_new_body(pTHX_ size_t size, svtype sv_type)
{
void *xpv;
- new_body_inline(xpv, arena_root, root, size);
+ new_body_inline(xpv, &PL_body_roots[sv_type], size, sv_type);
return xpv;
}
@@ -1144,31 +1181,19 @@
UNLOCK_SV_MUTEX; \
} STMT_END
-/* Conventionally we simply malloc() a big block of memory, then divide it
- up into lots of the thing that we're allocating.
-
- This macro will expand to call to S_new_body. So for XPVBM (with ithreads),
- it would become
-
- S_new_body(my_perl, (void**)&(my_perl->Ixpvbm_arenaroot),
- (void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0)
-*/
-
-#define new_body_type(TYPE,lctype) \
- S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
- (void**)&PL_ ## lctype ## _root, \
- sizeof(TYPE))
-
-#define del_body_type(p,TYPE,lctype) \
- del_body((void*)p, (void**)&PL_ ## lctype ## _root)
-
-/* But for some types, we cheat. The type starts with some members that are
- never accessed. So we allocate the substructure, starting at the first used
- member, then adjust the pointer back in memory by the size of the bit not
- allocated, so it's as if we allocated the full structure.
- (But things will all go boom if you write to the part that is "not there",
- because you'll be overwriting the last members of the preceding structure
- in memory.)
+/*
+ Revisiting type 3 arenas, there are 4 body-types which have some
+ members that are never accessed. They are XPV, XPVIV, XPVAV,
+ XPVHV, which have corresponding types: xpv_allocated,
+ xpviv_allocated, xpvav_allocated, xpvhv_allocated,
+
+ For these types, the arenas are carved up into *_allocated size
+ chunks, we thus avoid wasted memory for those unaccessed members.
+ When bodies are allocated, we adjust the pointer back in memory by
+ the size of the bit not allocated, so it's as if we allocated the
+ full structure. (But things will all go boom if you write to the
+ part that is "not there", because you'll be overwriting the last
+ members of the preceding structure in memory.)
We calculate the correction using the STRUCT_OFFSET macro. For example, if
xpv_allocated is the same structure as XPV then the two OFFSETs sum to zero,
@@ -1182,18 +1207,79 @@
start of the structure. IV bodies don't need it either, because they are
no longer allocated. */
-#define new_body_allocated(TYPE,lctype,member) \
- (void*)((char*)S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
- (void**)&PL_ ## lctype ## _root, \
- sizeof(lctype ## _allocated)) - \
- STRUCT_OFFSET(TYPE, member) \
- + STRUCT_OFFSET(lctype ## _allocated, member))
+/* The following 2 arrays hide the above details in a pair of
+ lookup-tables, allowing us to be body-type agnostic.
+
+ sizeof_body_by_svtype[] maps svtype to its body's allocated size.
+ offset_by_type[] maps svtype to the body-pointer adjustment needed
+ NB: elements in latter are 0 or <0, and are added during
+ allocation, and subtracted during deallocation. It may be clearer
+ to invert the values, and call it shrinkage_by_svtype.
+*/
+
+static int sizeof_body_by_svtype[] = {
+ 0, /* SVt_NULLs, SVt_IVs, SVt_NVs, SVt_RVs have no body */
+ 0,
+ sizeof(xpv_allocated), /* 8 byts on 686 */
+ 0,
+ sizeof(xpv_allocated), /* 8 byts on 686 */
+ sizeof(xpviv_allocated), /* 12 */
+ sizeof(XPVNV), /* 20 */
+ sizeof(XPVMG), /* 28 */
+ sizeof(XPVBM), /* 36 */
+ sizeof(XPVGV), /* 48 */
+ sizeof(XPVLV), /* 64 */
+ sizeof(xpvav_allocated), /* 20 */
+ sizeof(xpvhv_allocated), /* 20 */
+ sizeof(XPVCV), /* 76 */
+ sizeof(XPVFM), /* 80 */
+ sizeof(XPVIO) /* 84 */
+};
+#define SIZE_SVTYPES sizeof(sizeof_body_by_svtype)
+
+static int offset_by_svtype[] = {
+ 0,
+ 0,
+ 0,
+ 0,
+ STRUCT_OFFSET(xpv_allocated, xpv_cur) - STRUCT_OFFSET(XPV, xpv_cur),
+ STRUCT_OFFSET(xpviv_allocated, xpv_cur) - STRUCT_OFFSET(XPVIV, xpv_cur),
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ STRUCT_OFFSET(xpvav_allocated, xav_fill) - STRUCT_OFFSET(XPVAV, xav_fill),
+ STRUCT_OFFSET(xpvhv_allocated, xhv_fill) - STRUCT_OFFSET(XPVHV, xhv_fill),
+ 0,
+ 0,
+ 0,
+};
+#define SIZE_OFFSETS sizeof(sizeof_body_by_svtype)
+
+/* they better stay synchronized, but this doesnt do it.
+ #if SIZE_SVTYPES != SIZE_OFFSETS
+ #error "declaration problem: sizeof_body_by_svtype !=
sizeof(offset_by_svtype)"
+ #endif
+*/
+
+
+#define new_body_type(sv_type) \
+ S_new_body(aTHX_ sizeof_body_by_svtype[sv_type], sv_type) \
+ + offset_by_svtype[sv_type]
+
+#define del_body_type(p, sv_type) \
+ del_body(p, &PL_body_roots[sv_type])
+
+
+#define new_body_allocated(sv_type) \
+ S_new_body(aTHX_ sizeof_body_by_svtype[sv_type], sv_type) \
+ + offset_by_svtype[sv_type]
+
+#define del_body_allocated(p, sv_type) \
+ del_body(p - offset_by_svtype[sv_type], &PL_body_roots[sv_type])
-#define del_body_allocated(p,TYPE,lctype,member) \
- del_body((void*)((char*)p + STRUCT_OFFSET(TYPE, member) \
- - STRUCT_OFFSET(lctype ## _allocated, member)), \
- (void**)&PL_ ## lctype ## _root)
#define my_safemalloc(s) (void*)safemalloc(s)
#define my_safefree(p) safefree((char*)p)
@@ -1235,47 +1321,50 @@
#else /* !PURIFY */
-#define new_XNV() new_body_type(NV, xnv)
-#define del_XNV(p) del_body_type(p, NV, xnv)
+#define new_XNV() new_body_type(SVt_NV)
+#define del_XNV(p) del_body_type(p, SVt_NV)
-#define new_XPV() new_body_allocated(XPV, xpv, xpv_cur)
-#define del_XPV(p) del_body_allocated(p, XPV, xpv, xpv_cur)
+#define new_XPV() new_body_allocated(SVt_PV)
+#define del_XPV(p) del_body_allocated(p, SVt_PV)
-#define new_XPVIV() new_body_allocated(XPVIV, xpviv, xpv_cur)
-#define del_XPVIV(p) del_body_allocated(p, XPVIV, xpviv, xpv_cur)
+#define new_XPVIV() new_body_allocated(SVt_PVIV)
+#define del_XPVIV(p) del_body_allocated(p, SVt_PVIV)
-#define new_XPVNV() new_body_type(XPVNV, xpvnv)
-#define del_XPVNV(p) del_body_type(p, XPVNV, xpvnv)
+#define new_XPVNV() new_body_type(SVt_PVNV)
+#define del_XPVNV(p) del_body_type(p, SVt_PVNV)
-#define new_XPVCV() new_body_type(XPVCV, xpvcv)
-#define del_XPVCV(p) del_body_type(p, XPVCV, xpvcv)
+#define new_XPVCV() new_body_type(SVt_PVCV)
+#define del_XPVCV(p) del_body_type(p, SVt_PVCV)
-#define new_XPVAV() new_body_allocated(XPVAV, xpvav, xav_fill)
-#define del_XPVAV(p) del_body_allocated(p, XPVAV, xpvav, xav_fill)
+#define new_XPVAV() new_body_allocated(SVt_PVAV)
+#define del_XPVAV(p) del_body_allocated(p, SVt_PVAV)
-#define new_XPVHV() new_body_allocated(XPVHV, xpvhv, xhv_fill)
-#define del_XPVHV(p) del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
+#define new_XPVHV() new_body_allocated(SVt_PVHV)
+#define del_XPVHV(p) del_body_allocated(p, SVt_PVHV)
-#define new_XPVMG() new_body_type(XPVMG, xpvmg)
-#define del_XPVMG(p) del_body_type(p, XPVMG, xpvmg)
+#define new_XPVMG() new_body_type(SVt_PVMG)
+#define del_XPVMG(p) del_body_type(p, SVt_PVMG)
-#define new_XPVGV() new_body_type(XPVGV, xpvgv)
-#define del_XPVGV(p) del_body_type(p, XPVGV, xpvgv)
+#define new_XPVGV() new_body_type(SVt_PVGV)
+#define del_XPVGV(p) del_body_type(p, SVt_PVGV)
-#define new_XPVLV() new_body_type(XPVLV, xpvlv)
-#define del_XPVLV(p) del_body_type(p, XPVLV, xpvlv)
+#define new_XPVLV() new_body_type(SVt_PVLV)
+#define del_XPVLV(p) del_body_type(p, SVt_PVLV)
-#define new_XPVBM() new_body_type(XPVBM, xpvbm)
-#define del_XPVBM(p) del_body_type(p, XPVBM, xpvbm)
+#define new_XPVBM() new_body_type(SVt_PVBM)
+#define del_XPVBM(p) del_body_type(p, SVt_PVBM)
#endif /* PURIFY */
+/* no arena for you! */
#define new_XPVFM() my_safemalloc(sizeof(XPVFM))
#define del_XPVFM(p) my_safefree(p)
#define new_XPVIO() my_safemalloc(sizeof(XPVIO))
#define del_XPVIO(p) my_safefree(p)
+
+
/*
=for apidoc sv_upgrade
@@ -1372,7 +1461,7 @@
old_body_length = sizeof(IV);
break;
case SVt_NV:
- old_body_arena = (void **) &PL_xnv_root;
+ old_body_arena = &PL_body_roots[SVt_NV];
old_body_length = sizeof(NV);
#ifndef NV_ZERO_IS_ALLBITS_ZERO
zero_nv = FALSE;
@@ -1383,9 +1472,8 @@
case SVt_RV:
break;
case SVt_PV:
- old_body_arena = (void **) &PL_xpv_root;
- old_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
- - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+ old_body_arena = &PL_body_roots[SVt_PV];
+ old_body_offset = - offset_by_svtype[SVt_PVIV];
old_body_length = STRUCT_OFFSET(XPV, xpv_len)
+ sizeof (((XPV*)SvANY(sv))->xpv_len)
- old_body_offset;
@@ -1395,15 +1483,14 @@
mt = SVt_PVNV;
break;
case SVt_PVIV:
- old_body_arena = (void **) &PL_xpviv_root;
- old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
- - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
- old_body_length = STRUCT_OFFSET(XPVIV, xiv_u)
- + sizeof (((XPVIV*)SvANY(sv))->xiv_u)
- - old_body_offset;
+ old_body_arena = &PL_body_roots[SVt_PVIV];
+ old_body_offset = - offset_by_svtype[SVt_PVIV];
+ old_body_length = STRUCT_OFFSET(XPVIV, xiv_u);
+ old_body_length += sizeof (((XPVIV*)SvANY(sv))->xiv_u);
+ old_body_length -= old_body_offset;
break;
case SVt_PVNV:
- old_body_arena = (void **) &PL_xpvnv_root;
+ old_body_arena = &PL_body_roots[SVt_PVNV];
old_body_length = STRUCT_OFFSET(XPVNV, xiv_u)
+ sizeof (((XPVNV*)SvANY(sv))->xiv_u);
#ifndef NV_ZERO_IS_ALLBITS_ZERO
@@ -1419,7 +1506,7 @@
Given that it only has meaning inside the pad, it shouldn't be set
on anything that can get upgraded. */
assert((SvFLAGS(sv) & SVpad_TYPED) == 0);
- old_body_arena = (void **) &PL_xpvmg_root;
+ old_body_arena = &PL_body_roots[SVt_PVMG];
old_body_length = STRUCT_OFFSET(XPVMG, xmg_stash)
+ sizeof (((XPVMG*)SvANY(sv))->xmg_stash);
#ifndef NV_ZERO_IS_ALLBITS_ZERO
@@ -1498,41 +1585,21 @@
goto zero;
case SVt_PVBM:
- new_body_length = sizeof(XPVBM);
- new_body_arena = (void **) &PL_xpvbm_root;
- new_body_arenaroot = (void **) &PL_xpvbm_arenaroot;
- goto new_body;
case SVt_PVGV:
- new_body_length = sizeof(XPVGV);
- new_body_arena = (void **) &PL_xpvgv_root;
- new_body_arenaroot = (void **) &PL_xpvgv_arenaroot;
- goto new_body;
case SVt_PVCV:
- new_body_length = sizeof(XPVCV);
- new_body_arena = (void **) &PL_xpvcv_root;
- new_body_arenaroot = (void **) &PL_xpvcv_arenaroot;
- goto new_body;
case SVt_PVLV:
- new_body_length = sizeof(XPVLV);
- new_body_arena = (void **) &PL_xpvlv_root;
- new_body_arenaroot = (void **) &PL_xpvlv_arenaroot;
- goto new_body;
case SVt_PVMG:
- new_body_length = sizeof(XPVMG);
- new_body_arena = (void **) &PL_xpvmg_root;
- new_body_arenaroot = (void **) &PL_xpvmg_arenaroot;
- goto new_body;
case SVt_PVNV:
- new_body_length = sizeof(XPVNV);
- new_body_arena = (void **) &PL_xpvnv_root;
- new_body_arenaroot = (void **) &PL_xpvnv_arenaroot;
+ new_body_length = sizeof_body_by_svtype[mt];
+ new_body_arena = &PL_body_roots[mt];
+ new_body_arenaroot = &PL_body_arenaroots[mt];
goto new_body;
+
case SVt_PVIV:
- new_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
- - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
+ new_body_offset = - offset_by_svtype[SVt_PVIV];
new_body_length = sizeof(XPVIV) - new_body_offset;
- new_body_arena = (void **) &PL_xpviv_root;
- new_body_arenaroot = (void **) &PL_xpviv_arenaroot;
+ new_body_arena = &PL_body_roots[SVt_PVIV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PVIV];
/* XXX Is this still needed? Was it ever needed? Surely as there is
no route from NV to PVIV, NOK can never be true */
if (SvNIOK(sv))
@@ -1540,11 +1607,10 @@
SvNOK_off(sv);
goto new_body_no_NV;
case SVt_PV:
- new_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
- - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+ new_body_offset = - offset_by_svtype[SVt_PV];
new_body_length = sizeof(XPV) - new_body_offset;
- new_body_arena = (void **) &PL_xpv_root;
- new_body_arenaroot = (void **) &PL_xpv_arenaroot;
+ new_body_arena = &PL_body_roots[SVt_PV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PV];
new_body_no_NV:
/* PV and PVIV don't have an NV slot. */
#ifndef NV_ZERO_IS_ALLBITS_ZERO
@@ -1555,8 +1621,7 @@
assert(new_body_length);
#ifndef PURIFY
/* This points to the start of the allocated area. */
- new_body_inline(new_body, new_body_arenaroot, new_body_arena,
- new_body_length);
+ new_body_inline(new_body, new_body_arena, new_body_length, mt);
#else
/* We always allocated the full length item with PURIFY */
new_body_length += new_body_offset;
@@ -5576,22 +5641,22 @@
/* PVIOs aren't from arenas */
goto freescalar;
case SVt_PVBM:
- old_body_arena = (void **) &PL_xpvbm_root;
+ old_body_arena = &PL_body_roots[SVt_PVBM];
goto freescalar;
case SVt_PVCV:
- old_body_arena = (void **) &PL_xpvcv_root;
+ old_body_arena = &PL_body_roots[SVt_PVCV];
case SVt_PVFM:
/* PVFMs aren't from arenas */
cv_undef((CV*)sv);
goto freescalar;
case SVt_PVHV:
hv_undef((HV*)sv);
- old_body_arena = (void **) &PL_xpvhv_root;
+ old_body_arena = &PL_body_roots[SVt_PVHV];
old_body_offset = STRUCT_OFFSET(XPVHV, xhv_fill);
break;
case SVt_PVAV:
av_undef((AV*)sv);
- old_body_arena = (void **) &PL_xpvav_root;
+ old_body_arena = &PL_body_roots[SVt_PVAV];
old_body_offset = STRUCT_OFFSET(XPVAV, xav_fill);
break;
case SVt_PVLV:
@@ -5602,7 +5667,7 @@
}
else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV** */
SvREFCNT_dec(LvTARG(sv));
- old_body_arena = (void **) &PL_xpvlv_root;
+ old_body_arena = &PL_body_roots[SVt_PVLV];
goto freescalar;
case SVt_PVGV:
gp_free((GV*)sv);
@@ -5611,16 +5676,16 @@
have a back reference to us, which needs to be cleared. */
if (GvSTASH(sv))
sv_del_backref((SV*)GvSTASH(sv), sv);
- old_body_arena = (void **) &PL_xpvgv_root;
+ old_body_arena = &PL_body_roots[SVt_PVGV];
goto freescalar;
case SVt_PVMG:
- old_body_arena = (void **) &PL_xpvmg_root;
+ old_body_arena = &PL_body_roots[SVt_PVMG];
goto freescalar;
case SVt_PVNV:
- old_body_arena = (void **) &PL_xpvnv_root;
+ old_body_arena = &PL_body_roots[SVt_PVNV];
goto freescalar;
case SVt_PVIV:
- old_body_arena = (void **) &PL_xpviv_root;
+ old_body_arena = &PL_body_roots[SVt_PVIV];
old_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur);
freescalar:
/* Don't bother with SvOOK_off(sv); as we're only going to free it. */
@@ -5630,7 +5695,7 @@
}
goto pvrv_common;
case SVt_PV:
- old_body_arena = (void **) &PL_xpv_root;
+ old_body_arena = &PL_body_roots[SVt_PV];
old_body_offset = STRUCT_OFFSET(XPV, xpv_cur);
case SVt_RV:
pvrv_common:
@@ -5668,7 +5733,7 @@
#endif
break;
case SVt_NV:
- old_body_arena = (void **) &PL_xnv_root;
+ old_body_arena = PL_body_roots[SVt_NV]; //(void **) &PL_xnv_root;
break;
}
@@ -9101,11 +9166,9 @@
}
if (!asterisk)
- {
if( *q == '0' )
fill = *q++;
EXPECT_NUMBER(q, width);
- }
if (vectorize) {
if (vectorarg) {
@@ -10153,7 +10216,7 @@
# define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2)
#endif
-#define del_pte(p) del_body_type(p, struct ptr_tbl_ent, pte)
+#define del_pte(p) del_body((void*)p, (void**)&PL_pte_root)
/* map an existing pointer using a table */
@@ -10191,8 +10254,8 @@
return;
}
}
- new_body_inline(tblent, (void**)&PL_pte_arenaroot, (void**)&PL_pte_root,
- sizeof(struct ptr_tbl_ent));
+ new_body_inline(tblent, (void**)&PL_pte_root,
+ sizeof(struct ptr_tbl_ent), 1);
tblent->oldval = oldv;
tblent->newval = newv;
tblent->next = *otblent;
@@ -10414,8 +10477,9 @@
void **new_body_arena;
void **new_body_arenaroot;
void *new_body;
+ svtype sv_type = SvTYPE(sstr);
- switch (SvTYPE(sstr)) {
+ switch (sv_type) {
default:
Perl_croak(aTHX_ "Bizarre SvTYPE [%" IVdf "]",
(IV)SvTYPE(sstr));
@@ -10431,74 +10495,54 @@
break;
case SVt_PVHV:
- new_body_arena = (void **) &PL_xpvhv_root;
- new_body_arenaroot = (void **) &PL_xpvhv_arenaroot;
- new_body_offset = STRUCT_OFFSET(XPVHV, xhv_fill)
- - STRUCT_OFFSET(xpvhv_allocated, xhv_fill);
+ new_body_arena = &PL_body_roots[SVt_PVHV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PVHV];
+ new_body_offset = - offset_by_svtype[SVt_PVHV];
+
new_body_length = STRUCT_OFFSET(XPVHV, xmg_stash)
+ sizeof (((XPVHV*)SvANY(sstr))->xmg_stash)
- new_body_offset;
goto new_body;
case SVt_PVAV:
- new_body_arena = (void **) &PL_xpvav_root;
- new_body_arenaroot = (void **) &PL_xpvav_arenaroot;
- new_body_offset = STRUCT_OFFSET(XPVAV, xav_fill)
- - STRUCT_OFFSET(xpvav_allocated, xav_fill);
+ new_body_arena = &PL_body_roots[SVt_PVAV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PVAV];
+ new_body_offset = - offset_by_svtype[SVt_PVAV];
+
new_body_length = STRUCT_OFFSET(XPVHV, xmg_stash)
+ sizeof (((XPVHV*)SvANY(sstr))->xmg_stash)
- new_body_offset;
goto new_body;
- case SVt_PVBM:
- new_body_length = sizeof(XPVBM);
- new_body_arena = (void **) &PL_xpvbm_root;
- new_body_arenaroot = (void **) &PL_xpvbm_arenaroot;
- goto new_body;
case SVt_PVGV:
if (GvUNIQUE((GV*)sstr)) {
- /* Do sharing here. */
+ /* Do sharing here, and fall thru */
}
- new_body_length = sizeof(XPVGV);
- new_body_arena = (void **) &PL_xpvgv_root;
- new_body_arenaroot = (void **) &PL_xpvgv_arenaroot;
- goto new_body;
+ case SVt_PVBM:
case SVt_PVCV:
- new_body_length = sizeof(XPVCV);
- new_body_arena = (void **) &PL_xpvcv_root;
- new_body_arenaroot = (void **) &PL_xpvcv_arenaroot;
- goto new_body;
case SVt_PVLV:
- new_body_length = sizeof(XPVLV);
- new_body_arena = (void **) &PL_xpvlv_root;
- new_body_arenaroot = (void **) &PL_xpvlv_arenaroot;
- goto new_body;
case SVt_PVMG:
- new_body_length = sizeof(XPVMG);
- new_body_arena = (void **) &PL_xpvmg_root;
- new_body_arenaroot = (void **) &PL_xpvmg_arenaroot;
- goto new_body;
case SVt_PVNV:
- new_body_length = sizeof(XPVNV);
- new_body_arena = (void **) &PL_xpvnv_root;
- new_body_arenaroot = (void **) &PL_xpvnv_arenaroot;
+ new_body_length = sizeof_body_by_svtype[sv_type];
+ new_body_arena = &PL_body_roots[sv_type];
+ new_body_arenaroot = &PL_body_arenaroots[sv_type];
goto new_body;
+
case SVt_PVIV:
- new_body_offset = STRUCT_OFFSET(XPVIV, xpv_cur)
- - STRUCT_OFFSET(xpviv_allocated, xpv_cur);
+ new_body_offset = - offset_by_svtype[SVt_PVIV];
new_body_length = sizeof(XPVIV) - new_body_offset;
- new_body_arena = (void **) &PL_xpviv_root;
- new_body_arenaroot = (void **) &PL_xpviv_arenaroot;
+ new_body_arena = &PL_body_roots[SVt_PVIV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PVIV];
goto new_body;
case SVt_PV:
- new_body_offset = STRUCT_OFFSET(XPV, xpv_cur)
- - STRUCT_OFFSET(xpv_allocated, xpv_cur);
+ new_body_offset = - offset_by_svtype[SVt_PV];
new_body_length = sizeof(XPV) - new_body_offset;
- new_body_arena = (void **) &PL_xpv_root;
- new_body_arenaroot = (void **) &PL_xpv_arenaroot;
+ new_body_arena = &PL_body_roots[SVt_PV];
+ new_body_arenaroot = &PL_body_arenaroots[SVt_PV];
new_body:
assert(new_body_length);
#ifndef PURIFY
- new_body_inline(new_body, new_body_arenaroot, new_body_arena,
- new_body_length);
+ new_body_inline(new_body, new_body_arena,
+ new_body_length, SvTYPE(sstr));
+
new_body = (void*)((char*)new_body - new_body_offset);
#else
/* We always allocated the full length item with PURIFY */
@@ -11306,31 +11350,12 @@
param->flags = flags;
param->proto_perl = proto_perl;
- /* arena roots */
- PL_xnv_arenaroot = NULL;
- PL_xnv_root = NULL;
- PL_xpv_arenaroot = NULL;
- PL_xpv_root = NULL;
- PL_xpviv_arenaroot = NULL;
- PL_xpviv_root = NULL;
- PL_xpvnv_arenaroot = NULL;
- PL_xpvnv_root = NULL;
- PL_xpvcv_arenaroot = NULL;
- PL_xpvcv_root = NULL;
- PL_xpvav_arenaroot = NULL;
- PL_xpvav_root = NULL;
- PL_xpvhv_arenaroot = NULL;
- PL_xpvhv_root = NULL;
- PL_xpvmg_arenaroot = NULL;
- PL_xpvmg_root = NULL;
- PL_xpvgv_arenaroot = NULL;
- PL_xpvgv_root = NULL;
- PL_xpvlv_arenaroot = NULL;
- PL_xpvlv_root = NULL;
- PL_xpvbm_arenaroot = NULL;
- PL_xpvbm_root = NULL;
+ Zero(&PL_body_arenaroots, 1, PL_body_arenaroots);
+ Zero(&PL_body_roots, 1, PL_body_roots);
+
PL_he_arenaroot = NULL;
PL_he_root = NULL;
+
#if defined(USE_ITHREADS)
PL_pte_arenaroot = NULL;
PL_pte_root = NULL;
diff -ruN -X exclude-diffs ../bleadperl/sv.h arena-4/sv.h
--- ../bleadperl/sv.h 2005-08-30 04:02:51.000000000 -0600
+++ arena-4/sv.h 2005-09-06 10:47:14.000000000 -0600
@@ -59,7 +59,8 @@
SVt_PVHV, /* 12 */
SVt_PVCV, /* 13 */
SVt_PVFM, /* 14 */
- SVt_PVIO /* 15 */
+ SVt_PVIO, /* 15 */
+ SVt_LAST /* keep last in enum. used to size arrays */
} svtype;
