This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Additional floating point strictness is needed to get Intel cc to pass
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index 1cad444..3b52c20 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -74,10 +74,10 @@ in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 The SVs in the names AV have their PV being the name of the variable.
 NV+1..IV inclusive is a range of cop_seq numbers for which the name is
 valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
-type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> declarations in the
-same package can be detected).  SvCUR is sometimes hijacked to
-store the generation number during compilation.
+type.  For C<our> lexicals, the type is also SVt_PVGV, with the MAGIC slot
+pointing at the stash of the associated global (so that duplicate C<our>
+declarations in the same package can be detected).  SvCUR is sometimes
+hijacked to store the generation number during compilation.
 
 If SvFAKE is set on the name SV, then that slot in the frame AV is
 a REFCNT'ed reference to a lexical from "outside". In this case,
@@ -109,11 +109,17 @@ to be generated in evals, such as
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"
+#include "keywords.h"
 
 
 #define PAD_MAX 999999999
 
-
+#ifdef PERL_MAD
+void pad_peg(const char* s) {
+    static int pegcnt;
+    pegcnt++;
+}
+#endif
 
 /*
 =for apidoc pad_new
@@ -233,6 +239,7 @@ Perl_pad_undef(pTHX_ CV* cv)
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 
+    pad_peg("pad_undef");
     if (!padlist)
        return;
     if (SvIS_FREED(padlist)) /* may be during global destruction */
@@ -272,37 +279,35 @@ Perl_pad_undef(pTHX_ CV* cv)
                    SvREFCNT_dec(innercv);
                    inner_rc--;
                }
-               if (inner_rc /* in use, not just a prototype */
-                   && CvOUTSIDE(innercv) == cv)
-               {
+
+               /* in use, not just a prototype */
+               if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
                    assert(CvWEAKOUTSIDE(innercv));
                    /* don't relink to grandfather if he's being freed */
                    if (outercv && SvREFCNT(outercv)) {
                        CvWEAKOUTSIDE_off(innercv);
                        CvOUTSIDE(innercv) = outercv;
                        CvOUTSIDE_SEQ(innercv) = seq;
-                       (void)SvREFCNT_inc(outercv);
+                       SvREFCNT_inc_simple_void_NN(outercv);
                    }
                    else {
                        CvOUTSIDE(innercv) = NULL;
                    }
-
                }
