X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1d7e6444bd515142acf34ef230b50f9d80ab9017..669d6ad81497efd33243c692e6f057f97c6c1567:/av.c diff --git a/av.c b/av.c index a48702b..ba97fed 100644 --- a/av.c +++ b/av.c @@ -89,7 +89,7 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, if (key < -1) /* -1 is legal */ Perl_croak(aTHX_ - "panic: av_extend_guts() negative count (%"IVdf")", (IV)key); + "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key); if (key > *maxp) { SV** ary; @@ -210,7 +210,7 @@ value is non-null before dereferencing it to a C. See L 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 */ @@ -244,10 +244,13 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp) 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)) { @@ -268,22 +271,23 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval) } } - if (key < 0) { - key += AvFILLp(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) && SvIS_FREED(AvARRAY(av)[key])) { - /* eg. @_ could have freed elts */ - AvARRAY(av)[key] = NULL; /* 1/2 reify */ - goto emptyness; - } return &AvARRAY(av)[key]; } @@ -301,7 +305,7 @@ Note that the caller is responsible for suitably incrementing the reference count of C before the call, and decrementing it if the function returned C. -Approximate Perl equivalent: C<$myarray[$key] = $val;>. +Approximate Perl equivalent: C. See L for more information on how to use this function on tied arrays. @@ -405,13 +409,18 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) 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); @@ -426,8 +435,11 @@ Perl_av_make(pTHX_ SSize_t size, SV **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; } @@ -453,6 +465,7 @@ Perl_av_clear(pTHX_ AV *av) { SSize_t extra; bool real; + SSize_t orig_ix = 0; PERL_ARGS_ASSERT_AV_CLEAR; assert(SvTYPE(av) == SVt_PVAV); @@ -478,11 +491,15 @@ Perl_av_clear(pTHX_ AV *av) 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 @@ -497,7 +514,14 @@ Perl_av_clear(pTHX_ AV *av) 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); + } } /* @@ -518,6 +542,7 @@ void 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); @@ -526,10 +551,15 @@ Perl_av_undef(pTHX_ AV *av) 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]); } @@ -540,7 +570,14 @@ Perl_av_undef(pTHX_ AV *av) 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); + } } /* @@ -569,7 +606,7 @@ Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val) 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. +Perl equivalent: C. =cut */ @@ -657,10 +694,9 @@ Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val) =for apidoc av_unshift Unshift the given number of C values onto the beginning of the -array. The array will grow automatically to accommodate the addition. You -must then use C to assign values to these new elements. +array. The array will grow automatically to accommodate the addition. -Perl equivalent: S> +Perl equivalent: S> =cut */ @@ -844,11 +880,13 @@ Perl_av_fill(pTHX_ AV *av, SSize_t fill) /* =for apidoc av_delete -Deletes the element indexed by C from the array, makes the element mortal, -and returns it. If C equals C, the element is freed and null -is returned. Perl equivalent: S> for the -non-C version and a void-context S> for the -C version. +Deletes the element indexed by C from the array, makes the element +mortal, and returns it. If C equals C, the element is +freed and NULL is returned. NULL is also returned if C is out of +range. + +Perl equivalent: S> (with the +C in void context if C is present). =cut */ @@ -1019,17 +1057,17 @@ Perl_av_iter_p(pTHX_ AV *av) { 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 } /*