Silence compiler warnings on Win32/VC6

[p5sagit/p5-mst-13.2.git] / av.c

diff --git a/av.c b/av.c
index c6677a9..cf95d61 100644 (file)
--- 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.
@@ -27,7 +27,7 @@ Perl_av_reify(pTHX_ AV *av)
     dVAR;
     I32 key;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_REIFY;
 
     if (AvREAL(av))
        return;
@@ -66,7 +66,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     dVAR;
     MAGIC *mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_EXTEND;
 
     mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
     if (mg) {
@@ -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;
@@ -195,7 +195,7 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 {
     dVAR;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_FETCH;
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
@@ -278,7 +278,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     dVAR;
     SV** ary;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_STORE;
 
     /* S_regclass relies on being able to pass in a NULL sv
        (unicode_alternate may be NULL).
@@ -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;
-    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
@@ -385,10 +367,9 @@ 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()  */
+    PERL_ARGS_ASSERT_AV_MAKE;
     if (size) {                /* "defined" was returning undef for size==0 anyway. */
         register SV** ary;
         register I32 i;
@@ -421,7 +402,7 @@ Perl_av_clear(pTHX_ register AV *av)
     dVAR;
     I32 extra;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_CLEAR;
 #ifdef DEBUGGING
     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
        Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
@@ -432,8 +413,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;
@@ -469,21 +455,24 @@ 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;
 
     /* 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;
     AvARRAY(av) = NULL;
     AvMAX(av) = AvFILLp(av) = -1;
+
+    if(SvRMAGICAL(av)) mg_clear((SV*)av);
 }
 
 /*
@@ -499,6 +488,7 @@ 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);
@@ -518,7 +508,8 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 {             
     dVAR;
     MAGIC *mg;
-    assert(av);
+
+    PERL_ARGS_ASSERT_AV_PUSH;
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -556,7 +547,7 @@ Perl_av_pop(pTHX_ register AV *av)
     SV *retval;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_POP;
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -599,6 +590,7 @@ 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);
@@ -622,7 +614,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     register I32 i;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_UNSHIFT;
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -660,10 +652,9 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     }
     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;
@@ -694,7 +685,7 @@ Perl_av_shift(pTHX_ register AV *av)
     SV *retval;
     MAGIC* mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_SHIFT;
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -739,7 +730,7 @@ 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;
     return AvFILL(av);
 }
 
@@ -763,7 +754,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     dVAR;
     MAGIC *mg;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_FILL;
 
     if (fill < 0)
        fill = -1;
@@ -775,7 +766,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;
@@ -821,7 +812,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     dVAR;
     SV *sv;
 
-    assert(av);
+    PERL_ARGS_ASSERT_AV_DELETE;
 
     if (SvREADONLY(av))
        Perl_croak(aTHX_ PL_no_modify);
@@ -907,7 +898,7 @@ bool
 Perl_av_exists(pTHX_ AV *av, I32 key)
 {
     dVAR;
-    assert(av);
+    PERL_ARGS_ASSERT_AV_EXISTS;
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
@@ -958,12 +949,12 @@ 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;
 
-    assert(av);
+    PERL_ARGS_ASSERT_GET_AUX_MG;
 
     mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
 
@@ -974,9 +965,37 @@ 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);
+
+    PERL_ARGS_ASSERT_AV_ARYLEN_P;
+
     return &(mg->mg_obj);
 }
 
+IV *
+Perl_av_iter_p(pTHX_ AV *av) {
+    MAGIC *const mg = get_aux_mg(av);
+
+    PERL_ARGS_ASSERT_AV_ITER_P;
+
+#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