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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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.