X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=343274ff06dde9f4a044245229d3912e2c2b7c4a;hb=ac27d13b824657b726428f3a6a1d5b3a01df569e;hp=e4ab13a7d2aef7026f897f165d00ff3765253a16;hpb=977a499b5acccfc647611cff52bb8688f262ea5c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/av.c b/av.c
index e4ab13a..343274f 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, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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.
@@ -77,7 +77,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 	PUSHMARK(SP);
 	EXTEND(SP,2);
 	PUSHs(SvTIED_obj((SV*)av, mg));
-	PUSHs(sv_2mortal(newSViv(key+1)));
+	mPUSHi(key + 1);
         PUTBACK;
 	call_method("EXTEND", G_SCALAR|G_DISCARD);
 	POPSTACK;
@@ -95,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;
@@ -171,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;
 	}
     }
@@ -342,37 +342,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* const mg = SvMAGIC(av);
 	    sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
 	}
-	mg_set((SV*)av);
+	if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
+	    PL_delaymagic |= DM_ARRAY;
+	else
+	   mg_set((SV*)av);
     }
     return &ary[key];
 }
 
 /*
-=for apidoc newAV
-
-Creates a new AV.  The reference count is set to 1.
-
-=cut
-*/
-
-AV *
-Perl_newAV(pTHX)
-{
-    register AV * const av = (AV*)newSV(0);
-
-    sv_upgrade((SV *)av, SVt_PVAV);
-    /* sv_upgrade does AvREAL_only()  */
-    AvALLOC(av) = 0;
-    SvPV_set(av, NULL);
-    AvMAX(av) = AvFILLp(av) = -1;
-    return av;
-}
-
-/*
 =for apidoc av_make
 
 Creates a new AV and populates it with a list of SVs.  The SVs are copied
@@ -385,16 +367,14 @@ will have a reference count of 1.
 AV *
 Perl_av_make(pTHX_ register I32 size, register SV **strp)
 {
-    register AV * const av = (AV*)newSV(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);
+	AvARRAY(av) = ary;
 	AvFILLp(av) = AvMAX(av) = size - 1;
 	for (i = 0; i < size; i++) {
 	    assert (*strp);
@@ -432,8 +412,13 @@ Perl_av_clear(pTHX_ register AV *av)
 	Perl_croak(aTHX_ PL_no_modify);
 
     /* Give any tie a chance to cleanup first */
-    if (SvRMAGICAL(av))
-	mg_clear((SV*)av); 
+    if (SvRMAGICAL(av)) {
+	const MAGIC* const mg = SvMAGIC(av);
+	if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
+	    PL_delaymagic |= DM_ARRAY;
+        else
+	    mg_clear((SV*)av); 
+    }
 
     if (AvMAX(av) < 0)
 	return;
@@ -452,7 +437,7 @@ Perl_av_clear(pTHX_ register AV *av)
     extra = AvARRAY(av) - AvALLOC(av);
     if (extra) {
 	AvMAX(av) += extra;
-	SvPV_set(av, (char*)AvALLOC(av));
+	AvARRAY(av) = AvALLOC(av);
     }
     AvFILLp(av) = -1;
 
@@ -473,17 +458,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) = NULL;
-    SvPV_set(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);
 }
 
 /*
@@ -568,6 +574,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
@@ -618,14 +644,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;
@@ -637,7 +662,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;
     }
 }
 
@@ -681,7 +706,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))
@@ -737,7 +762,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 	PUSHMARK(SP);
 	EXTEND(SP,2);
 	PUSHs(SvTIED_obj((SV*)av, mg));
-	PUSHs(sv_2mortal(newSViv(fill+1)));
+	mPUSHi(fill + 1);
 	PUTBACK;
 	call_method("STORESIZE", G_SCALAR|G_DISCARD);
 	POPSTACK;
@@ -920,8 +945,8 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
 	return FALSE;
 }
 
-SV **
-Perl_av_arylen_p(pTHX_ AV *av) {
+MAGIC *
+S_get_aux_mg(pTHX_ AV *av) {
     dVAR;
     MAGIC *mg;
 
@@ -936,9 +961,31 @@ Perl_av_arylen_p(pTHX_ AV *av) {
 	/* sv_magicext won't set this for us because we pass in a NULL obj  */
 	mg->mg_flags |= MGf_REFCOUNTED;
     }
+    return mg;
+}
+
+SV **
+Perl_av_arylen_p(pTHX_ AV *av) {
+    MAGIC *const mg = get_aux_mg(av);
     return &(mg->mg_obj);
 }
 
+IV *
+Perl_av_iter_p(pTHX_ AV *av) {
+    MAGIC *const mg = get_aux_mg(av);
+#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;
+    }
+    return (IV *)mg->mg_ptr;
+#endif
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd