void
Perl_av_reify(pTHX_ AV *av)
{
- dVAR;
SSize_t key;
PERL_ARGS_ASSERT_AV_REIFY;
void
Perl_av_extend(pTHX_ AV *av, SSize_t key)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_EXTEND;
Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
SV ***arrayp)
{
- dVAR;
-
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_1(newmax, SV*, oom_array_extend);
}
#ifdef STRESS_REALLOC
{
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_1(newmax, SV*, oom_array_extend);
}
Newx(*allocp, newmax+1, SV*);
ary = *allocp + 1;
SV**
Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
{
- dVAR;
+ 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;>.
SV**
Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
{
- dVAR;
SV** ary;
PERL_ARGS_ASSERT_AV_STORE;
=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...);>
/*
=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
*/
void
Perl_av_clear(pTHX_ AV *av)
{
- dVAR;
SSize_t extra;
bool real;
/*
=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
*/
/*
=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;>.
void
Perl_av_push(pTHX_ AV *av, SV *val)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_PUSH;
SV *
Perl_av_pop(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
array. The array will grow automatically to accommodate the addition. You
must then use C<av_store> to assign values to these new elements.
-Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
+Perl equivalent: S<C<unshift @myarray, ( (undef) x $n );>>
=cut
*/
void
Perl_av_unshift(pTHX_ AV *av, SSize_t num)
{
- dVAR;
SSize_t i;
MAGIC* mg;
SV *
Perl_av_shift(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
=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.
+array is S<C<av_top_index(av) + 1>>. Returns -1 if the array is empty.
The Perl equivalent for this is C<$#myarray>.
=for apidoc av_len
-Same as L</av_top_index>. Returns the highest index in the array. Note that the
-return value is +1 what its name implies it returns; and hence differs in
-meaning from what the similarly named L</sv_len> returns.
+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.
=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 an 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
void
Perl_av_fill(pTHX_ AV *av, SSize_t fill)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_FILL;
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
+is returned. Perl equivalent: S<C<my $elem = delete($myarray[$idx]);>> for the
+non-C<G_DISCARD> version and a void-context S<C<delete($myarray[$idx]);>> for the
C<G_DISCARD> version.
=cut
SV *
Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_AV_DELETE;
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
sv = AvARRAY(av)[key];
+ AvARRAY(av)[key] = NULL;
if (key == AvFILLp(av)) {
- AvARRAY(av)[key] = NULL;
do {
AvFILLp(av)--;
} while (--key >= 0 && !AvARRAY(av)[key]);
}
- else
- AvARRAY(av)[key] = NULL;
if (SvSMAGICAL(av))
mg_set(MUTABLE_SV(av));
}
- if (flags & G_DISCARD) {
- SvREFCNT_dec(sv);
- sv = NULL;
+ if(sv != NULL) {
+ if (flags & G_DISCARD) {
+ SvREFCNT_dec_NN(sv);
+ return NULL;
+ }
+ else if (AvREAL(av))
+ sv_2mortal(sv);
}
- else if (AvREAL(av))
- sv = sv_2mortal(sv);
return sv;
}
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])>.
bool
Perl_av_exists(pTHX_ AV *av, SSize_t key)
{
- dVAR;
PERL_ARGS_ASSERT_AV_EXISTS;
assert(SvTYPE(av) == SVt_PVAV);
static MAGIC *
S_get_aux_mg(pTHX_ AV *av) {
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_GET_AUX_MG;
}
/*
- * 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