add intuit-only match to s///

[perl5.git] / av.c

diff --git a/av.c b/av.c
index cfa5399..b15f6ff 100644 (file)
--- a/av.c
+++ b/av.c
@@ -76,7 +76,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     if (mg) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(key + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
                            arg1);
        return;
     }
@@ -119,10 +119,6 @@ Perl_av_extend_guts(pTHX_ AV *av, I32 key, SSize_t *maxp, SV ***allocp,
 #endif
 
            if (*allocp) {
-#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
-               MEM_SIZE bytes;
-               IV itmp;
-#endif
 
 #ifdef Perl_safesysmalloc_size
                /* Whilst it would be quite possible to move this logic around
@@ -147,24 +143,7 @@ Perl_av_extend_guts(pTHX_ AV *av, I32 key, SSize_t *maxp, SV ***allocp,
                newmax = key + *maxp / 5;
              resize:
                MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
                Renew(*allocp,newmax+1, SV*);
-#else
-               bytes = (newmax + 1) * sizeof(const SV *);
-#define MALLOC_OVERHEAD 16
-               itmp = MALLOC_OVERHEAD;
-               while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
-                   itmp += itmp;
-               itmp -= MALLOC_OVERHEAD;
-               itmp /= sizeof(const SV *);
-               assert(itmp > newmax);
-               newmax = itmp - 1;
-               assert(newmax >= *maxp);
-               Newx(ary, newmax+1, SV*);
-               Copy(*allocp, ary, *maxp+1, SV*);
-               Safefree(*allocp);
-               *allocp = ary;
-#endif
 #ifdef Perl_safesysmalloc_size
              resized:
 #endif
@@ -237,7 +216,7 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp)
 }
 
 SV**
-Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
+Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval)
 {
     dVAR;
 
@@ -308,7 +287,7 @@ more information on how to use this function on tied arrays.
 */
 
 SV**
-Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
+Perl_av_store(pTHX_ AV *av, I32 key, SV *val)
 {
     dVAR;
     SV** ary;
@@ -397,7 +376,7 @@ Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
 */
 
 AV *
-Perl_av_make(pTHX_ register I32 size, register SV **strp)
+Perl_av_make(pTHX_ I32 size, SV **strp)
 {
     AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
     /* sv_upgrade does AvREAL_only()  */
@@ -447,7 +426,7 @@ Perl equivalent: C<@myarray = ();>.
 */
 
 void
-Perl_av_clear(pTHX_ register AV *av)
+Perl_av_clear(pTHX_ AV *av)
 {
     dVAR;
     I32 extra;
@@ -510,7 +489,7 @@ be freed.
 */
 
 void
-Perl_av_undef(pTHX_ register AV *av)
+Perl_av_undef(pTHX_ AV *av)
 {
     bool real;
 
@@ -570,7 +549,7 @@ Perl equivalent: C<push @myarray, $elem;>.
 */
 
 void
-Perl_av_push(pTHX_ register AV *av, SV *val)
+Perl_av_push(pTHX_ AV *av, SV *val)
 {             
     dVAR;
     MAGIC *mg;
@@ -582,7 +561,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
                            val);
        return;
     }
@@ -592,8 +571,9 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 /*
 =for apidoc av_pop
 
-Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
-is empty.
+Removes one SV from the end of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller.  Returns C<&PL_sv_undef> if the array is empty.
 
 Perl equivalent: C<pop(@myarray);>
 
@@ -601,7 +581,7 @@ Perl equivalent: C<pop(@myarray);>
 */
 
 SV *
-Perl_av_pop(pTHX_ register AV *av)
+Perl_av_pop(pTHX_ AV *av)
 {
     dVAR;
     SV *retval;
@@ -613,7 +593,7 @@ Perl_av_pop(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -657,12 +637,12 @@ 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 );>
-    
+
 =cut
 */
 
 void
-Perl_av_unshift(pTHX_ register AV *av, register I32 num)
+Perl_av_unshift(pTHX_ AV *av, I32 num)
 {
     dVAR;
     I32 i;
@@ -675,7 +655,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
        Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
                            G_DISCARD | G_UNDEF_FILL, num);
        return;
     }
@@ -717,9 +697,9 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 /*
 =for apidoc av_shift
 
-Shifts an SV off the beginning of the
-array.  Returns C<&PL_sv_undef> if the 
-array is empty.
+Removes one SV from the start of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller.  Returns C<&PL_sv_undef> if the array is empty.
 
 Perl equivalent: C<shift(@myarray);>
 
@@ -727,7 +707,7 @@ Perl equivalent: C<shift(@myarray);>
 */
 
 SV *
-Perl_av_shift(pTHX_ register AV *av)
+Perl_av_shift(pTHX_ AV *av)
 {
     dVAR;
     SV *retval;
@@ -739,7 +719,7 @@ Perl_av_shift(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -758,13 +738,21 @@ Perl_av_shift(pTHX_ register AV *av)
 }
 
 /*
-=for apidoc av_len
+=for apidoc av_top_index
 
 Returns the highest index in the array.  The number of elements in the
-array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
+array is C<av_top_index(av) + 1>.  Returns -1 if the array is empty.
 
 The Perl equivalent for this is C<$#myarray>.
 
+(A slightly shorter form is C<av_tindex>.)
+
+=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.
+
 =cut
 */
 
@@ -772,9 +760,8 @@ I32
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
-    assert(SvTYPE(av) == SVt_PVAV);
 
-    return AvFILL(av);
+    return av_top_index(av);
 }
 
 /*
@@ -792,7 +779,7 @@ the same as C<av_clear(av)>.
 =cut
 */
 void
-Perl_av_fill(pTHX_ register AV *av, I32 fill)
+Perl_av_fill(pTHX_ AV *av, I32 fill)
 {
     dVAR;
     MAGIC *mg;
@@ -805,7 +792,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(fill + 1));
-       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
                            1, arg1);
        return;
     }