X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2b6765935f5ee68d8093e686b8e292ad5de5a898..86c6fce076648c5abe5ab491fec9d3142d93bde1:/av.c

diff --git a/av.c b/av.c
index a4d6ea2..44b5fbc 100644
--- a/av.c
+++ b/av.c
@@ -74,38 +74,41 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
-	dSP;
-	ENTER;
-	SAVETMPS;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	mPUSHi(key + 1);
-        PUTBACK;
-	call_method("EXTEND", G_SCALAR|G_DISCARD);
-	POPSTACK;
-	FREETMPS;
-	LEAVE;
+	SV *arg1 = sv_newmortal();
+	sv_setiv(arg1, (IV)(key + 1));
+	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+			    arg1);
 	return;
     }
-    if (key > AvMAX(av)) {
+    av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av));
+}    
+
+/* The guts of av_extend.  *Not* for general use! */
+void
+Perl_av_extend_guts(pTHX_ AV *av, I32 key, SSize_t *maxp, SV ***allocp,
+			  SV ***arrayp)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
+
+    if (key > *maxp) {
 	SV** ary;
 	I32 tmp;
 	I32 newmax;
 
-	if (AvALLOC(av) != AvARRAY(av)) {
-	    ary = AvALLOC(av) + AvFILLp(av) + 1;
-	    tmp = AvARRAY(av) - AvALLOC(av);
-	    Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
-	    AvMAX(av) += tmp;
-	    AvARRAY(av) = AvALLOC(av);
+	if (av && *allocp != *arrayp) {
+	    ary = *allocp + AvFILLp(av) + 1;
+	    tmp = *arrayp - *allocp;
+	    Move(*arrayp, *allocp, AvFILLp(av)+1, SV*);
+	    *maxp += tmp;
+	    *arrayp = *allocp;
 	    if (AvREAL(av)) {
 		while (tmp)
 		    ary[--tmp] = &PL_sv_undef;
 	    }
-	    if (key > AvMAX(av) - 10) {
-		newmax = key + AvMAX(av);
+	    if (key > *maxp - 10) {
+		newmax = key + *maxp;
 		goto resize;
 	    }
 	}
@@ -115,11 +118,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 	      "Out of memory during array extend"; /* Duplicated in pp_hot.c */
 #endif
 
-	    if (AvALLOC(av)) {
-#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
-		MEM_SIZE bytes;
-		IV itmp;
-#endif
+	    if (*allocp) {
 
 #ifdef Perl_safesysmalloc_size
 		/* Whilst it would be quite possible to move this logic around
@@ -135,63 +134,42 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 		   memory that might never be read. So, I feel, better to keep
 		   the current lazy system of only writing to it if our caller
 		   has a need for more space. NWC  */
-		newmax = Perl_safesysmalloc_size((void*)AvALLOC(av)) /
+		newmax = Perl_safesysmalloc_size((void*)*allocp) /
 		    sizeof(const SV *) - 1;
 
 		if (key <= newmax) 
 		    goto resized;
 #endif 
-		newmax = key + AvMAX(av) / 5;
+		newmax = key + *maxp / 5;
 	      resize:
 		MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-		Renew(AvALLOC(av),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 >= AvMAX(av));
-		Newx(ary, newmax+1, SV*);
-		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
-		if (AvMAX(av) > 64)
-		    offer_nice_chunk(AvALLOC(av),
-				     (AvMAX(av)+1) * sizeof(const SV *));
-		else
-		    Safefree(AvALLOC(av));
-		AvALLOC(av) = ary;
-#endif
+		Renew(*allocp,newmax+1, SV*);
 #ifdef Perl_safesysmalloc_size
 	      resized:
 #endif
-		ary = AvALLOC(av) + AvMAX(av) + 1;
-		tmp = newmax - AvMAX(av);
+		ary = *allocp + *maxp + 1;
+		tmp = newmax - *maxp;
 		if (av == PL_curstack) {	/* Oops, grew stack (via av_store()?) */
-		    PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
-		    PL_stack_base = AvALLOC(av);
+		    PL_stack_sp = *allocp + (PL_stack_sp - PL_stack_base);
+		    PL_stack_base = *allocp;
 		    PL_stack_max = PL_stack_base + newmax;
 		}
 	    }
 	    else {
 		newmax = key < 3 ? 3 : key;
 		MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-		Newx(AvALLOC(av), newmax+1, SV*);
-		ary = AvALLOC(av) + 1;
+		Newx(*allocp, newmax+1, SV*);
+		ary = *allocp + 1;
 		tmp = newmax;
-		AvALLOC(av)[0] = &PL_sv_undef;	/* For the stacks */
+		*allocp[0] = &PL_sv_undef;	/* For the stacks */
 	    }
-	    if (AvREAL(av)) {
+	    if (av && AvREAL(av)) {
 		while (tmp)
 		    ary[--tmp] = &PL_sv_undef;
 	    }
 	    
-	    AvARRAY(av) = AvALLOC(av);
-	    AvMAX(av) = newmax;
+	    *arrayp = *allocp;
+	    *maxp = newmax;
 	}
     }
 }
@@ -200,17 +178,45 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 =for apidoc av_fetch
 
 Returns the SV at the specified index in the array.  The C<key> is the
-index.  If C<lval> is set then the fetch will be part of a store.  Check
-that the return value is non-null before dereferencing it to a C<SV*>.
+index.  If lval is true, you are guaranteed to get a real SV back (in case
+it wasn't real before), which you can then modify.  Check that the return
+value is non-null before dereferencing it to a C<SV*>.
 
 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]>.
+
 =cut
 */
 
+static bool
+S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp)
+{
+    bool adjust_index = 1;
+    if (mg) {
+	/* Handle negative array indices 20020222 MJD */
+	SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg);
+	SvGETMAGIC(ref);
+	if (SvROK(ref) && SvOBJECT(SvRV(ref))) {
+	    SV * const * const negative_indices_glob =
+		hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0);
+
+	    if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
+		adjust_index = 0;
+	}
+    }
+
+    if (adjust_index) {
+	*keyp += AvFILL(av) + 1;
+	if (*keyp < 0)
+	    return FALSE;
+    }
+    return TRUE;
+}
+
 SV**
-Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
+Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval)
 {
     dVAR;
 
@@ -223,28 +229,15 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
         if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
 	    SV *sv;
 	    if (key < 0) {
-		I32 adjust_index = 1;
-		if (tied_magic) {
-		    /* Handle negative array indices 20020222 MJD */
-		    SV * const * const negative_indices_glob =
-			hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av),
-							 tied_magic))),
-				NEGATIVE_INDICES_VAR, 16, 0);
-
-		    if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
-			adjust_index = 0;
-		}
-
-		if (adjust_index) {
-		    key += AvFILL(av) + 1;
-		    if (key < 0)
+		if (!S_adjust_index(aTHX_ av, tied_magic, &key))
 			return NULL;
-		}
 	    }
 
             sv = sv_newmortal();
 	    sv_upgrade(sv, SVt_PVLV);
 	    mg_copy(MUTABLE_SV(av), sv, 0, key);
+	    if (!tied_magic) /* for regdata, force leavesub to make copies */
+		SvTEMP_off(sv);
 	    LvTYPE(sv) = 't';
 	    LvTARG(sv) = sv; /* fake (SV**) */
 	    return &(LvTARG(sv));
@@ -257,18 +250,12 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 	    return NULL;
     }
 
-    if (key > AvFILLp(av)) {
-	if (!lval)
-	    return NULL;
-	return av_store(av,key,newSV(0));
+    if (key > AvFILLp(av) || AvARRAY(av)[key] == &PL_sv_undef) {
+      emptyness:
+	return lval ? av_store(av,key,newSV(0)) : NULL;
     }
-    if (AvARRAY(av)[key] == &PL_sv_undef) {
-    emptyness:
-	if (lval)
-	    return av_store(av,key,newSV(0));
-	return NULL;
-    }
-    else if (AvREIFY(av)
+
+    if (AvREIFY(av)
 	     && (!AvARRAY(av)[key]	/* eg. @_ could have freed elts */
 		 || SvIS_FREED(AvARRAY(av)[key]))) {
 	AvARRAY(av)[key] = &PL_sv_undef;	/* 1/2 reify */
@@ -283,11 +270,16 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 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
 need to be actually stored within the array (as in the case of tied
-arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
-that the caller is responsible for suitably incrementing the reference
+arrays). Otherwise, it can be dereferenced
+to get the C<SV*> that was stored
+there (= C<val>)).
+
+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.
 
+Approximate Perl equivalent: C<$myarray[$key] = $val;>.
+
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays.
 
@@ -295,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;
@@ -313,21 +305,9 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied);
         if (tied_magic) {
-            /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
-		bool adjust_index = 1;
-		SV * const * const negative_indices_glob =
-                    hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                     tied_magic))), 
-                             NEGATIVE_INDICES_VAR, 16, 0);
-                if (negative_indices_glob
-                    && SvTRUE(GvSV(*negative_indices_glob)))
-                    adjust_index = 0;
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
+		if (!S_adjust_index(aTHX_ av, tied_magic, &key))
                         return 0;
-                }
             }
 	    if (val != &PL_sv_undef) {
 		mg_copy(MUTABLE_SV(av), val, 0, key);
@@ -344,7 +324,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
 
     if (!AvREAL(av) && AvREIFY(av))
 	av_reify(av);
@@ -365,13 +345,19 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 	SvREFCNT_dec(ary[key]);
     ary[key] = val;
     if (SvSMAGICAL(av)) {
-	const MAGIC* const mg = SvMAGIC(av);
-	if (val != &PL_sv_undef) {
+	const MAGIC *mg = SvMAGIC(av);
+	bool set = TRUE;
+	for (; mg; mg = mg->mg_moremagic) {
+	  if (!isUPPER(mg->mg_type)) continue;
+	  if (val != &PL_sv_undef) {
 	    sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
+	  }
+	  if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) {
+	    PL_delaymagic |= DM_ARRAY_ISA;
+	    set = FALSE;
+	  }
 	}
-	if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
-	    PL_delaymagic |= DM_ARRAY;
-	else
+	if (set)
 	   mg_set(MUTABLE_SV(av));
     }
     return &ary[key];
@@ -384,24 +370,29 @@ 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
 will have a reference count of 1.
 
+Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
+
 =cut
 */
 
 AV *
-Perl_av_make(pTHX_ register I32 size, register SV **strp)
+Perl_av_make(pTHX_ I32 size, SV **strp)
 {
-    register AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
+    AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
     /* sv_upgrade does AvREAL_only()  */
     PERL_ARGS_ASSERT_AV_MAKE;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (size) {		/* "defined" was returning undef for size==0 anyway. */
-        register SV** ary;
-        register I32 i;
+        SV** ary;
+        I32 i;
 	Newx(ary,size,SV*);
 	AvALLOC(av) = ary;
 	AvARRAY(av) = ary;
-	AvFILLp(av) = AvMAX(av) = size - 1;
+	AvMAX(av) = size - 1;
+	AvFILLp(av) = -1;
+	ENTER;
+	SAVEFREESV(av);
 	for (i = 0; i < size; i++) {
 	    assert (*strp);
 
@@ -409,11 +400,15 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 	       have multiple references to the same temp scalar (e.g.
 	       from a list slice) */
 
+	    SvGETMAGIC(*strp); /* before newSV, in case it dies */
+	    AvFILLp(av)++;
 	    ary[i] = newSV(0);
 	    sv_setsv_flags(ary[i], *strp,
-			   SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
+			   SV_DO_COW_SVSETSV|SV_NOSTEAL);
 	    strp++;
 	}
+	SvREFCNT_inc_simple_void_NN(av);
+	LEAVE;
     }
     return av;
 }
@@ -421,17 +416,21 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 /*
 =for apidoc av_clear
 
-Clears an array, making it empty.  Does not free the memory used by the
-array itself.
+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.
+
+Perl equivalent: C<@myarray = ();>.
 
 =cut
 */
 
 void
-Perl_av_clear(pTHX_ register AV *av)
+Perl_av_clear(pTHX_ AV *av)
 {
     dVAR;
     I32 extra;
+    bool real;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
     assert(SvTYPE(av) == SVt_PVAV);
@@ -443,13 +442,13 @@ Perl_av_clear(pTHX_ register AV *av)
 #endif
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
 	const MAGIC* const mg = SvMAGIC(av);
 	if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
-	    PL_delaymagic |= DM_ARRAY;
+	    PL_delaymagic |= DM_ARRAY_ISA;
         else
 	    mg_clear(MUTABLE_SV(av)); 
     }
@@ -457,9 +456,11 @@ Perl_av_clear(pTHX_ register AV *av)
     if (AvMAX(av) < 0)
 	return;
 
-    if (AvREAL(av)) {
+    if ((real = !!AvREAL(av))) {
 	SV** const ary = AvARRAY(av);
 	I32 index = AvFILLp(av) + 1;
+	ENTER;
+	SAVEFREESV(SvREFCNT_inc_simple_NN(av));
 	while (index) {
 	    SV * const sv = ary[--index];
 	    /* undef the slot before freeing the value, because a
@@ -474,20 +475,24 @@ Perl_av_clear(pTHX_ register AV *av)
 	AvARRAY(av) = AvALLOC(av);
     }
     AvFILLp(av) = -1;
-
+    if (real) LEAVE;
 }
 
 /*
 =for apidoc av_undef
 
-Undefines the array.  Frees the memory used by the array itself.
+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.
 
 =cut
 */
 
 void
-Perl_av_undef(pTHX_ register AV *av)
+Perl_av_undef(pTHX_ AV *av)
 {
+    bool real;
+
     PERL_ARGS_ASSERT_AV_UNDEF;
     assert(SvTYPE(av) == SVt_PVAV);
 
@@ -495,8 +500,10 @@ Perl_av_undef(pTHX_ register AV *av)
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) 
 	av_fill(av, -1);
 
-    if (AvREAL(av)) {
-	register I32 key = AvFILLp(av) + 1;
+    if ((real = !!AvREAL(av))) {
+	I32 key = AvFILLp(av) + 1;
+	ENTER;
+	SAVEFREESV(SvREFCNT_inc_simple_NN(av));
 	while (key)
 	    SvREFCNT_dec(AvARRAY(av)[--key]);
     }
@@ -507,6 +514,7 @@ Perl_av_undef(pTHX_ register AV *av)
     AvMAX(av) = AvFILLp(av) = -1;
 
     if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
+    if(real) LEAVE;
 }
 
 /*
@@ -533,14 +541,15 @@ Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
 =for apidoc av_push
 
 Pushes an SV onto the end of the array.  The array will grow automatically
-to accommodate the addition. Like C<av_store>, this takes ownership of one
-reference count.
+to accommodate the addition.  This takes ownership of one reference count.
+
+Perl equivalent: C<push @myarray, $elem;>.
 
 =cut
 */
 
 void
-Perl_av_push(pTHX_ register AV *av, SV *val)
+Perl_av_push(pTHX_ AV *av, SV *val)
 {             
     dVAR;
     MAGIC *mg;
@@ -549,20 +558,11 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUSHs(val);
-	PUTBACK;
-	ENTER;
-	call_method("PUSH", G_SCALAR|G_DISCARD);
-	LEAVE;
-	POPSTACK;
+	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+			    val);
 	return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -571,14 +571,17 @@ 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);>
 
 =cut
 */
 
 SV *
-Perl_av_pop(pTHX_ register AV *av)
+Perl_av_pop(pTHX_ AV *av)
 {
     dVAR;
     SV *retval;
@@ -588,21 +591,11 @@ Perl_av_pop(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;    
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUTBACK;
-	ENTER;
-	if (call_method("POP", G_SCALAR)) {
-	    retval = newSVsv(*PL_stack_sp--);    
-	} else {    
-	    retval = &PL_sv_undef;
-	}
-	LEAVE;
-	POPSTACK;
+	retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+	if (retval)
+	    retval = newSVsv(retval);
 	return retval;
     }
     if (AvFILL(av) < 0)
@@ -643,36 +636,27 @@ 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.
 
+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;
-    register I32 i;
+    I32 i;
     MAGIC* mg;
 
     PERL_ARGS_ASSERT_AV_UNSHIFT;
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,1+num);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	while (num-- > 0) {
-	    PUSHs(&PL_sv_undef);
-	}
-	PUTBACK;
-	ENTER;
-	call_method("UNSHIFT", G_SCALAR|G_DISCARD);
-	LEAVE;
-	POPSTACK;
+	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+			    G_DISCARD | G_UNDEF_FILL, num);
 	return;
     }
 
@@ -691,7 +675,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 	AvARRAY(av) = AvARRAY(av) - i;
     }
     if (num) {
-	register SV **ary;
+	SV **ary;
 	const I32 i = AvFILLp(av);
 	/* Create extra elements */
 	const I32 slide = i > 0 ? i : 0;
@@ -713,14 +697,17 @@ 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 
+Shifts an SV off the beginning of the
+array.  Returns C<&PL_sv_undef> if the 
 array is empty.
 
+Perl equivalent: C<shift(@myarray);>
+
 =cut
 */
 
 SV *
-Perl_av_shift(pTHX_ register AV *av)
+Perl_av_shift(pTHX_ AV *av)
 {
     dVAR;
     SV *retval;
@@ -730,21 +717,11 @@ Perl_av_shift(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUTBACK;
-	ENTER;
-	if (call_method("SHIFT", G_SCALAR)) {
-	    retval = newSVsv(*PL_stack_sp--);            
-	} else {    
-	    retval = &PL_sv_undef;
-	}     
-	LEAVE;
-	POPSTACK;
+	retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+	if (retval)
+	    retval = newSVsv(retval);
 	return retval;
     }
     if (AvFILL(av) < 0)
@@ -761,10 +738,20 @@ 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
 */
@@ -773,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);
 }
 
 /*
@@ -785,7 +771,7 @@ Set the highest index in the array to the given number, equivalent to
 Perl'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
+av_fill() returns.  If the array was previously shorter, then the
 additional elements appended are set to C<PL_sv_undef>.  If the array
 was longer, then the excess elements are freed.  C<av_fill(av, -1)> is
 the same as C<av_clear(av)>.
@@ -793,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;
@@ -804,19 +790,10 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if (fill < 0)
 	fill = -1;
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;            
-	ENTER;
-	SAVETMPS;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	mPUSHi(fill + 1);
-	PUTBACK;
-	call_method("STORESIZE", G_SCALAR|G_DISCARD);
-	POPSTACK;
-	FREETMPS;
-	LEAVE;
+	SV *arg1 = sv_newmortal();
+	sv_setiv(arg1, (IV)(fill + 1));
+	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+			    1, arg1);
 	return;
     }
     if (fill <= AvMAX(av)) {
@@ -845,9 +822,11 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 /*
 =for apidoc av_delete
 
-Deletes the element indexed by C<key> from the array.  Returns the
-deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
-and null is returned.
+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.
 
 =cut
 */
