make opslot_slab an offset in current slab

[perl5.git] / av.c

diff --git a/av.c b/av.c
index 882be18..f10f124 100644 (file)
--- a/av.c
+++ b/av.c
@@ -89,7 +89,7 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
 
     if (key < -1) /* -1 is legal */
         Perl_croak(aTHX_
-            "panic: av_extend_guts() negative count (%"IVdf")", (IV)key);
+            "panic: av_extend_guts() negative count (%" IVdf ")", (IV)key);
 
     if (key > *maxp) {
        SV** ary;
@@ -140,17 +140,13 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
                             ? SSize_t_MAX : key + newmax;
              resize:
                {
-#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
-                   static const char oom_array_extend[] =
-                       "Out of memory during array extend";
-#endif
                     /* it should really be newmax+1 here, but if newmax
                      * happens to equal SSize_t_MAX, then newmax+1 is
                      * undefined. This means technically we croak one
                      * index lower than we should in theory; in practice
                      * its unlikely the system has SSize_t_MAX/sizeof(SV*)
                      * bytes to spare! */
-                   MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
+                   MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
                }
 #ifdef STRESS_REALLOC
                {
@@ -176,12 +172,8 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
            else {
                newmax = key < 3 ? 3 : key;
                {
-#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
-                   static const char oom_array_extend[] =
-                       "Out of memory during array extend";
-#endif
                     /* see comment above about newmax+1*/
-                   MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
+                   MEM_WRAP_CHECK_s(newmax, SV*, "Out of memory during array extend");
                }
                Newx(*allocp, newmax+1, SV*);
                ary = *allocp + 1;
@@ -364,8 +356,8 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
        }
        AvFILLp(av) = key;
     }
-    else if (AvREAL(av))
-       SvREFCNT_dec(ary[key]);
+    else if (AvREAL(av) && LIKELY(ary[key] != val))
+        SvREFCNT_dec(ary[key]);
     ary[key] = val;
     if (SvSMAGICAL(av)) {
        const MAGIC *mg = SvMAGIC(av);
@@ -409,13 +401,18 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)
     if (size) {                /* "defined" was returning undef for size==0 anyway. */
         SV** ary;
         SSize_t i;
+        SSize_t orig_ix;
+
        Newx(ary,size,SV*);
        AvALLOC(av) = ary;
        AvARRAY(av) = ary;
        AvMAX(av) = size - 1;
        AvFILLp(av) = -1;
-       ENTER;
-       SAVEFREESV(av);
+        /* avoid av being leaked if croak when calling magic below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = (SV*)av;
+        orig_ix = PL_tmps_ix;
+
        for (i = 0; i < size; i++) {
            assert (*strp);
 
@@ -430,8 +427,11 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)
                           SV_DO_COW_SVSETSV|SV_NOSTEAL);
            strp++;
        }
-       SvREFCNT_inc_simple_void_NN(av);
-       LEAVE;
+        /* disarm av's leak guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
     }
     return av;
 }
@@ -457,6 +457,7 @@ Perl_av_clear(pTHX_ AV *av)
 {
     SSize_t extra;
     bool real;
+    SSize_t orig_ix = 0;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
     assert(SvTYPE(av) == SVt_PVAV);
@@ -482,11 +483,15 @@ Perl_av_clear(pTHX_ AV *av)
     if (AvMAX(av) < 0)
        return;
 
-    if ((real = !!AvREAL(av))) {
+    if ((real = cBOOL(AvREAL(av)))) {
        SV** const ary = AvARRAY(av);
        SSize_t index = AvFILLp(av) + 1;
-       ENTER;
-       SAVEFREESV(SvREFCNT_inc_simple_NN(av));
+
+        /* avoid av being freed when calling destructors below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+        orig_ix = PL_tmps_ix;
+
        while (index) {
            SV * const sv = ary[--index];
            /* undef the slot before freeing the value, because a
@@ -501,7 +506,14 @@ Perl_av_clear(pTHX_ AV *av)
        AvARRAY(av) = AvALLOC(av);
     }
     AvFILLp(av) = -1;
-    if (real) LEAVE;
+    if (real) {
+        /* disarm av's premature free guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
+        SvREFCNT_dec_NN(av);
+    }
 }
 
 /*
@@ -522,6 +534,7 @@ void
 Perl_av_undef(pTHX_ AV *av)
 {
     bool real;
+    SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
 
     PERL_ARGS_ASSERT_AV_UNDEF;
     assert(SvTYPE(av) == SVt_PVAV);
@@ -530,10 +543,15 @@ Perl_av_undef(pTHX_ AV *av)
     if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) 
        av_fill(av, -1);
 
-    if ((real = !!AvREAL(av))) {
+    real = cBOOL(AvREAL(av));
+    if (real) {
        SSize_t key = AvFILLp(av) + 1;
-       ENTER;
-       SAVEFREESV(SvREFCNT_inc_simple_NN(av));
+
+        /* avoid av being freed when calling destructors below */
+        EXTEND_MORTAL(1);
+        PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av);
+        orig_ix = PL_tmps_ix;
+
        while (key)
            SvREFCNT_dec(AvARRAY(av)[--key]);
     }
@@ -544,7 +562,14 @@ Perl_av_undef(pTHX_ AV *av)
     AvMAX(av) = AvFILLp(av) = -1;
 
     if(SvRMAGICAL(av)) mg_clear(MUTABLE_SV(av));
-    if(real) LEAVE;
+    if (real) {
+        /* disarm av's premature free guard */
+        if (LIKELY(PL_tmps_ix == orig_ix))
+            PL_tmps_ix--;
+        else
+            PL_tmps_stack[orig_ix] = &PL_sv_undef;
+        SvREFCNT_dec_NN(av);
+    }
 }
 
 /*
@@ -982,6 +1007,9 @@ Perl_av_exists(pTHX_ AV *av, SSize_t key)
 
     if (key <= AvFILLp(av) && AvARRAY(av)[key])
     {
+       if (SvSMAGICAL(AvARRAY(av)[key])
+        && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem))
+           return FALSE;
        return TRUE;
     }
     else
@@ -1024,17 +1052,27 @@ Perl_av_iter_p(pTHX_ AV *av) {
     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;
+    if (sizeof(IV) == sizeof(SSize_t)) {
+       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;
     }
-    return (IV *)mg->mg_ptr;
-#endif
+}
+
+SV *
+Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) {
+    SV * const sv = newSV(0);
+    PERL_ARGS_ASSERT_AV_NONELEM;
+    if (!av_store(av,ix,sv))
+       return sv_2mortal(sv); /* has tie magic */
+    sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0);
+    return sv;
 }
 
 /*