X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=c1b03fee75be2c63df32febe14d45b7e1f40aaa6;hb=e59c8b07349f66b8f6de8cad95787c1bfaf1297d;hp=c2250932c7361a55c6b370ab0176f6729eb763c7;hpb=7a5b473ebcffe303e0ee757c10a615cdeb97e2f3;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/av.c b/av.c
index c225093..c1b03fe 100644
--- a/av.c
+++ b/av.c
@@ -1,7 +1,7 @@
 /*    av.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -24,6 +24,7 @@
 void
 Perl_av_reify(pTHX_ AV *av)
 {
+    dVAR;
     I32 key;
 
     assert(av);
@@ -41,7 +42,7 @@ Perl_av_reify(pTHX_ AV *av)
 	SV * const sv = AvARRAY(av)[--key];
 	assert(sv);
 	if (sv != &PL_sv_undef)
-	    (void)SvREFCNT_inc(sv);
+	    SvREFCNT_inc_simple_void_NN(sv);
     }
     key = AvARRAY(av) - AvALLOC(av);
     while (key)
@@ -62,6 +63,7 @@ extended.
 void
 Perl_av_extend(pTHX_ AV *av, I32 key)
 {
+    dVAR;
     MAGIC *mg;
 
     assert(av);
@@ -93,7 +95,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 	    tmp = AvARRAY(av) - AvALLOC(av);
 	    Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
 	    AvMAX(av) += tmp;
-	    SvPV_set(av, (char*)AvALLOC(av));
+	    AvARRAY(av) = AvALLOC(av);
 	    if (AvREAL(av)) {
 		while (tmp)
 		    ary[--tmp] = &PL_sv_undef;
@@ -169,7 +171,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 		    ary[--tmp] = &PL_sv_undef;
 	    }
 	    
-	    SvPV_set(av, (char*)AvALLOC(av));
+	    AvARRAY(av) = AvALLOC(av);
 	    AvMAX(av) = newmax;
 	}
     }
@@ -191,32 +193,32 @@ more information on how to use this function on tied arrays.
 SV**
 Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 {
-    SV *sv;
+    dVAR;
 
     assert(av);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
         if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
-            U32 adjust_index = 1;
-
-            if (tied_magic && key < 0) {
-                /* Handle negative array indices 20020222 MJD */
-		SV * const * const negative_indices_glob =
-                    hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
-                                                     tied_magic))), 
-                             NEGATIVE_INDICES_VAR, 16, 0);
+	    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((SV *)av, tied_magic))),
+				NEGATIVE_INDICES_VAR, 16, 0);
 
-                if (negative_indices_glob
-                    && SvTRUE(GvSV(*negative_indices_glob)))
-                    adjust_index = 0;
-            }
+		    if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob)))
+			adjust_index = 0;
+		}
 
-            if (key < 0 && adjust_index) {
-                key += AvFILL(av) + 1;
-                if (key < 0)
-                    return 0;
-            }
+		if (adjust_index) {
+		    key += AvFILL(av) + 1;
+		    if (key < 0)
+			return NULL;
+		}
+	    }
 
             sv = sv_newmortal();
 	    sv_upgrade(sv, SVt_PVLV);
@@ -230,22 +232,19 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
     if (key < 0) {
 	key += AvFILL(av) + 1;
 	if (key < 0)
-	    return 0;
+	    return NULL;
     }
 
     if (key > AvFILLp(av)) {
 	if (!lval)
-	    return 0;
-	sv = NEWSV(5,0);
-	return av_store(av,key,sv);
+	    return NULL;
+	return av_store(av,key,newSV(0));
     }
     if (AvARRAY(av)[key] == &PL_sv_undef) {
     emptyness:
-	if (lval) {
-	    sv = NEWSV(6,0);
-	    return av_store(av,key,sv);
-	}
-	return 0;
+	if (lval)
+	    return av_store(av,key,newSV(0));
+	return NULL;
     }
     else if (AvREIFY(av)
 	     && (!AvARRAY(av)[key]	/* eg. @_ could have freed elts */
@@ -276,10 +275,15 @@ more information on how to use this function on tied arrays.
 SV**
 Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 {
+    dVAR;
     SV** ary;
 
     assert(av);
 
+    /* S_regclass relies on being able to pass in a NULL sv
+       (unicode_alternate may be NULL).
+    */
+
     if (!val)
 	val = &PL_sv_undef;
 
@@ -288,7 +292,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
         if (tied_magic) {
             /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
-                unsigned adjust_index = 1;
+		bool adjust_index = 1;
 		SV * const * const negative_indices_glob =
                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
                                                      tied_magic))), 
@@ -305,7 +309,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 	    if (val != &PL_sv_undef) {
 		mg_copy((SV*)av, val, 0, key);
 	    }
-	    return 0;
+	    return NULL;
         }
     }
 