@@ -861,30 +840,16 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify();
 
     if (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))) {
-            /* Handle negative array indices 20020222 MJD */
             SV **svp;
             if (key < 0) {
-                unsigned adjust_index = 1;
-                if (tied_magic) {
-		    SV * const * const negative_indices_glob =
-                        hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                         tied_magic))), 
-                                 NEGATIVE_INDICES_VAR, 16, 0);
-                    if (negative_indices_glob
-                        && SvTRUE(GvSV(*negative_indices_glob)))
-                        adjust_index = 0;
-                }
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
+		if (!S_adjust_index(aTHX_ av, tied_magic, &key))
 			return NULL;
-                }
             }
             svp = av_fetch(av, key, TRUE);
             if (svp) {
@@ -939,6 +904,8 @@ Returns true if the element indexed by C<key> has been initialized.
 This relies on the fact that uninitialized array elements are set to
 C<&PL_sv_undef>.
 
+Perl equivalent: C<exists($myarray[$key])>.
+
 =cut
 */
 bool
@@ -951,35 +918,34 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
     if (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)) {
-	    SV * const sv = sv_newmortal();
+        const MAGIC * const regdata_magic
+            = mg_find((const SV *)av, PERL_MAGIC_regdata);
+        if (tied_magic || regdata_magic) {
             MAGIC *mg;
             /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
-                unsigned adjust_index = 1;
-                if (tied_magic) {
-		    SV * const * const negative_indices_glob =
-                        hv_fetch(SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(av), 
-                                                         tied_magic))), 
-                                 NEGATIVE_INDICES_VAR, 16, 0);
-                    if (negative_indices_glob
-                        && SvTRUE(GvSV(*negative_indices_glob)))
-                        adjust_index = 0;
-                }
-                if (adjust_index) {
-                    key += AvFILL(av) + 1;
-                    if (key < 0)
+		if (!S_adjust_index(aTHX_ av, tied_magic, &key))
                         return FALSE;
-                }
             }
 
-            mg_copy(MUTABLE_SV(av), sv, 0, key);
-            mg = mg_find(sv, PERL_MAGIC_tiedelem);
-            if (mg) {
-                magic_existspack(sv, mg);
-                return (bool)SvTRUE(sv);
+            if(key >= 0 && regdata_magic) {
+                if (key <= AvFILL(av))
+                    return TRUE;
+                else
+                    return FALSE;
             }
-
+	    {
+		SV * const sv = sv_newmortal();
+		mg_copy(MUTABLE_SV(av), sv, 0, key);
+		mg = mg_find(sv, PERL_MAGIC_tiedelem);
+		if (mg) {
+		    magic_existspack(sv, mg);
+		    {
+			I32 retbool = SvTRUE_nomg_NN(sv);
+			return cBOOL(retbool);
+		    }
+		}
+	    }
         }
     }
 
@@ -1052,8 +1018,8 @@ Perl_av_iter_p(pTHX_ AV *av) {
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */