From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 20 Dec 2007 19:49:50 +0000 (+0000)
Subject: Perl_newAV() can become a mathom by making newAV() a wrapper around
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac572bf4fde55cf563ae338dfe4e12b22ebc6d80;hp=82c0efa4e83781652347e2d8715e3fc7441c39d4;p=p5sagit%2Fp5-mst-13.2.git

Perl_newAV() can become a mathom by making newAV() a wrapper around
newSV_type() and tweaking Perl_sv_upgrade().

p4raw-id: //depot/perl@32675
---

diff --git a/av.c b/av.c
index 0d46117..116b7aa 100644
--- a/av.c
+++ b/av.c
@@ -355,25 +355,6 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 }
 
 /*
-=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_type(SVt_PVAV);
-    /* sv_upgrade does AvREAL_only()  */
-    AvALLOC(av) = 0;
-    AvARRAY(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
diff --git a/av.h b/av.h
index 06ecc7a..b3f56ff 100644
--- a/av.h
+++ b/av.h
@@ -116,6 +116,16 @@ Same as C<av_len()>.  Deprecated, use C<av_len()> instead.
 #define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES"
 
 /*
+=for apidoc newAV
+
+Creates a new AV.  The reference count is set to 1.
+
+=cut
+*/
+
+#define newAV()	((AV *)newSV_type(SVt_PVAV))
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
diff --git a/embed.fnc b/embed.fnc
index 4f7254b..256f80f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -565,7 +565,7 @@ ApM	|CV *	|newXS_flags	|NULLOK const char *name|NN XSUBADDR_t subaddr\
 				|NN const char *const filename \
 				|NULLOK const char *const proto|U32 flags
 Apd	|CV*	|newXS		|NULLOK const char* name|NN XSUBADDR_t f|NN const char* filename
-Apda	|AV*	|newAV
+Amdba	|AV*	|newAV
 Apa	|OP*	|newAVREF	|NN OP* o
 Apa	|OP*	|newBINOP	|I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
 Apa	|OP*	|newCVREF	|I32 flags|NULLOK OP* o
diff --git a/embed.h b/embed.h
index fd21f57..93c495c 100644
--- a/embed.h
+++ b/embed.h
@@ -552,7 +552,6 @@
 #define newSUB			Perl_newSUB
 #define newXS_flags		Perl_newXS_flags
 #define newXS			Perl_newXS
-#define newAV			Perl_newAV
 #define newAVREF		Perl_newAVREF
 #define newBINOP		Perl_newBINOP
 #define newCVREF		Perl_newCVREF
@@ -2846,7 +2845,6 @@
 #define newSUB(a,b,c,d)		Perl_newSUB(aTHX_ a,b,c,d)
 #define newXS_flags(a,b,c,d,e)	Perl_newXS_flags(aTHX_ a,b,c,d,e)
 #define newXS(a,b,c)		Perl_newXS(aTHX_ a,b,c)
-#define newAV()			Perl_newAV(aTHX)
 #define newAVREF(a)		Perl_newAVREF(aTHX_ a)
 #define newBINOP(a,b,c,d)	Perl_newBINOP(aTHX_ a,b,c,d)
 #define newCVREF(a,b)		Perl_newCVREF(aTHX_ a,b)
diff --git a/mathoms.c b/mathoms.c
index 59ffe09..3caab1b 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -66,7 +66,7 @@ PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
-
+PERL_CALLCONV AV * Perl_newAV(pTHX);
 
 /* ref() is now a macro using Perl_doref;
  * this version provided for binary compatibility only.
@@ -1328,6 +1328,16 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
+AV *
+Perl_newAV(pTHX)
+{
+    return (AV*)newSV_type(SVt_PVAV);
+    /* sv_upgrade does AvREAL_only():
+    AvALLOC(av) = 0;
+    AvARRAY(av) = NULL;
+    AvMAX(av) = AvFILLp(av) = -1; */
+}
+
 #endif /* NO_MATHOMS */
 
 /*
diff --git a/proto.h b/proto.h
index cdf0ecd..2642512 100644
--- a/proto.h
+++ b/proto.h
@@ -1508,9 +1508,9 @@ PERL_CALLCONV CV*	Perl_newXS(pTHX_ const char* name, XSUBADDR_t f, const char* f
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_3);
 
-PERL_CALLCONV AV*	Perl_newAV(pTHX)
+/* PERL_CALLCONV AV*	Perl_newAV(pTHX)
 			__attribute__malloc__
-			__attribute__warn_unused_result__;
+			__attribute__warn_unused_result__; */
 
 PERL_CALLCONV OP*	Perl_newAVREF(pTHX_ OP* o)
 			__attribute__malloc__
diff --git a/sv.c b/sv.c
index 718e305..eaaa726 100644
--- a/sv.c
+++ b/sv.c
@@ -1253,6 +1253,13 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 	    AvMAX(sv)	= -1;
 	    AvFILLp(sv)	= -1;
 	    AvREAL_only(sv);
+	    if (old_type >= SVt_RV) {
+		AvALLOC(sv) = 0;
+	    } else {
+		/* It will have been zeroed when the new body was allocated.
+		   Lets not write to it, in case it confuses a write-back
+		   cache.  */
+	    }
 	}
 
 	/* SVt_NULL isn't the only thing upgraded to AV or HV.