@@ -313,7 +317,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     if (key < 0) {
 	key += AvFILL(av) + 1;
 	if (key < 0)
-	    return 0;
+	    return NULL;
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
@@ -328,9 +332,9 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 	if (!AvREAL(av)) {
 	    if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
 		PL_stack_sp = PL_stack_base + key;	/* XPUSH in disguise */
-	    do
+	    do {
 		ary[++AvFILLp(av)] = &PL_sv_undef;
-	    while (AvFILLp(av) < key);
+	    } while (AvFILLp(av) < key);
 	}
 	AvFILLp(av) = key;
     }
@@ -358,12 +362,10 @@ Creates a new AV.  The reference count is set to 1.
 AV *
 Perl_newAV(pTHX)
 {
-    register AV * const av = (AV*)NEWSV(3,0);
-
-    sv_upgrade((SV *)av, SVt_PVAV);
+    register AV * const av = (AV*)newSV_type(SVt_PVAV);
     /* sv_upgrade does AvREAL_only()  */
     AvALLOC(av) = 0;
-    SvPV_set(av, (char*)0);
+    AvARRAY(av) = NULL;
     AvMAX(av) = AvFILLp(av) = -1;
     return av;
 }
@@ -381,21 +383,18 @@ will have a reference count of 1.
 AV *
 Perl_av_make(pTHX_ register I32 size, register SV **strp)
 {
-    register AV * const av = (AV*)NEWSV(8,0);
-
-    sv_upgrade((SV *) av,SVt_PVAV);
+    register AV * const av = (AV*)newSV_type(SVt_PVAV);
     /* sv_upgrade does AvREAL_only()  */
     if (size) {		/* "defined" was returning undef for size==0 anyway. */
         register SV** ary;
         register I32 i;
 	Newx(ary,size,SV*);
 	AvALLOC(av) = ary;
-	SvPV_set(av, (char*)ary);
-	AvFILLp(av) = size - 1;
-	AvMAX(av) = size - 1;
+	AvARRAY(av) = ary;
+	AvFILLp(av) = AvMAX(av) = size - 1;
 	for (i = 0; i < size; i++) {
 	    assert (*strp);
-	    ary[i] = NEWSV(7,0);
+	    ary[i] = newSV(0);
 	    sv_setsv(ary[i], *strp);
 	    strp++;
 	}
@@ -415,7 +414,8 @@ array itself.
 void
 Perl_av_clear(pTHX_ register AV *av)
 {
-    register I32 key;
+    dVAR;
+    I32 extra;
 
     assert(av);
 #ifdef DEBUGGING
@@ -436,18 +436,19 @@ Perl_av_clear(pTHX_ register AV *av)
 
     if (AvREAL(av)) {
 	SV** const ary = AvARRAY(av);
-	key = AvFILLp(av) + 1;
-	while (key) {
-	    SV * const sv = ary[--key];
+	I32 index = AvFILLp(av) + 1;
+	while (index) {
+	    SV * const sv = ary[--index];
 	    /* undef the slot before freeing the value, because a
-	     * destructor might try to modify this arrray */
-	    ary[key] = &PL_sv_undef;
+	     * destructor might try to modify this array */
+	    ary[index] = &PL_sv_undef;
 	    SvREFCNT_dec(sv);
 	}
     }
-    if ((key = AvARRAY(av) - AvALLOC(av))) {
-	AvMAX(av) += key;
-	SvPV_set(av, (char*)AvALLOC(av));
+    extra = AvARRAY(av) - AvALLOC(av);
+    if (extra) {
+	AvMAX(av) += extra;
+	AvARRAY(av) = AvALLOC(av);
     }
     AvFILLp(av) = -1;
 
@@ -468,17 +469,38 @@ Perl_av_undef(pTHX_ register AV *av)
 
     /* Give any tie a chance to cleanup first */
     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
-	av_fill(av, -1);   /* mg_clear() ? */
+	av_fill(av, -1);
 
     if (AvREAL(av)) {
 	register I32 key = AvFILLp(av) + 1;
 	while (key)
 	    SvREFCNT_dec(AvARRAY(av)[--key]);
     }
+
     Safefree(AvALLOC(av));
-    AvALLOC(av) = 0;
-    SvPV_set(av, (char*)0);
+    AvALLOC(av) = NULL;
+    AvARRAY(av) = NULL;
     AvMAX(av) = AvFILLp(av) = -1;
+
+    if(SvRMAGICAL(av)) mg_clear((SV*)av);
+}
+
+/*
+
+=for apidoc av_create_and_push
+
+Push an SV onto the end of the array, creating the array if necessary.
+A small internal helper function to remove a commonly duplicated idiom.
+
+=cut
+*/
+
+void
+Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
+{
+    if (!*avp)
+	*avp = newAV();
+    av_push(*avp, val);
 }
 
 /*
@@ -563,6 +585,26 @@ Perl_av_pop(pTHX_ register AV *av)
 }
 
 /*
+
+=for apidoc av_create_and_unshift_one
+
+Unshifts an SV onto the beginning of the array, creating the array if
+necessary.
+A small internal helper function to remove a commonly duplicated idiom.
+
+=cut
+*/
+
+SV **
+Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
+{
+    if (!*avp)
+	*avp = newAV();
+    av_unshift(*avp, 1);
+    return av_store(*avp, 0, val);
+}
+
+/*
 =for apidoc av_unshift
 
 Unshift the given number of C<undef> values onto the beginning of the
@@ -613,14 +655,13 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     
 	AvMAX(av) += i;
 	AvFILLp(av) += i;
-	SvPV_set(av, (char*)(AvARRAY(av) - i));
+	AvARRAY(av) = AvARRAY(av) - i;
     }
     if (num) {
 	register SV **ary;
-	I32 slide;
-	i = AvFILLp(av);
+	const I32 i = AvFILLp(av);
 	/* Create extra elements */
-	slide = i > 0 ? i : 0;
+	const I32 slide = i > 0 ? i : 0;
 	num += slide;
 	av_extend(av, i + num);
 	AvFILLp(av) += num;
@@ -632,7 +673,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 	/* Make extra elements into a buffer */
 	AvMAX(av) -= slide;
 	AvFILLp(av) -= slide;
-	SvPV_set(av, (char*)(AvARRAY(av) + slide));
+	AvARRAY(av) = AvARRAY(av) + slide;
     }
 }
 
@@ -676,7 +717,7 @@ Perl_av_shift(pTHX_ register AV *av)
     retval = *AvARRAY(av);
     if (AvREAL(av))
 	*AvARRAY(av) = &PL_sv_undef;
-    SvPV_set(av, (char*)(AvARRAY(av) + 1));
+    AvARRAY(av) = AvARRAY(av) + 1;
     AvMAX(av)--;
     AvFILLp(av)--;
     if (SvSMAGICAL(av))
@@ -687,8 +728,8 @@ Perl_av_shift(pTHX_ register AV *av)
 /*
 =for apidoc av_len
 
-Returns the highest index in the array.  Returns -1 if the array is
-empty.
+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.
 
 =cut
 */
@@ -703,9 +744,15 @@ Perl_av_len(pTHX_ register const AV *av)
 /*
 =for apidoc av_fill
 
-Ensure than an array has a given number of elements, equivalent to
+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
+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)>.
+
 =cut
 */
 void
@@ -769,6 +816,7 @@ and null is returned.
 SV *
 Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
 {
+    dVAR;
     SV *sv;
 
     assert(av);
@@ -856,6 +904,7 @@ C<&PL_sv_undef>.
 bool
 Perl_av_exists(pTHX_ AV *av, I32 key)
 {
+    dVAR;
     assert(av);
 
     if (SvRMAGICAL(av)) {