*/
/*
-=head1 Array Manipulation Functions
+=for apidoc_section AV Handling
*/
#include "EXTERN.h"
/*
=for apidoc av_extend
-Pre-extend an array. The C<key> is the index to which the array should be
-extended.
+Pre-extend an array so that it is capable of storing values at indexes
+C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
+elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
+on a plain array will work without any further memory allocation.
+
+If the av argument is a tied array then will call the C<EXTEND> tied
+array method with an argument of C<(key+1)>.
=cut
*/
mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
if (mg) {
SV *arg1 = sv_newmortal();
+ /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
+ *
+ * The C function takes an *index* (assumes 0 indexed arrays) and ensures
+ * that the array is at least as large as the index provided.
+ *
+ * The tied array method EXTEND takes a *count* and ensures that the array
+ * is at least that many elements large. Thus we have to +1 the key when
+ * we call the tied method.
+ */
sv_setiv(arg1, (IV)(key + 1));
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
arg1);
{
PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
+ if (key < -1) /* -1 is legal */
+ Perl_croak(aTHX_
+ "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
+
if (key > *maxp) {
SV** ary;
SSize_t tmp;
if (key <= newmax)
goto resized;
#endif
- newmax = key + *maxp / 5;
+ /* overflow-safe version of newmax = key + *maxp/5 */
+ newmax = *maxp / 5;
+ newmax = (key > SSize_t_MAX - newmax)
+ ? SSize_t_MAX : key + newmax;
resize:
{
-#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
- static const char oom_array_extend[] =
- "Out of memory during array extend";
-#endif
- MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+ /* it should really be newmax+1 here, but if newmax
+ * happens to equal SSize_t_MAX, then newmax+1 is
+ * undefined. This means technically we croak one
+ * index lower than we should in theory; in practice
+ * its unlikely the system has SSize_t_MAX/sizeof(SV*)
+ * bytes to spare! */
+ MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
}
#ifdef STRESS_REALLOC
{
else {
newmax = key < 3 ? 3 : key;
{
-#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
- static const char oom_array_extend[] =
- "Out of memory during array extend";
-#endif
- MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+ /* see comment above about newmax+1*/
+ MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
}
Newx(*allocp, newmax+1, SV*);
ary = *allocp + 1;
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
more information on how to use this function on tied arrays.
-The rough perl equivalent is C<$myarray[$idx]>.
+The rough perl equivalent is C<$myarray[$key]>.
=cut
*/
SV**
Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
{
+ SSize_t neg;
+ SSize_t size;
+
PERL_ARGS_ASSERT_AV_FETCH;
assert(SvTYPE(av) == SVt_PVAV);
- if (SvRMAGICAL(av)) {
+ if (UNLIKELY(SvRMAGICAL(av))) {
const MAGIC * const tied_magic
= mg_find((const SV *)av, PERL_MAGIC_tied);
if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
}
}
- if (key < 0) {
- key += AvFILL(av) + 1;
- if (key < 0)
+ neg = (key < 0);
+ size = AvFILLp(av) + 1;
+ key += neg * size; /* handle negative index without using branch */
+
+ /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
+ * to be tested as a single condition */
+ if ((Size_t)key >= (Size_t)size) {
+ if (UNLIKELY(neg))
return NULL;
+ goto emptyness;
}
- if (key > AvFILLp(av) || !AvARRAY(av)[key]) {
+ if (!AvARRAY(av)[key]) {
emptyness:
return lval ? av_store(av,key,newSV(0)) : NULL;
}
- if (AvREIFY(av)
- && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
- || SvIS_FREED(AvARRAY(av)[key]))) {
- AvARRAY(av)[key] = NULL; /* 1/2 reify */
- goto emptyness;
- }
return &AvARRAY(av)[key];
}
=for apidoc av_store
Stores an SV in an array. The array index is specified as C<key>. The
-return value will be NULL if the operation failed or if the value did not
+return value will be C<NULL> if the operation failed or if the value did not
need to be actually stored within the array (as in the case of tied
arrays). Otherwise, it can be dereferenced
to get the C<SV*> that was stored
Note that the caller is responsible for suitably incrementing the reference
count of C<val> before the call, and decrementing it if the function
-returned NULL.
+returned C<NULL>.
-Approximate Perl equivalent: C<$myarray[$key] = $val;>.
+Approximate Perl equivalent: C<splice(@myarray, $key, 1, $val)>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
more information on how to use this function on tied arrays.
=for apidoc av_make
Creates a new AV and populates it with a list of SVs. The SVs are copied
-into the array, so they may be freed after the call to av_make. The new AV
+into the array, so they may be freed after the call to C<av_make>. The new AV
will have a reference count of 1.
Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
if (size) { /* "defined" was returning undef for size==0 anyway. */
SV** ary;
SSize_t i;
+ SSize_t orig_ix;
+
Newx(ary,size,SV*);
AvALLOC(av) = ary;
AvARRAY(av) = ary;
AvMAX(av) = size - 1;
AvFILLp(av) = -1;
- ENTER;
- SAVEFREESV(av);
+ /* avoid av being leaked if croak when calling magic below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
+ orig_ix = PL_tmps_ix;
+
for (i = 0; i < size; i++) {
assert (*strp);
SV_DO_COW_SVSETSV|SV_NOSTEAL);
strp++;
}
- SvREFCNT_inc_simple_void_NN(av);
- LEAVE;
+ /* disarm av's leak guard */
+ if (LIKELY(PL_tmps_ix == orig_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[orig_ix] = &PL_sv_undef;
}
return av;
}
/*
=for apidoc av_clear
-Clears an array, making it empty. Does not free the memory the av uses to
-store its list of scalars. If any destructors are triggered as a result,
-the av itself may be freed when this function returns.
+Frees the all the elements of an array, leaving it empty.
+The XS equivalent of C<@array = ()>. See also L</av_undef>.
-Perl equivalent: C<@myarray = ();>.
+Note that it is possible that the actions of a destructor called directly
+or indirectly by freeing an element of the array could cause the reference
+count of the array itself to be reduced (e.g. by deleting an entry in the
+symbol table). So it is a possibility that the AV could have been freed
+(or even reallocated) on return from the call unless you hold a reference
+to it.
=cut
*/
{
SSize_t extra;
bool real;
+ SSize_t orig_ix = 0;
PERL_ARGS_ASSERT_AV_CLEAR;
assert(SvTYPE(av) == SVt_PVAV);
if (AvMAX(av) < 0)
return;
- if ((real = !!AvREAL(av))) {
+ if ((real = cBOOL(AvREAL(av)))) {
SV** const ary = AvARRAY(av);
SSize_t index = AvFILLp(av) + 1;
- ENTER;
- SAVEFREESV(SvREFCNT_inc_simple_NN(av));
+
+ /* avoid av being freed when calling destructors below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+ orig_ix = PL_tmps_ix;
+
while (index) {
SV * const sv = ary[--index];
/* undef the slot before freeing the value, because a
AvARRAY(av) = AvALLOC(av);
}
AvFILLp(av) = -1;
- if (real) LEAVE;
+ if (real) {
+ /* disarm av's premature free guard */
+ if (LIKELY(PL_tmps_ix == orig_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[orig_ix] = &PL_sv_undef;
+ SvREFCNT_dec_NN(av);
+ }
}
/*
=for apidoc av_undef
-Undefines the array. Frees the memory used by the av to store its list of
-scalars. If any destructors are triggered as a result, the av itself may
-be freed.
+Undefines the array. The XS equivalent of C<undef(@array)>.
+
+As well as freeing all the elements of the array (like C<av_clear()>), this
+also frees the memory used by the av to store its list of scalars.
+
+See L</av_clear> for a note about the array possibly being invalid on
+return.
=cut
*/
Perl_av_undef(pTHX_ AV *av)
{
bool real;
+ SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
PERL_ARGS_ASSERT_AV_UNDEF;
assert(SvTYPE(av) == SVt_PVAV);
if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied))
av_fill(av, -1);
- if ((real = !!AvREAL(av))) {
+ real = cBOOL(AvREAL(av));
+ if (real) {
SSize_t key = AvFILLp(av) + 1;
- ENTER;
- SAVEFREESV(SvREFCNT_inc_simple_NN(av));
+
+ /* avoid av being freed when calling destructors below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+ orig_ix = PL_tmps_ix;
+
while (key)
SvREFCNT_dec(AvARRAY(av)[--key]);
}
AvMAX(av) = AvFILLp(av) = -1;
if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
- if(real) LEAVE;
+ if (real) {
+ /* disarm av's premature free guard */
+ if (LIKELY(PL_tmps_ix == orig_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[orig_ix] = &PL_sv_undef;
+ SvREFCNT_dec_NN(av);
+ }
}
/*
/*
=for apidoc av_push
-Pushes an SV onto the end of the array. The array will grow automatically
-to accommodate the addition. This takes ownership of one reference count.
+Pushes an SV (transferring control of one reference count) onto the end of the
+array. The array will grow automatically to accommodate the addition.
-Perl equivalent: C<push @myarray, $elem;>.
+Perl equivalent: C<push @myarray, $val;>.
=cut
*/
=for apidoc av_unshift
Unshift the given number of C<undef> values onto the beginning of the
-array. The array will grow automatically to accommodate the addition. You
-must then use C<av_store> to assign values to these new elements.
+array. The array will grow automatically to accommodate the addition.
-Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
+Perl equivalent: S<C<unshift @myarray, ((undef) x $num);>>
=cut
*/
}
/*
-=for apidoc av_top_index
-
-Returns the highest index in the array. The number of elements in the
-array is C<av_top_index(av) + 1>. Returns -1 if the array is empty.
+=for apidoc av_tindex
+=for apidoc_item av_top_index
-The Perl equivalent for this is C<$#myarray>.
+These behave identically.
+If the array C<av> is empty, these return -1; otherwise they return the maximum
+value of the indices of all the array elements which are currently defined in
+C<av>.
-(A slightly shorter form is C<av_tindex>.)
+They process 'get' magic.
-=for apidoc av_tindex
+The Perl equivalent for these is C<$#av>.
-Same as L</av_top_index>.
+Use C<L</av_count>> to get the number of elements in an array.
=for apidoc av_len
Same as L</av_top_index>. Note that, unlike what the name implies, it returns
-the highest index in the array, so to get the size of the array you need to use
-S<C<av_len(av) + 1>>. This is unlike L</sv_len>, which returns what you would
-expect.
+the maximum index in the array. This is unlike L</sv_len>, which returns what
+you would expect.
+
+B<To get the true number of elements in the array, instead use C<L</av_count>>>.
=cut
*/
=for apidoc av_fill
Set the highest index in the array to the given number, equivalent to
-Perl's C<$#array = $fill;>.
+Perl's S<C<$#array = $fill;>>.
-The number of elements in the array will be C<fill + 1> after
-av_fill() returns. If the array was previously shorter, then the
+The number of elements in the array will be S<C<fill + 1>> after
+C<av_fill()> returns. If the array was previously shorter, then the
additional elements appended are set to NULL. If the array
-was longer, then the excess elements are freed. C<av_fill(av, -1)> is
+was longer, then the excess elements are freed. S<C<av_fill(av, -1)>> is
the same as C<av_clear(av)>.
=cut
/*
=for apidoc av_delete
-Deletes the element indexed by C<key> from the array, makes the element mortal,
-and returns it. If C<flags> equals C<G_DISCARD>, the element is freed and null
-is returned. Perl equivalent: C<my $elem = delete($myarray[$idx]);> for the
-non-C<G_DISCARD> version and a void-context C<delete($myarray[$idx]);> for the
-C<G_DISCARD> version.
+Deletes the element indexed by C<key> from the array, makes the element
+mortal, and returns it. If C<flags> equals C<G_DISCARD>, the element is
+freed and NULL is returned. NULL is also returned if C<key> is out of
+range.
+
+Perl equivalent: S<C<splice(@myarray, $key, 1, undef)>> (with the
+C<splice> in void context if C<G_DISCARD> is present).
=cut
*/
Returns true if the element indexed by C<key> has been initialized.
This relies on the fact that uninitialized array elements are set to
-NULL.
+C<NULL>.
Perl equivalent: C<exists($myarray[$key])>.
if (key <= AvFILLp(av) && AvARRAY(av)[key])
{
+ if (SvSMAGICAL(AvARRAY(av)[key])
+ && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
+ return FALSE;
return TRUE;
}
else
PERL_ARGS_ASSERT_AV_ITER_P;
assert(SvTYPE(av) == SVt_PVAV);
-#if IVSIZE == I32SIZE
- return (IV *)&(mg->mg_len);
-#else
- if (!mg->mg_ptr) {
- IV *temp;
- mg->mg_len = IVSIZE;
- Newxz(temp, 1, IV);
- mg->mg_ptr = (char *) temp;
+ if (sizeof(IV) == sizeof(SSize_t)) {
+ return (IV *)&(mg->mg_len);
+ } else {
+ if (!mg->mg_ptr) {
+ IV *temp;
+ mg->mg_len = IVSIZE;
+ Newxz(temp, 1, IV);
+ mg->mg_ptr = (char *) temp;
+ }
+ return (IV *)mg->mg_ptr;
}
- return (IV *)mg->mg_ptr;
-#endif
+}
+
+SV *
+Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
+ SV * const sv = newSV(0);
+ PERL_ARGS_ASSERT_AV_NONELEM;
+ if (!av_store(av,ix,sv))
+ return sv_2mortal(sv); /* has tie magic */
+ sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
+ return sv;
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff