From: Jim Cromie Date: Mon, 13 Feb 2006 14:12:41 +0000 (-0700) Subject: arena-rework : consolidated patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2a0f284b32a9deb0ebffbb06cf667a0ea1ea610;p=p5sagit%2Fp5-mst-13.2.git arena-rework : consolidated patch Message-ID: <43F0F649.9040205@gmail.com> Tweaked somewhat to split the arena boolean from the arena_size, and with the PTE still doubling-up with one of the SV types in the array. p4raw-id: //depot/perl@27215 --- diff --git a/embed.fnc b/embed.fnc index 6eb7867..4dbeb36 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1346,7 +1346,7 @@ sn |char * |F0convert |NV nv|NN char *endbuf|NN STRLEN *len sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|STRLEN len|NN SV *after # endif s |SV * |more_sv -s |void * |more_bodies |size_t size|svtype sv_type +s |void * |more_bodies |svtype sv_type s |bool |sv_2iuv_common |NN SV *sv s |void |glob_assign_glob|NN SV *dstr|NN SV *sstr|const int dtype s |void |glob_assign_ref|NN SV *dstr|NN SV *sstr diff --git a/embed.h b/embed.h index 24c85cd..a47fd20 100644 --- a/embed.h +++ b/embed.h @@ -3428,7 +3428,7 @@ # endif #ifdef PERL_CORE #define more_sv() S_more_sv(aTHX) -#define more_bodies(a,b) S_more_bodies(aTHX_ a,b) +#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 f8d5851..6be56db 100644 --- a/hv.c +++ b/hv.c @@ -46,7 +46,7 @@ S_more_he(pTHX) he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE); heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; - PL_body_roots[HE_SVSLOT] = ++he; + PL_body_roots[HE_SVSLOT] = he; while (he < heend) { HeNEXT(he) = (HE*)(he + 1); he++; diff --git a/perl.h b/perl.h index 6f9f966..75c4932 100644 --- a/perl.h +++ b/perl.h @@ -807,6 +807,11 @@ int usleep(unsigned int); #define PERL_ARENA_SIZE 4080 #endif +/* enable ARENA_SETS by default, but allow disabling */ +#ifndef ARENASETS +#define ARENASETS 1 +#endif + #endif /* PERL_CORE */ /* We no longer default to creating a new SV for GvSV. diff --git a/pod/perlapi.pod b/pod/perlapi.pod index eeabacf..a9dbc5c 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -3440,18 +3440,6 @@ NOTE: the perl_ form of this function is deprecated. =for hackers Found in file perl.c -=item looks_like_number -X - -Test if the content of an SV looks like a number (or is a number). -C and C are treated as numbers (so will not issue a -non-numeric warning), even if your atof() doesn't grok them. - - I32 looks_like_number(SV* sv) - -=for hackers -Found in file sv.c - =item newRV_inc X @@ -3463,157 +3451,6 @@ incremented. =for hackers Found in file sv.h -=item newRV_noinc -X - -Creates an RV wrapper for an SV. The reference count for the original -SV is B incremented. - - SV* newRV_noinc(SV *sv) - -=for hackers -Found in file sv.c - -=item newSV -X - -Creates a new SV. A non-zero C parameter indicates the number of -bytes of preallocated string space the SV should have. An extra byte for a -trailing NUL is also reserved. (SvPOK is not set for the SV even if string -space is allocated.) The reference count for the new SV is set to 1. - -In 5.9.3, newSV() replaces the older NEWSV() API, and drops the first -parameter, I, a debug aid which allowed callers to identify themselves. -This aid has been superseded by a new build option, PERL_MEM_LOG (see -L). The older API is still there for use in XS -modules supporting older perls. - - SV* newSV(STRLEN len) - -=for hackers -Found in file sv.c - -=item newSVhek -X - -Creates a new SV from the hash key structure. It will generate scalars that -point to the shared string table where possible. Returns a new (undefined) -SV if the hek is NULL. - - SV* newSVhek(const HEK *hek) - -=for hackers -Found in file sv.c - -=item newSViv -X - -Creates a new SV and copies an integer into it. The reference count for the -SV is set to 1. - - SV* newSViv(IV i) - -=for hackers -Found in file sv.c - -=item newSVnv -X - -Creates a new SV and copies a floating point value into it. -The reference count for the SV is set to 1. - - SV* newSVnv(NV n) - -=for hackers -Found in file sv.c - -=item newSVpv -X - -Creates a new SV and copies a string into it. The reference count for the -SV is set to 1. If C is zero, Perl will compute the length using -strlen(). For efficiency, consider using C instead. - - SV* newSVpv(const char* s, STRLEN len) - -=for hackers -Found in file sv.c - -=item newSVpvf -X - -Creates a new SV and initializes it with the string formatted like -C. - - SV* newSVpvf(const char* pat, ...) - -=for hackers -Found in file sv.c - -=item newSVpvn -X - -Creates a new SV and copies a string into it. The reference count for the -SV is set to 1. Note that if C is zero, Perl will create a zero length -string. You are responsible for ensuring that the source string is at least -C bytes long. If the C argument is NULL the new SV will be undefined. - - SV* newSVpvn(const char* s, STRLEN len) - -=for hackers -Found in file sv.c - -=item newSVpvn_share -X - -Creates a new SV with its SvPVX_const pointing to a shared string in the string -table. If the string does not already exist in the table, it is created -first. Turns on READONLY and FAKE. The string's hash is stored in the UV -slot of the SV; if the C parameter is non-zero, that value is used; -otherwise the hash is computed. The idea here is that as the string table -is used for shared hash keys these strings will have SvPVX_const == HeKEY and -hash lookup will avoid string compare. - - SV* newSVpvn_share(const char* s, I32 len, U32 hash) - -=for hackers -Found in file sv.c - -=item newSVrv -X - -Creates a new SV for the RV, C, to point to. If C is not an RV then -it will be upgraded to one. If C is non-null then the new SV will -be blessed in the specified package. The new SV is returned and its -reference count is 1. - - SV* newSVrv(SV* rv, const char* classname) - -=for hackers -Found in file sv.c - -=item newSVsv -X - -Creates a new SV which is an exact duplicate of the original SV. -(Uses C). - - SV* newSVsv(SV* old) - -=for hackers -Found in file sv.c - -=item newSVuv -X - -Creates a new SV and copies an unsigned integer into it. -The reference count for the SV is set to 1. - - SV* newSVuv(UV u) - -=for hackers -Found in file sv.c - =item SvCUR X @@ -4544,6 +4381,228 @@ Returns a boolean indicating whether the SV contains a v-string. =for hackers Found in file sv.h +=item sv_catpvn_nomg +X + +Like C but doesn't process magic. + + void sv_catpvn_nomg(SV* sv, const char* ptr, STRLEN len) + +=for hackers +Found in file sv.h + +=item sv_catsv_nomg +X + +Like C but doesn't process magic. + + void sv_catsv_nomg(SV* dsv, SV* ssv) + +=for hackers +Found in file sv.h + +=item sv_derived_from +X + +Returns a boolean indicating whether the SV is derived from the specified +class. This is the function that implements C. It works +for class names as well as for objects. + + bool sv_derived_from(SV* sv, const char* name) + +=for hackers +Found in file universal.c + +=item sv_report_used +X + +Dump the contents of all SVs not yet freed. (Debugging aid). + + void sv_report_used() + +=for hackers +Found in file sv.c + +=item sv_setsv_nomg +X + +Like C but doesn't process magic. + + void sv_setsv_nomg(SV* dsv, SV* ssv) + +=for hackers +Found in file sv.h + + +=back + +=head1 SV-Body Allocation + +=over 8 + +=item looks_like_number +X + +Test if the content of an SV looks like a number (or is a number). +C and C are treated as numbers (so will not issue a +non-numeric warning), even if your atof() doesn't grok them. + + I32 looks_like_number(SV* sv) + +=for hackers +Found in file sv.c + +=item newRV_noinc +X + +Creates an RV wrapper for an SV. The reference count for the original +SV is B incremented. + + SV* newRV_noinc(SV *sv) + +=for hackers +Found in file sv.c + +=item newSV +X + +Creates a new SV. A non-zero C parameter indicates the number of +bytes of preallocated string space the SV should have. An extra byte for a +trailing NUL is also reserved. (SvPOK is not set for the SV even if string +space is allocated.) The reference count for the new SV is set to 1. + +In 5.9.3, newSV() replaces the older NEWSV() API, and drops the first +parameter, I, a debug aid which allowed callers to identify themselves. +This aid has been superseded by a new build option, PERL_MEM_LOG (see +L). The older API is still there for use in XS +modules supporting older perls. + + SV* newSV(STRLEN len) + +=for hackers +Found in file sv.c + +=item newSVhek +X + +Creates a new SV from the hash key structure. It will generate scalars that +point to the shared string table where possible. Returns a new (undefined) +SV if the hek is NULL. + + SV* newSVhek(const HEK *hek) + +=for hackers +Found in file sv.c + +=item newSViv +X + +Creates a new SV and copies an integer into it. The reference count for the +SV is set to 1. + + SV* newSViv(IV i) + +=for hackers +Found in file sv.c + +=item newSVnv +X + +Creates a new SV and copies a floating point value into it. +The reference count for the SV is set to 1. + + SV* newSVnv(NV n) + +=for hackers +Found in file sv.c + +=item newSVpv +X + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. If C is zero, Perl will compute the length using +strlen(). For efficiency, consider using C instead. + + SV* newSVpv(const char* s, STRLEN len) + +=for hackers +Found in file sv.c + +=item newSVpvf +X + +Creates a new SV and initializes it with the string formatted like +C. + + SV* newSVpvf(const char* pat, ...) + +=for hackers +Found in file sv.c + +=item newSVpvn +X + +Creates a new SV and copies a string into it. The reference count for the +SV is set to 1. Note that if C is zero, Perl will create a zero length +string. You are responsible for ensuring that the source string is at least +C bytes long. If the C argument is NULL the new SV will be undefined. + + SV* newSVpvn(const char* s, STRLEN len) + +=for hackers +Found in file sv.c + +=item newSVpvn_share +X + +Creates a new SV with its SvPVX_const pointing to a shared string in the string +table. If the string does not already exist in the table, it is created +first. Turns on READONLY and FAKE. The string's hash is stored in the UV +slot of the SV; if the C parameter is non-zero, that value is used; +otherwise the hash is computed. The idea here is that as the string table +is used for shared hash keys these strings will have SvPVX_const == HeKEY and +hash lookup will avoid string compare. + + SV* newSVpvn_share(const char* s, I32 len, U32 hash) + +=for hackers +Found in file sv.c + +=item newSVrv +X + +Creates a new SV for the RV, C, to point to. If C is not an RV then +it will be upgraded to one. If C is non-null then the new SV will +be blessed in the specified package. The new SV is returned and its +reference count is 1. + + SV* newSVrv(SV* rv, const char* classname) + +=for hackers +Found in file sv.c + +=item newSVsv +X + +Creates a new SV which is an exact duplicate of the original SV. +(Uses C). + + SV* newSVsv(SV* old) + +=for hackers +Found in file sv.c + +=item newSVuv +X + +Creates a new SV and copies an unsigned integer into it. +The reference count for the SV is set to 1. + + SV* newSVuv(UV u) + +=for hackers +Found in file sv.c + =item sv_2bool X @@ -4759,16 +4818,6 @@ in terms of this function. =for hackers Found in file sv.c -=item sv_catpvn_nomg -X - -Like C but doesn't process magic. - - void sv_catpvn_nomg(SV* sv, const char* ptr, STRLEN len) - -=for hackers -Found in file sv.h - =item sv_catpv_mg X @@ -4804,16 +4853,6 @@ and C are implemented in terms of this function. =for hackers Found in file sv.c -=item sv_catsv_nomg -X - -Like C but doesn't process magic. - - void sv_catsv_nomg(SV* dsv, SV* ssv) - -=for hackers -Found in file sv.h - =item sv_chop X @@ -4912,18 +4951,6 @@ if necessary. Handles 'get' magic. =for hackers Found in file sv.c -=item sv_derived_from -X - -Returns a boolean indicating whether the SV is derived from the specified -class. This is the function that implements C. It works -for class names as well as for objects. - - bool sv_derived_from(SV* sv, const char* name) - -=for hackers -Found in file universal.c - =item sv_eq X @@ -5232,16 +5259,6 @@ time you'll want to use C or one of its many macro front-ends. =for hackers Found in file sv.c -=item sv_report_used -X - -Dump the contents of all SVs not yet freed. (Debugging aid). - - void sv_report_used() - -=for hackers -Found in file sv.c - =item sv_reset X @@ -5525,16 +5542,6 @@ Like C, but also handles 'set' magic. =for hackers Found in file sv.c -=item sv_setsv_nomg -X - -Like C but doesn't process magic. - - void sv_setsv_nomg(SV* dsv, SV* ssv) - -=for hackers -Found in file sv.h - =item sv_setuv X diff --git a/proto.h b/proto.h index b2838c2..657ca7b 100644 --- a/proto.h +++ b/proto.h @@ -3722,7 +3722,7 @@ STATIC void S_sv_release_COW(pTHX_ SV *sv, const char *pvx, STRLEN len, SV *afte # endif STATIC SV * S_more_sv(pTHX); -STATIC void * S_more_bodies(pTHX_ size_t size, svtype sv_type); +STATIC void * S_more_bodies(pTHX_ svtype sv_type); STATIC bool S_sv_2iuv_common(pTHX_ SV *sv) __attribute__nonnull__(pTHX_1); diff --git a/sv.c b/sv.c index 52395d5..4a91dd6 100644 --- a/sv.c +++ b/sv.c @@ -58,39 +58,39 @@ =head1 Allocation and deallocation of SVs. -An SV (or AV, HV, etc.) is allocated in two parts: the head (struct sv, -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. - -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). +An SV (or AV, HV, etc.) is allocated in two parts: the head (struct +sv, av, hv...) contains type and reference count information, and for +many types, a pointer to the body (struct xrv, xpv, xpviv...), which +contains fields specific to each type. Some types store all they need +in the head, so don't have a body. + +In all but the most memory-paranoid configuations (ex: PURIFY), heads +and bodies are allocated out of arenas, which by default are +approximately 4K chunks of memory parcelled up into N heads or bodies. 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. +For SV-heads, the first slot in each arena is reserved, and holds a +link to the next arena, 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. + +SV-bodies are similar, but they use arena-sets by default, which +separate the link and info from the arena itself, and reclaim the 1st +slot in the arena. SV-bodies are further described later. 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_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. + PL_body_arenas head of linked-list of body arenas + PL_body_roots[] array of pointers to list of free bodies of svtype + arrays are indexed by the svtype needed -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. +A few special SV heads are not allocated from an arena, but are +instead directly created in the interpreter structure, eg PL_sv_undef. The size of arenas can be changed from the default by setting PERL_ARENA_SIZE appropriately at compile time. @@ -103,13 +103,6 @@ to return the SV to the free list with error checking.) new_SV() calls more_sv() / sv_add_arena() to add an extra arena if the free list is empty. SVs in the free list have their SvTYPE field set to all ones. -Similarly, there are macros new_XIV()/del_XIV(), new_XNV()/del_XNV() etc -that allocate and return individual body types. Normally these are mapped -to the arena-manipulating functions new_xiv()/del_xiv() etc, but may be -instead mapped directly to malloc()/free() if PURIFY is defined. The -new/del functions remove from, or add to, the appropriate PL_foo_root -list, and call more_xiv() etc to add a new arena if the list is empty. - At the time of very final cleanup, sv_free_arenas() is called from perl_destruct() to physically free all the arenas allocated since the start of the interpreter. @@ -159,13 +152,10 @@ Public API: sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas() - =cut ============================================================================ */ - - /* * "A time to plant, and a time to uproot what was planted..." */ @@ -247,7 +237,7 @@ S_more_sv(pTHX) } else { char *chunk; /* must use New here to match call to */ - Newx(chunk,PERL_ARENA_SIZE,char); /* Safefree() in sv_free_arenas() */ + Newx(chunk,PERL_ARENA_SIZE,char); /* Safefree() in sv_free_arenas() */ sv_add_arena(chunk, PERL_ARENA_SIZE, 0); } uproot_SV(sv); @@ -567,14 +557,9 @@ Perl_sv_clean_all(pTHX) 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 back the 1st slot in each arena (ie 1.7% of a CV-arena, less for - others) - - union arena is declared with a fixed size, but is intended to vary - by type, allowing their use for big, rare body-types where theres - currently too much wastage (unused arena slots) + smaller types). The recovery of the wasted space allows use of + small arenas for large, rare body types, */ -#define ARENASETS 1 - struct arena_desc { char *arena; /* the raw storage, allocated aligned */ size_t size; /* its size ~4k typ */ @@ -715,7 +700,7 @@ Perl_get_arena(pTHX_ int arena_size) union arena* arp; /* allocate and attach arena */ - Newx(arp, PERL_ARENA_SIZE, char); + Newx(arp, arena_size, char); arp->next = PL_body_arenas; PL_body_arenas = arp; return arp; @@ -745,74 +730,13 @@ Perl_get_arena(pTHX_ int arena_size) Newxz(adesc->arena, arena_size, char); adesc->size = arena_size; - DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p\n", curr, aroot)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "arena %d added: %p size %d\n", + curr, adesc->arena, arena_size)); return adesc->arena; #endif } -STATIC void * -S_more_bodies (pTHX_ size_t size, svtype sv_type) -{ - dVAR; - void ** const root = &PL_body_roots[sv_type]; - char *start; - const char *end; - const size_t count = PERL_ARENA_SIZE / size; - - start = (char*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE); - - end = start + (count-1) * size; - -#if !ARENASETS - /* 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. */ - start += size; -#endif - - *root = (void *)start; - - while (start < end) { - char * const next = start + size; - *(void**) start = (void *)next; - start = next; - } - *(void **)start = 0; - - return *root; -} - -/* grab a new thing from the free list, allocating more if necessary */ - -/* 1st, the inline version */ - -#define new_body_inline(xpv, size, sv_type) \ - STMT_START { \ - void ** const r3wt = &PL_body_roots[sv_type]; \ - LOCK_SV_MUTEX; \ - xpv = *((void **)(r3wt)) \ - ? *((void **)(r3wt)) : S_more_bodies(aTHX_ size, sv_type); \ - *(r3wt) = *(void**)(xpv); \ - UNLOCK_SV_MUTEX; \ - } STMT_END - -/* now use the inline version in the proper function */ - -#ifndef PURIFY - -/* This isn't being used with -DPURIFY, so don't declare it. Otherwise - compilers issue warnings. */ - -STATIC void * -S_new_body(pTHX_ size_t size, svtype sv_type) -{ - dVAR; - void *xpv; - new_body_inline(xpv, size, sv_type); - return xpv; -} - -#endif /* return a thing to the free list */ @@ -826,54 +750,110 @@ S_new_body(pTHX_ size_t size, svtype sv_type) } STMT_END /* - 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, - and the pointer is unchanged. If the allocated structure is smaller (no - initial NV actually allocated) then the net effect is to subtract the size - of the NV from the pointer, to return a new pointer as if an initial NV were - actually allocated. - - This is the same trick as was used for NV and IV bodies. Ironically it - doesn't need to be used for NV bodies any more, because NV is now at the - start of the structure. IV bodies don't need it either, because they are - no longer allocated. */ - -/* The following 2 arrays hide the above details in a pair of - lookup-tables, allowing us to be body-type agnostic. - - size maps svtype to its body's allocated size. - offset 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. + +=head1 SV-Body Allocation + +Allocation of SV-bodies is similar to SV-heads, differing as follows; +the allocation mechanism is used for many body types, so is somewhat +more complicated, it uses arena-sets, and has no need for still-live +SV detection. + +At the outermost level, (new|del)_X*V macros return bodies of the +appropriate type. These macros call either (new|del)_body_type or +(new|del)_body_allocated macro pairs, depending on specifics of the +type. Most body types use the former pair, the latter pair is used to +allocate body types with "ghost fields". + +"ghost fields" are fields that are unused in certain types, and +consequently dont need to actually exist. They are declared because +they're part of a "base type", which allows use of functions as +methods. The simplest examples are AVs and HVs, 2 aggregate types +which don't use the fields which support SCALAR semantics. + +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, and the pointer is unchanged. If the allocated +structure is smaller (no initial NV actually allocated) then the net +effect is to subtract the size of the NV from the pointer, to return a +new pointer as if an initial NV were actually allocated. + +This is the same trick as was used for NV and IV bodies. Ironically it +doesn't need to be used for NV bodies any more, because NV is now at +the start of the structure. IV bodies don't need it either, because +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 +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 +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. + +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: + +Arena_size determines whether arenas are used for this body type, and if +so, how big they are. PURIFY or PERL_ARENA_SIZE=0 set this field to +zero, forcing individual mallocs and frees. + +Body_size determines how big a body is, and therefore how many fit into +each arena. Offset carries the body-pointer adjustment needed for +*_allocated body types, and is used in *_allocated macros. + +But its main purpose is to parameterize info needed in +Perl_sv_upgrade(). The info here dramatically simplifies the function +vs the implementation in 5.8.7, making it table-driven. All fields +are used for this, except for arena_size. + +For the sv-types that have no bodies, arenas are not used, so those +PL_body_roots[sv_type] are unused, and can be overloaded. In +something of a special case, SVt_NULL is borrowed for HE arenas; +PL_body_roots[SVt_NULL] is filled by S_more_he, but the +bodies_by_type[SVt_NULL] slot is not used, as the table is not +available in hv.c, + +PTEs also use arenas, but are never seen in Perl_sv_upgrade. +Nonetheless, they get their own slot in bodies_by_type[SVt_NULL], so +they can just use the same allocation semantics. At first, PTEs were +also overloaded to a non-body sv-type, but this yielded hard-to-find +malloc bugs, so was simplified by claiming a new slot. This choice +has no consequence at this time. + */ struct body_details { - size_t size; /* Size to allocate */ + size_t body_size; /* Size to allocate */ size_t copy; /* Size of structure to copy (may be shorter) */ size_t offset; - bool cant_upgrade; /* Can upgrade this type */ + bool cant_upgrade; /* Cannot upgrade this type */ bool zero_nv; /* zero the NV when upgrading from this */ bool arena; /* Allocated from an arena */ + size_t arena_size; /* Size of arena to allocate */ }; #define HADNV FALSE #define NONV TRUE + #ifdef PURIFY /* With -DPURFIY we allocate everything directly, and don't use arenas. This seems a rather elegant way to simplify some of the code below. */ @@ -883,6 +863,18 @@ struct body_details { #endif #define NOARENA FALSE +/* Size the arenas to exactly fit a given number of bodies. A count + of 0 fits the max number bodies into a PERL_ARENA_SIZE.block, + simplifying the default. If count > 0, the arena is sized to fit + only that many bodies, allowing arenas to be used for large, rare + bodies (XPVFM, XPVIO) without undue waste. The arena size is + limited by PERL_ARENA_SIZE, so we can safely oversize the + declarations. + */ +#define FIT_ARENA(count, body_size) \ + (!count || count * body_size > PERL_ARENA_SIZE) \ + ? (int)(PERL_ARENA_SIZE / body_size) * body_size : count * body_size + /* A macro to work out the offset needed to subtract from a pointer to (say) typedef struct { @@ -912,65 +904,93 @@ struct xpv { + sizeof (((type*)SvANY((SV*)0))->last_member) static const struct body_details bodies_by_type[] = { - {0, 0, 0, FALSE, NONV, NOARENA}, - /* IVs are in the head, so the allocation size is 0 */ - {0, sizeof(IV), STRUCT_OFFSET(XPVIV, xiv_iv), FALSE, NONV, NOARENA}, + { sizeof(HE), 0, 0, FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) }, + + /* IVs are in the head, so the allocation size is 0. + However, the slot is overloaded for PTEs. */ + { sizeof(struct ptr_tbl_ent), /* This is used for PTEs. */ + sizeof(IV), /* This is used to copy out the IV body. */ + STRUCT_OFFSET(XPVIV, xiv_iv), FALSE, NONV, + NOARENA /* IVS don't need an arena */, + /* But PTEs need to know the size of their arena */ + FIT_ARENA(0, sizeof(struct ptr_tbl_ent)) + }, + /* 8 bytes on most ILP32 with IEEE doubles */ - {sizeof(NV), sizeof(NV), 0, FALSE, HADNV, HASARENA}, - /* RVs are in the head now */ - /* However, this slot is overloaded and used by the pte */ - {0, 0, 0, FALSE, NONV, NOARENA}, + { sizeof(NV), sizeof(NV), 0, FALSE, HADNV, HASARENA, + FIT_ARENA(0, sizeof(NV)) }, + + /* RVs are in the head now. */ + { 0, 0, 0, FALSE, NONV, NOARENA, 0 }, + /* 8 bytes on most ILP32 with IEEE doubles */ - {sizeof(xpv_allocated), - copy_length(XPV, xpv_len) - - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), - + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), - FALSE, NONV, HASARENA}, + { sizeof(xpv_allocated), + copy_length(XPV, xpv_len) + - relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), + + relative_STRUCT_OFFSET(xpv_allocated, XPV, xpv_cur), + FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpv_allocated)) }, + /* 12 */ - {sizeof(xpviv_allocated), - copy_length(XPVIV, xiv_u) - - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), - + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), - FALSE, NONV, HASARENA}, + { sizeof(xpviv_allocated), + copy_length(XPVIV, xiv_u) + - relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), + + relative_STRUCT_OFFSET(xpviv_allocated, XPVIV, xpv_cur), + FALSE, NONV, HASARENA, FIT_ARENA(0, sizeof(xpviv_allocated)) }, + /* 20 */ - {sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, FALSE, HADNV, HASARENA}, + { sizeof(XPVNV), copy_length(XPVNV, xiv_u), 0, FALSE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVNV)) }, + /* 28 */ - {sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, FALSE, HADNV, HASARENA}, + { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, FALSE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVMG)) }, + /* 36 */ - {sizeof(XPVBM), sizeof(XPVBM), 0, TRUE, HADNV, HASARENA}, + { sizeof(XPVBM), sizeof(XPVBM), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVBM)) }, + /* 48 */ - {sizeof(XPVGV), sizeof(XPVGV), 0, TRUE, HADNV, HASARENA}, + { sizeof(XPVGV), sizeof(XPVGV), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVGV)) }, + /* 64 */ - {sizeof(XPVLV), sizeof(XPVLV), 0, TRUE, HADNV, HASARENA}, - /* 20 */ - {sizeof(xpvav_allocated), - copy_length(XPVAV, xmg_stash) - - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), - + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), - TRUE, HADNV, HASARENA}, - /* 20 */ - {sizeof(xpvhv_allocated), - copy_length(XPVHV, xmg_stash) - - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), - + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), - TRUE, HADNV, HASARENA}, + { sizeof(XPVLV), sizeof(XPVLV), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVLV)) }, + + { sizeof(xpvav_allocated), + copy_length(XPVAV, xmg_stash) + - relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), + + relative_STRUCT_OFFSET(xpvav_allocated, XPVAV, xav_fill), + TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvav_allocated)) }, + + { sizeof(xpvhv_allocated), + copy_length(XPVHV, xmg_stash) + - relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), + + relative_STRUCT_OFFSET(xpvhv_allocated, XPVHV, xhv_fill), + TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(xpvhv_allocated)) }, + /* 76 */ - {sizeof(XPVCV), sizeof(XPVCV), 0, TRUE, HADNV, HASARENA}, - /* 80 */ - {sizeof(XPVFM), sizeof(XPVFM), 0, TRUE, HADNV, NOARENA}, - /* 84 */ - {sizeof(XPVIO), sizeof(XPVIO), 0, TRUE, HADNV, NOARENA} + { sizeof(XPVCV), sizeof(XPVCV), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(0, sizeof(XPVCV)) }, + + /* XPVFM is 80 bytes, fits 51x */ + { sizeof(XPVFM), sizeof(XPVFM), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(20, sizeof(XPVFM)) }, + + /* XPVIO is 84 bytes, fits 48x */ + { sizeof(XPVIO), sizeof(XPVIO), 0, TRUE, HADNV, + HASARENA, FIT_ARENA(24, sizeof(XPVIO)) }, }; -#define new_body_type(sv_type) \ - (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type)) +#define new_body_type(sv_type) \ + (void *)((char *)S_new_body(aTHX_ sv_type)) #define del_body_type(p, sv_type) \ del_body(p, &PL_body_roots[sv_type]) #define new_body_allocated(sv_type) \ - (void *)((char *)S_new_body(aTHX_ bodies_by_type[sv_type].size, sv_type)\ + (void *)((char *)S_new_body(aTHX_ sv_type) \ - bodies_by_type[sv_type].offset) #define del_body_allocated(p, sv_type) \ @@ -1026,9 +1046,75 @@ static const struct body_details bodies_by_type[] = { /* no arena for you! */ #define new_NOARENA(details) \ - my_safemalloc((details)->size + (details)->offset) + my_safemalloc((details)->body_size + (details)->offset) #define new_NOARENAZ(details) \ - my_safecalloc((details)->size + (details)->offset) + my_safecalloc((details)->body_size + (details)->offset) + +STATIC void * +S_more_bodies (pTHX_ svtype sv_type) +{ + dVAR; + void ** const root = &PL_body_roots[sv_type]; + const struct body_details *bdp = &bodies_by_type[sv_type]; + const size_t body_size = bdp->body_size; + char *start; + const char *end; + + assert(bdp->arena_size); + start = (char*) Perl_get_arena(aTHX_ bdp->arena_size); + + end = start + bdp->arena_size - body_size; + +#if !ARENASETS + /* 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. */ + start += body_size; +#else + /* computed count doesnt reflect the 1st slot reservation */ + DEBUG_m(PerlIO_printf(Perl_debug_log, + "arena %p end %p arena-size %d type %d size %d ct %d\n", + start, end, bdp->arena_size, sv_type, body_size, + bdp->arena_size / body_size)); +#endif + + *root = (void *)start; + + while (start < end) { + char * const next = start + body_size; + *(void**) start = (void *)next; + start = next; + } + *(void **)start = 0; + + return *root; +} + +/* grab a new thing from the free list, allocating more if necessary. + The inline version is used for speed in hot routines, and the + function using it serves the rest (unless PURIFY). +*/ +#define new_body_inline(xpv, sv_type) \ + STMT_START { \ + void ** const r3wt = &PL_body_roots[sv_type]; \ + LOCK_SV_MUTEX; \ + xpv = *((void **)(r3wt)) \ + ? *((void **)(r3wt)) : S_more_bodies(aTHX_ sv_type); \ + *(r3wt) = *(void**)(xpv); \ + UNLOCK_SV_MUTEX; \ + } STMT_END + +#ifndef PURIFY + +STATIC void * +S_new_body(pTHX_ svtype sv_type) +{ + dVAR; + void *xpv; + new_body_inline(xpv, sv_type); + return xpv; +} + +#endif /* =for apidoc sv_upgrade @@ -1047,9 +1133,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) void* old_body; void* new_body; const U32 old_type = SvTYPE(sv); + const struct body_details *new_type_details; const struct body_details *const old_type_details = bodies_by_type + old_type; - const struct body_details *new_type_details; if (new_type != SVt_PV && SvIsCOW(sv)) { sv_force_normal_flags(sv, 0); @@ -1167,13 +1253,14 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) return; case SVt_PVHV: case SVt_PVAV: - assert(new_type_details->size); + assert(new_type_details->body_size); #ifndef PURIFY assert(new_type_details->arena); + assert(new_type_details->arena_size); /* This points to the start of the allocated area. */ - new_body_inline(new_body, new_type_details->size, new_type); - Zero(new_body, new_type_details->size, char); + new_body_inline(new_body, new_type); + Zero(new_body, new_type_details->body_size, char); new_body = ((char *)new_body) - new_type_details->offset; #else /* We always allocated the full length item with PURIFY. To do this @@ -1221,13 +1308,13 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) case SVt_PVNV: case SVt_PV: - assert(new_type_details->size); + assert(new_type_details->body_size); /* We always allocated the full length item with PURIFY. To do this we fake things so that arena is false for all 16 types.. */ if(new_type_details->arena) { /* This points to the start of the allocated area. */ - new_body_inline(new_body, new_type_details->size, new_type); - Zero(new_body, new_type_details->size, char); + new_body_inline(new_body, new_type); + Zero(new_body, new_type_details->body_size, char); new_body = ((char *)new_body) - new_type_details->offset; } else { new_body = new_NOARENAZ(new_type_details); @@ -1260,8 +1347,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type) (unsigned long)new_type); } - if (old_type_details->size) { - /* If the old body had an allocated size, then we need to free it. */ + if (old_type_details->arena) { + /* If there was an old body, then we need to free it. + Note that there is an assumption that all bodies of types that + can be upgraded came from arenas. Only the more complex non- + upgradable types are allowed to be directly malloc()ed. */ #ifdef PURIFY my_safefree(old_body); #else @@ -4812,8 +4902,12 @@ Perl_sv_clear(pTHX_ register SV *sv) assert(sv); assert(SvREFCNT(sv) == 0); - if (type <= SVt_IV) + if (type <= SVt_IV) { + /* See the comment in sv.h about the collusion between this early + return and the overloading of the NULL and IV slots in the size + table. */ return; + } if (SvOBJECT(sv)) { if (PL_defstash) { /* Still have a symbol table? */ @@ -4971,7 +5065,7 @@ Perl_sv_clear(pTHX_ register SV *sv) del_body(((char *)SvANY(sv) + sv_type_details->offset), &PL_body_roots[type]); } - else if (sv_type_details->size) { + else if (sv_type_details->body_size) { my_safefree(SvANY(sv)); } } @@ -9331,7 +9425,8 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv) } else { const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max; - new_body_inline(tblent, sizeof(struct ptr_tbl_ent), PTE_SVSLOT); + new_body_inline(tblent, PTE_SVSLOT); + tblent->oldval = oldsv; tblent->newval = newsv; tblent->next = tbl->tbl_ary[entry]; @@ -9556,9 +9651,9 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) case SVt_PVNV: case SVt_PVIV: case SVt_PV: - assert(sv_type_details->size); + assert(sv_type_details->body_size); if (sv_type_details->arena) { - new_body_inline(new_body, sv_type_details->size, sv_type); + new_body_inline(new_body, sv_type); new_body = (void*)((char*)new_body - sv_type_details->offset); } else { @@ -9575,7 +9670,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) #else Copy(((char*)SvANY(sstr)), ((char*)SvANY(dstr)), - sv_type_details->size + sv_type_details->offset, char); + sv_type_details->body_size + sv_type_details->offset, char); #endif if (sv_type != SVt_PVAV && sv_type != SVt_PVHV) diff --git a/sv.h b/sv.h index 89b4a9e..dd4302c 100644 --- a/sv.h +++ b/sv.h @@ -63,8 +63,13 @@ typedef enum { SVt_LAST /* keep last in enum. used to size arrays */ } svtype; +/* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL + and SVt_IV, so never reaches the clause at the end that uses + sv_type_details->body_size to determine whether to call safefree(). Hence + body_size can be set no-zero to record the size of PTEs and HEs, without + fear of bogus frees. */ #ifdef PERL_IN_SV_C -#define PTE_SVSLOT SVt_RV +#define PTE_SVSLOT SVt_IV #endif #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST) #define HE_SVSLOT SVt_NULL