From: Jim Cromie Date: Mon, 14 Nov 2005 12:29:52 +0000 (-0700) Subject: Re: eliminate discreet arenaroots X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93e68bfb4c30bda791d4bf574f645d153ab4343b;p=p5sagit%2Fp5-mst-13.2.git Re: eliminate discreet arenaroots Message-ID: <4378E5B0.3010708@gmail.com> Date: Mon, 14 Nov 2005 12:29:52 -0700 p4raw-id: //depot/perl@26141 --- diff --git a/embedvar.h b/embedvar.h index 81628be..038039a 100644 --- a/embedvar.h +++ b/embedvar.h @@ -191,6 +191,8 @@ #define PL_beginav (vTHX->Ibeginav) #define PL_beginav_save (vTHX->Ibeginav_save) #define PL_bitcount (vTHX->Ibitcount) +#define PL_body_arenaroots (vTHX->Ibody_arenaroots) +#define PL_body_roots (vTHX->Ibody_roots) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) #define PL_checkav (vTHX->Icheckav) @@ -434,28 +436,6 @@ #define PL_uudmap (vTHX->Iuudmap) #define PL_warnhook (vTHX->Iwarnhook) #define PL_widesyscalls (vTHX->Iwidesyscalls) -#define PL_xnv_arenaroot (vTHX->Ixnv_arenaroot) -#define PL_xnv_root (vTHX->Ixnv_root) -#define PL_xpv_arenaroot (vTHX->Ixpv_arenaroot) -#define PL_xpv_root (vTHX->Ixpv_root) -#define PL_xpvav_arenaroot (vTHX->Ixpvav_arenaroot) -#define PL_xpvav_root (vTHX->Ixpvav_root) -#define PL_xpvbm_arenaroot (vTHX->Ixpvbm_arenaroot) -#define PL_xpvbm_root (vTHX->Ixpvbm_root) -#define PL_xpvcv_arenaroot (vTHX->Ixpvcv_arenaroot) -#define PL_xpvcv_root (vTHX->Ixpvcv_root) -#define PL_xpvgv_arenaroot (vTHX->Ixpvgv_arenaroot) -#define PL_xpvgv_root (vTHX->Ixpvgv_root) -#define PL_xpvhv_arenaroot (vTHX->Ixpvhv_arenaroot) -#define PL_xpvhv_root (vTHX->Ixpvhv_root) -#define PL_xpviv_arenaroot (vTHX->Ixpviv_arenaroot) -#define PL_xpviv_root (vTHX->Ixpviv_root) -#define PL_xpvlv_arenaroot (vTHX->Ixpvlv_arenaroot) -#define PL_xpvlv_root (vTHX->Ixpvlv_root) -#define PL_xpvmg_arenaroot (vTHX->Ixpvmg_arenaroot) -#define PL_xpvmg_root (vTHX->Ixpvmg_root) -#define PL_xpvnv_arenaroot (vTHX->Ixpvnv_arenaroot) -#define PL_xpvnv_root (vTHX->Ixpvnv_root) #define PL_yycharp (vTHX->Iyycharp) #define PL_yylvalp (vTHX->Iyylvalp) @@ -494,6 +474,8 @@ #define PL_Ibeginav PL_beginav #define PL_Ibeginav_save PL_beginav_save #define PL_Ibitcount PL_bitcount +#define PL_Ibody_arenaroots PL_body_arenaroots +#define PL_Ibody_roots PL_body_roots #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr #define PL_Icheckav PL_checkav @@ -737,28 +719,6 @@ #define PL_Iuudmap PL_uudmap #define PL_Iwarnhook PL_warnhook #define PL_Iwidesyscalls PL_widesyscalls -#define PL_Ixnv_arenaroot PL_xnv_arenaroot -#define PL_Ixnv_root PL_xnv_root -#define PL_Ixpv_arenaroot PL_xpv_arenaroot -#define PL_Ixpv_root PL_xpv_root -#define PL_Ixpvav_arenaroot PL_xpvav_arenaroot -#define PL_Ixpvav_root PL_xpvav_root -#define PL_Ixpvbm_arenaroot PL_xpvbm_arenaroot -#define PL_Ixpvbm_root PL_xpvbm_root -#define PL_Ixpvcv_arenaroot PL_xpvcv_arenaroot -#define PL_Ixpvcv_root PL_xpvcv_root -#define PL_Ixpvgv_arenaroot PL_xpvgv_arenaroot -#define PL_Ixpvgv_root PL_xpvgv_root -#define PL_Ixpvhv_arenaroot PL_xpvhv_arenaroot -#define PL_Ixpvhv_root PL_xpvhv_root -#define PL_Ixpviv_arenaroot PL_xpviv_arenaroot -#define PL_Ixpviv_root PL_xpviv_root -#define PL_Ixpvlv_arenaroot PL_xpvlv_arenaroot -#define PL_Ixpvlv_root PL_xpvlv_root -#define PL_Ixpvmg_arenaroot PL_xpvmg_arenaroot -#define PL_Ixpvmg_root PL_xpvmg_root -#define PL_Ixpvnv_arenaroot PL_xpvnv_arenaroot -#define PL_Ixpvnv_root PL_xpvnv_root #define PL_Iyycharp PL_yycharp #define PL_Iyylvalp PL_yylvalp diff --git a/intrpvar.h b/intrpvar.h index 7f6d21f..1612b9f 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -247,18 +247,10 @@ PERLVAR(Iosname, char *) /* operating system */ 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 @@ -426,21 +418,14 @@ PERLVAR(Iptr_table, PTR_TBL_t*) #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 --git a/perlapi.h b/perlapi.h index e3dc42c..cb9fac4 100644 --- a/perlapi.h +++ b/perlapi.h @@ -180,6 +180,10 @@ END_EXTERN_C #define PL_beginav_save (*Perl_Ibeginav_save_ptr(aTHX)) #undef PL_bitcount #define PL_bitcount (*Perl_Ibitcount_ptr(aTHX)) +#undef PL_body_arenaroots +#define PL_body_arenaroots (*Perl_Ibody_arenaroots_ptr(aTHX)) +#undef PL_body_roots +#define PL_body_roots (*Perl_Ibody_roots_ptr(aTHX)) #undef PL_bufend #define PL_bufend (*Perl_Ibufend_ptr(aTHX)) #undef PL_bufptr @@ -666,50 +670,6 @@ END_EXTERN_C #define PL_warnhook (*Perl_Iwarnhook_ptr(aTHX)) #undef PL_widesyscalls #define PL_widesyscalls (*Perl_Iwidesyscalls_ptr(aTHX)) -#undef PL_xnv_arenaroot -#define PL_xnv_arenaroot (*Perl_Ixnv_arenaroot_ptr(aTHX)) -#undef PL_xnv_root -#define PL_xnv_root (*Perl_Ixnv_root_ptr(aTHX)) -#undef PL_xpv_arenaroot -#define PL_xpv_arenaroot (*Perl_Ixpv_arenaroot_ptr(aTHX)) -#undef PL_xpv_root -#define PL_xpv_root (*Perl_Ixpv_root_ptr(aTHX)) -#undef PL_xpvav_arenaroot -#define PL_xpvav_arenaroot (*Perl_Ixpvav_arenaroot_ptr(aTHX)) -#undef PL_xpvav_root -#define PL_xpvav_root (*Perl_Ixpvav_root_ptr(aTHX)) -#undef PL_xpvbm_arenaroot -#define PL_xpvbm_arenaroot (*Perl_Ixpvbm_arenaroot_ptr(aTHX)) -#undef PL_xpvbm_root -#define PL_xpvbm_root (*Perl_Ixpvbm_root_ptr(aTHX)) -#undef PL_xpvcv_arenaroot -#define PL_xpvcv_arenaroot (*Perl_Ixpvcv_arenaroot_ptr(aTHX)) -#undef PL_xpvcv_root -#define PL_xpvcv_root (*Perl_Ixpvcv_root_ptr(aTHX)) -#undef PL_xpvgv_arenaroot -#define PL_xpvgv_arenaroot (*Perl_Ixpvgv_arenaroot_ptr(aTHX)) -#undef PL_xpvgv_root -#define PL_xpvgv_root (*Perl_Ixpvgv_root_ptr(aTHX)) -#undef PL_xpvhv_arenaroot -#define PL_xpvhv_arenaroot (*Perl_Ixpvhv_arenaroot_ptr(aTHX)) -#undef PL_xpvhv_root -#define PL_xpvhv_root (*Perl_Ixpvhv_root_ptr(aTHX)) -#undef PL_xpviv_arenaroot -#define PL_xpviv_arenaroot (*Perl_Ixpviv_arenaroot_ptr(aTHX)) -#undef PL_xpviv_root -#define PL_xpviv_root (*Perl_Ixpviv_root_ptr(aTHX)) -#undef PL_xpvlv_arenaroot -#define PL_xpvlv_arenaroot (*Perl_Ixpvlv_arenaroot_ptr(aTHX)) -#undef PL_xpvlv_root -#define PL_xpvlv_root (*Perl_Ixpvlv_root_ptr(aTHX)) -#undef PL_xpvmg_arenaroot -#define PL_xpvmg_arenaroot (*Perl_Ixpvmg_arenaroot_ptr(aTHX)) -#undef PL_xpvmg_root -#define PL_xpvmg_root (*Perl_Ixpvmg_root_ptr(aTHX)) -#undef PL_xpvnv_arenaroot -#define PL_xpvnv_arenaroot (*Perl_Ixpvnv_arenaroot_ptr(aTHX)) -#undef PL_xpvnv_root -#define PL_xpvnv_root (*Perl_Ixpvnv_root_ptr(aTHX)) #undef PL_yycharp #define PL_yycharp (*Perl_Iyycharp_ptr(aTHX)) #undef PL_yylvalp diff --git a/sv.c b/sv.c index 02557d5..1f28bbb 100644 --- a/sv.c +++ b/sv.c @@ -63,30 +63,36 @@ av, hv...) contains type and reference count information, as well as a pointer to the body (struct xrv, xpv, xpviv...), which contains fields specific to each type. -Normally, this allocation is done using arenas, which by default are -approximately 4K chunks of memory parcelled up into N heads or bodies. The -first slot in each arena is reserved, and is used to hold a link to the next -arena. In the case of heads, the unused first slot also contains some flags -and a note of the number of slots. Snaked through each arena chain is a -linked list of free items; when this becomes empty, an extra arena is -allocated and divided up into N items which are threaded into the free list. +In all but the most memory-paranoid configuations (ex: PURIFY), this +allocation is done using arenas, which by default are approximately 4K +chunks of memory parcelled up into N heads or bodies (of same size). +Sv-bodies are allocated by their sv-type, guaranteeing size +consistency needed to allocate safely from arrays. + +The first slot in each arena is reserved, and is used to hold a link +to the next arena. In the case of heads, the unused first slot also +contains some flags and a note of the number of slots. Snaked through +each arena chain is a linked list of free items; when this becomes +empty, an extra arena is allocated and divided up into N items which +are threaded into the free list. The following global variables are associated with arenas: 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) -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 -not allocated from an arena, but are instead directly created as static -or auto variables, eg PL_sv_undef. The size of arenas can be changed from -the default by setting PERL_ARENA_SIZE appropriately at compile time. +Note that 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. + +In addition, a few SV heads are not allocated from an arena, but are +instead directly created as static or auto variables, eg PL_sv_undef. +The size of arenas can be changed from the default by setting +PERL_ARENA_SIZE appropriately at compile time. The SV arena serves the secondary purpose of allowing still-live SVs to be located and destroyed during final cleanup. @@ -140,7 +146,7 @@ called by visit() for each SV]): of zero. called repeatedly from perl_destruct() until there are no SVs left. -=head2 Summary +=head2 Arena allocator API Summary Private API to rest of sv.c @@ -558,7 +564,6 @@ heads and bodies within the arenas must already have been freed. =cut */ - #define free_arena(name) \ STMT_START { \ S_free_arena(aTHX_ (void**) PL_ ## name ## _arenaroot); \ @@ -571,6 +576,7 @@ Perl_sv_free_arenas(pTHX) { 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.) */ @@ -583,18 +589,13 @@ Perl_sv_free_arenas(pTHX) 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; iIxpvbm_arenaroot), - (void**)&(my_perl->Ixpvbm_root), sizeof(XPVBM), 0) -*/ +/* + 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, -#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.) + 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, @@ -1181,18 +1209,79 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size) 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 bytes on 686 */ + 0, + sizeof(xpv_allocated), /* 8 bytes 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) @@ -1234,47 +1323,50 @@ S_new_body(pTHX_ void **arena_root, void **root, size_t size) #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 @@ -1371,7 +1463,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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; @@ -1382,9 +1474,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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; @@ -1394,15 +1485,14 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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 @@ -1418,7 +1508,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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 @@ -1497,41 +1587,21 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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)) @@ -1539,11 +1609,10 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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 @@ -1554,8 +1623,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) 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; @@ -5397,22 +5465,22 @@ Perl_sv_clear(pTHX_ register SV *sv) /* 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: @@ -5423,7 +5491,7 @@ Perl_sv_clear(pTHX_ register SV *sv) } 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); @@ -5432,16 +5500,16 @@ Perl_sv_clear(pTHX_ register SV *sv) 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. */ @@ -5451,7 +5519,7 @@ Perl_sv_clear(pTHX_ register SV *sv) } 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: @@ -5489,7 +5557,7 @@ Perl_sv_clear(pTHX_ register SV *sv) #endif break; case SVt_NV: - old_body_arena = (void **) &PL_xnv_root; + old_body_arena = PL_body_roots[SVt_NV]; break; } @@ -9755,7 +9823,13 @@ Perl_ptr_table_new(pTHX) # define PTR_TABLE_HASH(ptr) (PTR2UV(ptr) >> 2) #endif -#define del_pte(p) del_body_type(p, struct ptr_tbl_ent, pte) +/* + we use the PTE_SVSLOT 'reservation' made above, both here (in the + following define) and at call to new_body_inline made below in + Perl_ptr_table_store() + */ + +#define del_pte(p) del_body_type(p, PTE_SVSLOT) /* map an existing pointer using a table */ @@ -9793,8 +9867,8 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv) 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), PTE_SVSLOT); tblent->oldval = oldsv; tblent->newval = newsv; tblent->next = *otblent; @@ -10015,8 +10089,9 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) 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)); @@ -10032,74 +10107,54 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) 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 through */ } - 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 */ @@ -10907,31 +10962,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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 --git a/sv.h b/sv.h index f5a3125..c9cf0fe 100644 --- a/sv.h +++ b/sv.h @@ -59,7 +59,8 @@ typedef enum { 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;