-
            }
        }
     }
 
     ix = AvFILLp(padlist);
     while (ix >= 0) {
-       SV* const sv = AvARRAY(padlist)[ix--];
-       if (!sv)
-           continue;
-       if (sv == (SV*)PL_comppad_name)
-           PL_comppad_name = NULL;
-       else if (sv == (SV*)PL_comppad) {
-           PL_comppad = Null(PAD*);
-           PL_curpad = Null(SV**);
+       const SV* const sv = AvARRAY(padlist)[ix--];
+       if (sv) {
+           if (sv == (SV*)PL_comppad_name)
+               PL_comppad_name = NULL;
+           else if (sv == (SV*)PL_comppad) {
+               PL_comppad = NULL;
+               PL_curpad = NULL;
+           }
        }
        SvREFCNT_dec(sv);
     }
@@ -329,7 +334,7 @@ If fake, it means we're cloning an existing entry
 */
 
 PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
+Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
 {
     dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
@@ -338,17 +343,20 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
 
-    sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
+    sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
     sv_setpv(namesv, name);
 
     if (typestash) {
        SvPAD_TYPED_on(namesv);
-       SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
+       SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
     }
     if (ourstash) {
        SvPAD_OUR_on(namesv);
        OURSTASH_set(namesv, ourstash);
-       SvREFCNT_inc(ourstash);
+       SvREFCNT_inc_simple_void_NN(ourstash);
+    }
+    else if (state) {
+       SvPAD_STATE_on(namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
@@ -470,6 +478,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     dVAR;
     PADOFFSET ix;
     SV* const name = newSV(0);
+    pad_peg("add_anon");
     sv_upgrade(name, SVt_PVNV);
     sv_setpvn(name, "&", 1);
     SvIV_set(name, -1);
@@ -534,7 +543,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
                break; /* "our" masking "our" */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                "\"%s\" variable %s masks earlier declaration in same %s",
-               (is_our ? "our" : "my"),
+               (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"),
                name,
                (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
            --off;
@@ -586,9 +595,10 @@ Perl_pad_findmy(pTHX_ const char *name)
     const AV *nameav;
     SV **name_svp;
 
-    offset =  pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+    pad_peg("pad_findmy");
+    offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
                NULL, &out_sv, &out_flags);
-    if (offset != NOT_IN_PAD) 
+    if ((PADOFFSET)offset != NOT_IN_PAD) 
        return offset;
 
     /* look for an our that's being introduced; this allows
@@ -808,7 +818,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     if (!CvOUTSIDE(cv))
        return NOT_IN_PAD;
-    
+
     /* out_capture non-null means caller wants us to capture lex; in
      * addition we capture ourselves unless it's an ANON/format */
     new_capturep = out_capture ? out_capture :
@@ -816,9 +826,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
     offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
                new_capturep, out_name_sv, out_flags);
-    if (offset == NOT_IN_PAD)
+    if ((PADOFFSET)offset == NOT_IN_PAD)
        return NOT_IN_PAD;
-    
+
     /* found in an outer CV. Add appropriate fake entry to this pad */
 
     /* don't add new fake entries (via eval) to CVs that we have already
@@ -839,7 +849,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
            SvPAD_TYPED(*out_name_sv)
                    ? SvSTASH(*out_name_sv) : NULL,
            OURSTASH(*out_name_sv),
-           1  /* fake */
+           1,  /* fake */
+           0   /* not a state variable */
        );
 
        new_namesv = AvARRAY(PL_comppad_name)[new_offset];
@@ -847,7 +858,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
        SvNV_set(new_namesv, (NV)0);
        if (SvPAD_OUR(new_namesv)) {
-           /*EMPTY*/;   /* do nothing */
+           NOOP;   /* do nothing */
        }
        else if (CvLATE(cv)) {
            /* delayed creation - just note the offset within parent pad */
@@ -1025,7 +1036,8 @@ Perl_pad_leavemy(pTHX)
            if (sv && sv != &PL_sv_undef
                    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                                       "%"SVf" never introduced", sv);
+                           "%"SVf" never introduced",
+                           (void*)sv);
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -1455,7 +1467,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
     OP_REFCNT_UNLOCK;
     CvSTART(cv)                = CvSTART(proto);
-    CvOUTSIDE(cv)      = (CV*)SvREFCNT_inc(outside);
+    CvOUTSIDE(cv)      = (CV*)SvREFCNT_inc_simple(outside);
     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
@@ -1487,7 +1499,7 @@ Perl_cv_clone(pTHX_ CV *proto)
                }
                else {
                    assert(!SvPADSTALE(sv));
-                   sv = SvREFCNT_inc(sv);
+                   SvREFCNT_inc_simple_void_NN(sv);
                }
            }
            if (!sv) {
@@ -1504,7 +1516,7 @@ Perl_cv_clone(pTHX_ CV *proto)
            }
        }
        else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
-           sv = SvREFCNT_inc(ppad[ix]);
+           sv = SvREFCNT_inc_NN(ppad[ix]);
        }
        else {
            sv = newSV(0);
@@ -1591,10 +1603,7 @@ void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
     dVAR;
-    if (depth <= AvFILLp(padlist))
-       return;
-
-    {
+    if (depth > AvFILLp(padlist)) {
        SV** const svp = AvARRAY(padlist);
        AV* const newpad = newAV();
        SV** const oldpad = AvARRAY(svp[depth-1]);
@@ -1623,7 +1632,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                }
            }
            else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
-               av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
+               av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
            }
            else {
                /* save temporaries on recursion? */