=for hackers
Found in file perl.c
-=item looks_like_number
-X<looks_like_number>
-
-Test if the content of an SV looks like a number (or is a number).
-C<Inf> and C<Infinity> 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<newRV_inc>
=for hackers
Found in file sv.h
-=item newRV_noinc
-X<newRV_noinc>
-
-Creates an RV wrapper for an SV. The reference count for the original
-SV is B<not> incremented.
-
- SV* newRV_noinc(SV *sv)
-
-=for hackers
-Found in file sv.c
-
-=item newSV
-X<newSV>
-
-Creates a new SV. A non-zero C<len> 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<x>, a debug aid which allowed callers to identify themselves.
-This aid has been superseded by a new build option, PERL_MEM_LOG (see
-L<perlhack/PERL_MEM_LOG>). 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<newSVhek>
-
-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<newSViv>
-
-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<newSVnv>
-
-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<newSVpv>
-
-Creates a new SV and copies a string into it. The reference count for the
-SV is set to 1. If C<len> is zero, Perl will compute the length using
-strlen(). For efficiency, consider using C<newSVpvn> instead.
-
- SV* newSVpv(const char* s, STRLEN len)
-
-=for hackers
-Found in file sv.c
-
-=item newSVpvf
-X<newSVpvf>
-
-Creates a new SV and initializes it with the string formatted like
-C<sprintf>.
-
- SV* newSVpvf(const char* pat, ...)
-
-=for hackers
-Found in file sv.c
-
-=item newSVpvn
-X<newSVpvn>
-
-Creates a new SV and copies a string into it. The reference count for the
-SV is set to 1. Note that if C<len> is zero, Perl will create a zero length
-string. You are responsible for ensuring that the source string is at least
-C<len> bytes long. If the C<s> 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<newSVpvn_share>
-
-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<hash> 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<newSVrv>
-
-Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then
-it will be upgraded to one. If C<classname> 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<newSVsv>
-
-Creates a new SV which is an exact duplicate of the original SV.
-(Uses C<sv_setsv>).
-
- SV* newSVsv(SV* old)
-
-=for hackers
-Found in file sv.c
-
-=item newSVuv
-X<newSVuv>
-
-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<SvCUR>
=for hackers
Found in file sv.h
+=item sv_catpvn_nomg
+X<sv_catpvn_nomg>
+
+Like C<sv_catpvn> 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<sv_catsv_nomg>
+
+Like C<sv_catsv> 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<sv_derived_from>
+
+Returns a boolean indicating whether the SV is derived from the specified
+class. This is the function that implements C<UNIVERSAL::isa>. 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<sv_report_used>
+
+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<sv_setsv_nomg>
+
+Like C<sv_setsv> 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<looks_like_number>
+
+Test if the content of an SV looks like a number (or is a number).
+C<Inf> and C<Infinity> 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<newRV_noinc>
+
+Creates an RV wrapper for an SV. The reference count for the original
+SV is B<not> incremented.
+
+ SV* newRV_noinc(SV *sv)
+
+=for hackers
+Found in file sv.c
+
+=item newSV
+X<newSV>
+
+Creates a new SV. A non-zero C<len> 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<x>, a debug aid which allowed callers to identify themselves.
+This aid has been superseded by a new build option, PERL_MEM_LOG (see
+L<perlhack/PERL_MEM_LOG>). 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<newSVhek>
+
+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<newSViv>
+
+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<newSVnv>
+
+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<newSVpv>
+
+Creates a new SV and copies a string into it. The reference count for the
+SV is set to 1. If C<len> is zero, Perl will compute the length using
+strlen(). For efficiency, consider using C<newSVpvn> instead.
+
+ SV* newSVpv(const char* s, STRLEN len)
+
+=for hackers
+Found in file sv.c
+
+=item newSVpvf
+X<newSVpvf>
+
+Creates a new SV and initializes it with the string formatted like
+C<sprintf>.
+
+ SV* newSVpvf(const char* pat, ...)
+
+=for hackers
+Found in file sv.c
+
+=item newSVpvn
+X<newSVpvn>
+
+Creates a new SV and copies a string into it. The reference count for the
+SV is set to 1. Note that if C<len> is zero, Perl will create a zero length
+string. You are responsible for ensuring that the source string is at least
+C<len> bytes long. If the C<s> 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<newSVpvn_share>
+
+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<hash> 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<newSVrv>
+
+Creates a new SV for the RV, C<rv>, to point to. If C<rv> is not an RV then
+it will be upgraded to one. If C<classname> 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<newSVsv>
+
+Creates a new SV which is an exact duplicate of the original SV.
+(Uses C<sv_setsv>).
+
+ SV* newSVsv(SV* old)
+
+=for hackers
+Found in file sv.c
+
+=item newSVuv
+X<newSVuv>
+
+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<sv_2bool>
=for hackers
Found in file sv.c
-=item sv_catpvn_nomg
-X<sv_catpvn_nomg>
-
-Like C<sv_catpvn> 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<sv_catpv_mg>
=for hackers
Found in file sv.c
-=item sv_catsv_nomg
-X<sv_catsv_nomg>
-
-Like C<sv_catsv> but doesn't process magic.
-
- void sv_catsv_nomg(SV* dsv, SV* ssv)
-
-=for hackers
-Found in file sv.h
-
=item sv_chop
X<sv_chop>
=for hackers
Found in file sv.c
-=item sv_derived_from
-X<sv_derived_from>
-
-Returns a boolean indicating whether the SV is derived from the specified
-class. This is the function that implements C<UNIVERSAL::isa>. 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<sv_eq>
=for hackers
Found in file sv.c
-=item sv_report_used
-X<sv_report_used>
-
-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<sv_reset>
=for hackers
Found in file sv.c
-=item sv_setsv_nomg
-X<sv_setsv_nomg>
-
-Like C<sv_setsv> but doesn't process magic.
-
- void sv_setsv_nomg(SV* dsv, SV* ssv)
-
-=for hackers
-Found in file sv.h
-
=item sv_setuv
X<sv_setuv>
=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.
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.
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..."
*/
}
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);
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 */
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;
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 */
} 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. */
#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 {
+ 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) \
/* 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
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);
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
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);
(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
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? */
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));
}
}
} 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];
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 {
#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)
projects / platform / upstream / perl.git / commitdiff