Cross-propagate changes between make_ext and make_ext_cross.

[perl5.git] / av.c

diff --git a/av.c b/av.c
index d528ffc..3d15d58 100644 (file)
--- a/av.c
+++ b/av.c
@@ -27,7 +27,8 @@ Perl_av_reify(pTHX_ AV *av)
     dVAR;
     I32 key;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_REIFY;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (AvREAL(av))
        return;
@@ -66,7 +67,8 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     dVAR;
     MAGIC *mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_EXTEND;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
     if (mg) {
@@ -77,7 +79,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;
@@ -117,8 +119,22 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
                IV itmp;
 #endif
 
-#ifdef MYMALLOC
-               newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
+#ifdef Perl_safesysmalloc_size
+               /* Whilst it would be quite possible to move this logic around
+                  (as I did in the SV code), so as to set AvMAX(av) early,
+                  based on calling Perl_safesysmalloc_size() immediately after
+                  allocation, I'm not convinced that it is a great idea here.
+                  In an array we have to loop round setting everything to
+                  &PL_sv_undef, which means writing to memory, potentially lots
+                  of it, whereas for the SV buffer case we don't touch the
+                  "bonus" memory. So there there is no cost in telling the
+                  world about it, whereas here we have to do work before we can
+                  tell the world about it, and that work involves writing to
+                  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)) /
+                   sizeof(SV*) - 1;
 
                if (key <= newmax) 
                    goto resized;
@@ -147,7 +163,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
                    Safefree(AvALLOC(av));
                AvALLOC(av) = ary;
 #endif
-#ifdef MYMALLOC
+#ifdef Perl_safesysmalloc_size
              resized:
 #endif
                ary = AvALLOC(av) + AvMAX(av) + 1;
@@ -195,7 +211,8 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 {
     dVAR;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_FETCH;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
@@ -278,7 +295,8 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     dVAR;
     SV** ary;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_STORE;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     /* S_regclass relies on being able to pass in a NULL sv
        (unicode_alternate may be NULL).
@@ -369,6 +387,9 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 {
     register AV * const av = (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;
@@ -401,7 +422,9 @@ Perl_av_clear(pTHX_ register AV *av)
     dVAR;
     I32 extra;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_CLEAR;
+    assert(SvTYPE(av) == SVt_PVAV);
+
 #ifdef DEBUGGING
     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
        Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
@@ -414,7 +437,7 @@ Perl_av_clear(pTHX_ register AV *av)
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
        const MAGIC* const mg = SvMAGIC(av);
-       if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
+       if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
            PL_delaymagic |= DM_ARRAY;
         else
            mg_clear((SV*)av); 
@@ -454,7 +477,8 @@ Undefines the array.  Frees the memory used by the array itself.
 void
 Perl_av_undef(pTHX_ register AV *av)
 {
-    assert(av);
+    PERL_ARGS_ASSERT_AV_UNDEF;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     /* Give any tie a chance to cleanup first */
     if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
@@ -487,6 +511,8 @@ A small internal helper function to remove a commonly duplicated idiom.
 void
 Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
 {
+    PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH;
+
     if (!*avp)
        *avp = newAV();
     av_push(*avp, val);
@@ -506,7 +532,9 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 {             
     dVAR;
     MAGIC *mg;
-    assert(av);
+
+    PERL_ARGS_ASSERT_AV_PUSH;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -544,7 +572,8 @@ Perl_av_pop(pTHX_ register AV *av)
     SV *retval;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_POP;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -587,6 +616,8 @@ A small internal helper function to remove a commonly duplicated idiom.
 SV **
 Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val)
 {
+    PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE;
+
     if (!*avp)
        *avp = newAV();
     av_unshift(*avp, 1);
@@ -610,7 +641,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     register I32 i;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_UNSHIFT;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -669,7 +701,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 /*
 =for apidoc av_shift
 
-Shifts an SV off the beginning of the array.
+Shifts an SV off the beginning of the array. Returns C<&PL_sv_undef> if the 
+array is empty.
 
 =cut
 */
@@ -681,7 +714,8 @@ Perl_av_shift(pTHX_ register AV *av)
     SV *retval;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_SHIFT;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -726,7 +760,9 @@ array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
 I32
 Perl_av_len(pTHX_ register const AV *av)
 {
-    assert(av);
+    PERL_ARGS_ASSERT_AV_LEN;
+    assert(SvTYPE(av) == SVt_PVAV);
+
     return AvFILL(av);
 }
 
@@ -750,7 +786,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     dVAR;
     MAGIC *mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_FILL;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (fill < 0)
        fill = -1;
@@ -762,7 +799,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;
@@ -808,7 +845,8 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     dVAR;
     SV *sv;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_DELETE;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -894,7 +932,8 @@ bool
 Perl_av_exists(pTHX_ AV *av, I32 key)
 {
     dVAR;
-    assert(av);
+    PERL_ARGS_ASSERT_AV_EXISTS;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
@@ -950,7 +989,8 @@ S_get_aux_mg(pTHX_ AV *av) {
     dVAR;
     MAGIC *mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_GET_AUX_MG;
+    assert(SvTYPE(av) == SVt_PVAV);
 
     mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
 
@@ -967,14 +1007,31 @@ S_get_aux_mg(pTHX_ AV *av) {
 SV **
 Perl_av_arylen_p(pTHX_ AV *av) {
     MAGIC *const mg = get_aux_mg(av);
+
+    PERL_ARGS_ASSERT_AV_ARYLEN_P;
+    assert(SvTYPE(av) == SVt_PVAV);
+
     return &(mg->mg_obj);
 }
 
-/* This will change to returning IV ** at some point soon */
-I32 *
+IV *
 Perl_av_iter_p(pTHX_ AV *av) {
     MAGIC *const mg = get_aux_mg(av);
-    return &(mg->mg_len);
+
+    PERL_ARGS_ASSERT_AV_ITER_P;
+    assert(SvTYPE(av) == SVt_PVAV);
+
+#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
 }
 
 /*