Jim Cromie wrote:
Jim Cromie wrote:
Perl_sv_add_arena is called from only 2 places in the dist,
both from S_more_sv()
<aside> should this actually be exported ?
its very internal, and is used only by a file static function.
I cant see run-of-the-mill XS using it, maybe mod-perl...
Mr Schwern, you had a link that could search all of CPAN, can you
refresh me?
</aside>
I had another quick look at this - of th 38 found by
http://cpansearch.bulknews.net/search?q=sv_add_arena
all are ppport.h, Changes5.002.
So by that measure, it can be privatized.
Soo...
Nick Clark was looking to unify the arenas, can we migrate towards it ?
and maybe pick up a few advantages on the way ?
1. SV-heads always get flags = 0, body arenas get nothing. They could
get flag set to their sv-type.
with this, we could store body arena roots into an array, and index
them by the
svtype to get the right arena. (a few less globals)
Clarifying: 1st cell of each sv_arena is reserved, and treated like
an SV.
in sv_add_arena:
svany set to existing arena-chain,
svrefct = number of sv-heads in the arena
svflags set to flags passed in, but always 0
but body areans dont get quite the same treatment.
with this patch, S_more_bodies gets closer to uniformity:
svany was already done.
now set flags to passed-in body svtype
2. recently, SV-heads got bigger, giving us the opportunity to use
the sv_u
to hold more info. One candidate is the size of the body-type.
svtype is passed in thru the new_X*() macros, into the new_body_*()
macros,
and into S_new_body, then S_more_bodies,
but setting of arena.svref this isnt done, due to some casting
friction (lvalue cast warnings)
With this (and unified arena list), we could stop walking the arena list
when we find an arena with the right sized bodies, independent of type
(assuming that some bodies have same size).
or we drop the arena-root array for a hash, and map svtype/body-type to
the body size, then follow that chain.
tested against blead thread/non-thread
thread got 1 spurious failure :
t/op/sprintf..............................FAILED at test 246
non-threaded got that one, and this also
ext/Sys/Syslog/t/syslog...................Compilation failed in
require at ../ext/Sys/Syslog/t/syslog.t line 38.
BEGIN failed--compilation aborted at ../ext/Sys/Syslog/t/syslog.t line
38.
FAILED--no leader found
neither look relevant to to this internals patch.
yes, this one. :-}
Also, attaching appatch which hacks interpvar.h, replacing all the
body-arenaroot pointers
with a single array of body-arenaroot pointers, indexed by svtype.
It also adds a bunch of #defines which map old names to respective
elements by svtype.
It works for threaded, but fails to compile for non-threaded.
something simple, im sure, but Ive missed it so far.
diff -ruN -X exclude-diffs ../bleadperl/sv.c svarena/sv.c
--- ../bleadperl/sv.c 2005-07-13 10:55:47.000000000 -0600
+++ svarena/sv.c 2005-07-14 10:19:28.000000000 -0600
@@ -1082,17 +1082,26 @@
}
STATIC void *
-S_more_bodies (pTHX_ void **arena_root, void **root, size_t size)
+S_more_bodies (pTHX_ void **arena_root, void **root, size_t size, svtype
sv_type)
{
char *start;
const char *end;
- const size_t count = PERL_ARENA_SIZE/size;
+ const size_t count = (PL_nice_chunk)
+ ? (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 +1123,12 @@
/* 1st, the inline version */
-#define new_body_inline(xpv, arena_root, root, size) \
+#define new_body_inline(xpv, arena_root, 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_ arena_root, root, size, sv_type); \
*(root) = *(void**)(xpv); \
UNLOCK_SV_MUTEX; \
} STMT_END
@@ -1126,10 +1136,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_ void **arena_root, void **root, size_t size, svtype sv_type)
{
void *xpv;
- new_body_inline(xpv, arena_root, root, size);
+ new_body_inline(xpv, arena_root, root, size, sv_type);
return xpv;
}
@@ -1154,10 +1164,10 @@
(void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0)
*/
-#define new_body_type(TYPE,lctype) \
+#define new_body_type(TYPE,lctype,sv_type) \
S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
(void**)&PL_ ## lctype ## _root, \
- sizeof(TYPE))
+ sizeof(TYPE), 0)
#define del_body_type(p,TYPE,lctype) \
del_body((void*)p, (void**)&PL_ ## lctype ## _root)
@@ -1182,13 +1192,13 @@
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))
-
+#define new_body_allocated(TYPE,lctype,member,sv_type) \
+ (void*)((char*) \
+ S_new_body(aTHX_ (void**)&PL_ ## lctype ## _arenaroot, \
+ (void**)&PL_ ## lctype ## _root, \
+ sizeof(lctype ## _allocated), sv_type) \
+ - STRUCT_OFFSET(TYPE, member) \
+ + STRUCT_OFFSET(lctype ## _allocated, member))
#define del_body_allocated(p,TYPE,lctype,member) \
del_body((void*)((char*)p + STRUCT_OFFSET(TYPE, member) \
@@ -1235,41 +1245,42 @@
#else /* !PURIFY */
-#define new_XNV() new_body_type(NV, xnv)
+#define new_XNV() new_body_type(NV, xnv, SVt_NV)
#define del_XNV(p) del_body_type(p, NV, xnv)
-#define new_XPV() new_body_allocated(XPV, xpv, xpv_cur)
+#define new_XPV() new_body_allocated(XPV, xpv, xpv_cur, SVt_PV)
#define del_XPV(p) del_body_allocated(p, XPV, xpv, xpv_cur)
-#define new_XPVIV() new_body_allocated(XPVIV, xpviv, xpv_cur)
+#define new_XPVIV() new_body_allocated(XPVIV, xpviv, xpv_cur, SVt_PVIV)
#define del_XPVIV(p) del_body_allocated(p, XPVIV, xpviv, xpv_cur)
-#define new_XPVNV() new_body_type(XPVNV, xpvnv)
+#define new_XPVNV() new_body_type(XPVNV, xpvnv, SVt_PVNV)
#define del_XPVNV(p) del_body_type(p, XPVNV, xpvnv)
-#define new_XPVCV() new_body_type(XPVCV, xpvcv)
+#define new_XPVCV() new_body_type(XPVCV, xpvcv, SVt_PVCV)
#define del_XPVCV(p) del_body_type(p, XPVCV, xpvcv)
-#define new_XPVAV() new_body_allocated(XPVAV, xpvav, xav_fill)
+#define new_XPVAV() new_body_allocated(XPVAV, xpvav, xav_fill, SVt_PVAV)
#define del_XPVAV(p) del_body_allocated(p, XPVAV, xpvav, xav_fill)
-#define new_XPVHV() new_body_allocated(XPVHV, xpvhv, xhv_fill)
+#define new_XPVHV() new_body_allocated(XPVHV, xpvhv, xhv_fill, SVt_PVHV)
#define del_XPVHV(p) del_body_allocated(p, XPVHV, xpvhv, xhv_fill)
-#define new_XPVMG() new_body_type(XPVMG, xpvmg)
+#define new_XPVMG() new_body_type(XPVMG, xpvmg, SVt_PVMG)
#define del_XPVMG(p) del_body_type(p, XPVMG, xpvmg)
-#define new_XPVGV() new_body_type(XPVGV, xpvgv)
+#define new_XPVGV() new_body_type(XPVGV, xpvgv, SVt_PVGV)
#define del_XPVGV(p) del_body_type(p, XPVGV, xpvgv)
-#define new_XPVLV() new_body_type(XPVLV, xpvlv)
+#define new_XPVLV() new_body_type(XPVLV, xpvlv, SVt_PVLV)
#define del_XPVLV(p) del_body_type(p, XPVLV, xpvlv)
-#define new_XPVBM() new_body_type(XPVBM, xpvbm)
+#define new_XPVBM() new_body_type(XPVBM, xpvbm, SVt_PVBM)
#define del_XPVBM(p) del_body_type(p, XPVBM, xpvbm)
#endif /* PURIFY */
+/* no arena for you! */
#define new_XPVFM() my_safemalloc(sizeof(XPVFM))
#define del_XPVFM(p) my_safefree(p)
@@ -1452,6 +1463,7 @@
SvRV_set(sv, 0);
return;
case SVt_PVHV:
+# 1476
SvANY(sv) = new_XPVHV();
HvFILL(sv) = 0;
HvMAX(sv) = 0;
@@ -1556,7 +1568,7 @@
#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_length, 0);
#else
/* We always allocated the full length item with PURIFY */
new_body_length += new_body_offset;
@@ -9049,11 +9061,9 @@
}
if (!asterisk)
- {
if( *q == '0' )
fill = *q++;
EXPECT_NUMBER(q, width);
- }
if (vectorize) {
if (vectorarg) {
@@ -10154,7 +10164,7 @@
}
}
new_body_inline(tblent, (void**)&PL_pte_arenaroot, (void**)&PL_pte_root,
- sizeof(struct ptr_tbl_ent));
+ sizeof(struct ptr_tbl_ent), 0);
tblent->oldval = oldv;
tblent->newval = newv;
tblent->next = *otblent;
@@ -10460,7 +10470,7 @@
assert(new_body_length);
#ifndef PURIFY
new_body_inline(new_body, new_body_arenaroot, new_body_arena,
- new_body_length);
+ new_body_length, 0);
new_body = (void*)((char*)new_body - new_body_offset);
#else
/* We always allocated the full length item with PURIFY */
diff -ruN -X exclude-diffs ../bleadperl/intrpvar.h arena-array/intrpvar.h
--- ../bleadperl/intrpvar.h 2005-06-29 02:41:56.000000000 -0600
+++ arena-array/intrpvar.h 2005-07-14 10:53:02.000000000 -0600
@@ -424,6 +424,22 @@
#endif
PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */
+#if 1
+PERLVARA(Ibody_arenaroots, 17, void*) /* array of arena lists, by svtype */
+
+#define Ixnv_arenaroot Ibody_arenaroots[SVt_NV]
+#define Ixpv_arenaroot Ibody_arenaroots[SVt_PV]
+#define Ixpviv_arenaroot Ibody_arenaroots[SVt_PVIV]
+#define Ixpvnv_arenaroot Ibody_arenaroots[SVt_PVNV]
+#define Ixpvcv_arenaroot Ibody_arenaroots[SVt_PVCV]
+#define Ixpvav_arenaroot Ibody_arenaroots[SVt_PVAV]
+#define Ixpvhv_arenaroot Ibody_arenaroots[SVt_PVHV]
+#define Ixpvmg_arenaroot Ibody_arenaroots[SVt_PVMG]
+#define Ixpvgv_arenaroot Ibody_arenaroots[SVt_PVGV]
+#define Ixpvlv_arenaroot Ibody_arenaroots[SVt_PVLV]
+#define Ixpvbm_arenaroot Ibody_arenaroots[SVt_PVBM]
+
+#else
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 */
@@ -435,6 +451,7 @@
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 */
+#endif
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 */
