TPF++ # http://www.perlfoundation.org/gc/grants/2006-perl5-improve.html

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 9580c64..ae5c6a8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -146,14 +146,14 @@ Perl_Slab_Free(pTHX_ void *op)
 }
 #endif
 /*
- * In the following definition, the ", NULL" is just to make the compiler
+ * In the following definition, the ", (OP*)0" is just to make the compiler
  * think the expression is of the right type: croak actually does a Siglongjmp.
  */
 #define CHECKOP(type,o) \
-    ((PL_op_mask && PL_op_mask[type])                                  \
+    ((PL_op_mask && PL_op_mask[type])                          \
      ? ( op_free((OP*)o),                                      \
         Perl_croak(aTHX_ "'%s' trapped by operation mask", PL_op_desc[type]),  \
-        NULL )                                         \
+        (OP*)0 )                                               \
      : CALL_FPTR(PL_check[type])(aTHX_ (OP*)o))
 
 #define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
@@ -272,24 +272,27 @@ Perl_op_free(pTHX_ OP *o)
 {
     dVAR;
     OPCODE type;
-    PADOFFSET refcnt;
 
     if (!o || o->op_static)
        return;
 
+    type = o->op_type;
     if (o->op_private & OPpREFCOUNTED) {
-       switch (o->op_type) {
+       switch (type) {
        case OP_LEAVESUB:
        case OP_LEAVESUBLV:
        case OP_LEAVEEVAL:
        case OP_LEAVE:
        case OP_SCOPE:
        case OP_LEAVEWRITE:
+           {
+           PADOFFSET refcnt;
            OP_REFCNT_LOCK;
            refcnt = OpREFCNT_dec(o);
            OP_REFCNT_UNLOCK;
            if (refcnt)
                return;
+           }
            break;
        default:
            break;
@@ -303,7 +306,6 @@ Perl_op_free(pTHX_ OP *o)
            op_free(kid);
        }
     }
-    type = o->op_type;
     if (type == OP_NULL)
        type = (OPCODE)o->op_targ;
 
@@ -462,11 +464,7 @@ S_cop_free(pTHX_ COP* cop)
        SvREFCNT_dec(cop->cop_warnings);
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
-#if 0
-       STRLEN len;
-        char *s = SvPV(cop->cop_io,len);
-       Perl_warn(aTHX_ "io='%.*s'",(int) len,s); /* ??? --jhi */
-#endif
+       /*EMPTY*/
 #else
        SvREFCNT_dec(cop->cop_io);
 #endif
@@ -489,6 +487,7 @@ void
 Perl_op_refcnt_lock(pTHX)
 {
     dVAR;
+    PERL_UNUSED_CONTEXT;
     OP_REFCNT_LOCK;
 }
 
@@ -496,6 +495,7 @@ void
 Perl_op_refcnt_unlock(pTHX)
 {
     dVAR;
+    PERL_UNUSED_CONTEXT;
     OP_REFCNT_UNLOCK;
 }
 
@@ -776,6 +776,8 @@ Perl_scalarvoid(pTHX_ OP *o)
        else {
            if (ckWARN(WARN_VOID)) {
                useless = "a constant";
+               if (o->op_private & OPpCONST_ARYBASE)
+                   useless = 0;
                /* don't warn on optimised away booleans, eg 
                 * use constant Foo, 5; Foo || print; */
                if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
@@ -1035,7 +1037,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        PL_modcount++;
        return o;
     case OP_CONST:
-       if (!(o->op_private & (OPpCONST_ARYBASE)))
+       if (!(o->op_private & OPpCONST_ARYBASE))
            goto nomod;
        localize = 0;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
@@ -1548,7 +1550,7 @@ S_dup_attrlist(pTHX_ OP *o)
      * are OP_CONST.  We need to push the OP_CONST values.
      */
     if (o->op_type == OP_CONST)
-       rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc(cSVOPo->op_sv));
+       rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc_NN(cSVOPo->op_sv));
     else {
        assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
        rop = NULL;
@@ -1556,7 +1558,7 @@ S_dup_attrlist(pTHX_ OP *o)
            if (o->op_type == OP_CONST)
                rop = append_elem(OP_LIST, rop,
                                  newSVOP(OP_CONST, o->op_flags,
-                                         SvREFCNT_inc(cSVOPo->op_sv)));
+                                         SvREFCNT_inc_NN(cSVOPo->op_sv)));
        }
     }
     return rop;
@@ -1580,7 +1582,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
        /* Don't force the C<use> if we don't need it. */
        SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
        if (svp && *svp != &PL_sv_undef)
-           ;           /* already in %INC */
+           /*EMPTY*/;          /* already in %INC */
        else
            Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                             newSVpvs(ATTRSMODULE), NULL);
@@ -1796,6 +1798,7 @@ Perl_my(pTHX_ OP *o)
 OP *
 Perl_sawparens(pTHX_ OP *o)
 {
+    PERL_UNUSED_CONTEXT;
     if (o)
        o->op_flags |= OPf_PARENS;
     return o;
@@ -1937,7 +1940,7 @@ S_newDEFSVOP(pTHX)
 {
     dVAR;
     const I32 offset = pad_findmy("$_");
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
     }
     else {
@@ -2003,7 +2006,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 #if 0
        list(o);
 #else
-       ;
+       /*EMPTY*/;
 #endif
     else {
        if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
@@ -2125,7 +2128,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     if (o->op_targ && sv == PAD_SV(o->op_targ))        /* grab pad temp? */
        pad_swipe(o->op_targ,  FALSE);
     else if (SvTEMP(sv)) {                     /* grab mortal temp? */
-       (void)SvREFCNT_inc(sv);
+       SvREFCNT_inc_simple_void(sv);
        SvTEMP_off(sv);
     }
     op_free(o);
@@ -2163,7 +2166,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
     o->op_opt = 0;             /* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
-    ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
+    ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(*PL_stack_sp--));
     op_free(curop);
     linklist(o);
     return list(o);
@@ -2630,8 +2633,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        Safefree(cPVOPo->op_pv);
        cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
        SvREFCNT_dec(listsv);
-       if (transv)
-           SvREFCNT_dec(transv);
+       SvREFCNT_dec(transv);
 
        if (!del && havefinal && rlen)
            (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
@@ -2640,10 +2642,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        if (grows)
            o->op_private |= OPpTRANS_GROWS;
 
-       if (tsave)
-           Safefree(tsave);
-       if (rsave)
-           Safefree(rsave);
+       Safefree(tsave);
+       Safefree(rsave);
 
        op_free(expr);
        op_free(repl);
@@ -2748,7 +2748,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
        sv_setiv(repointer,0);
     } else {
        SV * const repointer = newSViv(0);
-       av_push(PL_regex_padav,SvREFCNT_inc(repointer));
+       av_push(PL_regex_padav, SvREFCNT_inc_simple_NN(repointer));
        pmop->op_pmoffset = av_len(PL_regex_padav);
        PL_regex_pad = AvARRAY(PL_regex_padav);
     }
@@ -2926,7 +2926,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
                        repl_has_vars = 1;
                    }
                    else if (curop->op_type == OP_PUSHRE)
-                       ; /* Okay here, dangerous in newASSIGNOP */
+                       /*EMPTY*/; /* Okay here, dangerous in newASSIGNOP */
                    else
                        break;
                }
@@ -3014,9 +3014,9 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 #ifdef USE_ITHREADS
     if (gv)
        GvIN_PAD_on(gv);
-    return newPADOP(type, flags, SvREFCNT_inc(gv));
+    return newPADOP(type, flags, SvREFCNT_inc_simple(gv));
 #else
-    return newSVOP(type, flags, SvREFCNT_inc(gv));
+    return newSVOP(type, flags, SvREFCNT_inc_simple(gv));
 #endif
 }
 
@@ -3363,9 +3363,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
                    if (curop->op_type == OP_GV) {
                        GV *gv = cGVOPx_gv(curop);
-                       if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
+                       if (gv == PL_defgv
+                           || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                            break;
-                       SvCUR_set(gv, PL_generation);
+                       GvASSIGN_GENERATION_set(gv, PL_generation);
                    }
                    else if (curop->op_type == OP_PADSV ||
                             curop->op_type == OP_PADAV ||
@@ -3395,9 +3396,11 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 #else
                            GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
 #endif
-                           if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
+                           if (gv == PL_defgv
+                               || (int)GvASSIGN_GENERATION(gv) == PL_generation)
                                break;
-                           SvCUR_set(gv, PL_generation);
+                           GvASSIGN_GENERATION_set(gv, PL_generation);
+                           GvASSIGN_GENERATION_set(gv, PL_generation);
                        }
                    }
                    else
@@ -3464,7 +3467,9 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
        if (PL_eval_start)
            PL_eval_start = 0;
        else {
+           op_free(o);
            o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
+           o->op_private |= OPpCONST_ARYBASE;
        }
     }
     return o;
@@ -3980,7 +3985,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
     }
     else {
         const I32 offset = pad_findmy("$_");
-       if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+       if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
            sv = newGVOP(OP_GV, 0, PL_defgv);
        }
        else {
@@ -4265,15 +4270,15 @@ Perl_cv_undef(pTHX_ CV *cv)
 {
     dVAR;
 #ifdef USE_ITHREADS
-    if (CvFILE(cv) && !CvXSUB(cv)) {
+    if (CvFILE(cv) && !CvISXSUB(cv)) {
        /* for XSUBs CvFILE point directly to static memory; __FILE__ */
        Safefree(CvFILE(cv));
     }
     CvFILE(cv) = 0;
 #endif
 
-    if (!CvXSUB(cv) && CvROOT(cv)) {
-       if (CvDEPTH(cv))
+    if (!CvISXSUB(cv) && CvROOT(cv)) {
+       if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
            Perl_croak(aTHX_ "Can't undef active subroutine");
        ENTER;
 
@@ -4299,8 +4304,8 @@ Perl_cv_undef(pTHX_ CV *cv)
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
        CvCONST_off(cv);
     }
-    if (CvXSUB(cv)) {
-        CvXSUB(cv) = 0;
+    if (CvISXSUB(cv) && CvXSUB(cv)) {
+       CvXSUB(cv) = NULL;
     }
     /* delete all flags except WEAKOUTSIDE */
     CvFLAGS(cv) &= CVf_WEAKOUTSIDE;
@@ -4350,6 +4355,7 @@ L<perlsub/"Constant Functions">.
 SV *
 Perl_cv_const_sv(pTHX_ CV *cv)
 {
+    PERL_UNUSED_CONTEXT;
     if (!cv)
        return NULL;
     if (!(SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM))
@@ -4583,13 +4589,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     if (const_sv) {
-       (void)SvREFCNT_inc(const_sv);
+       SvREFCNT_inc_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
+           CvISXSUB_on(cv);
        }
        else {
            GvCV(gv) = NULL;
@@ -4920,6 +4927,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
     (void)gv_fetchfile(filename);
     CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
                                   an external constant string */
+    CvISXSUB_on(cv);
     CvXSUB(cv) = subaddr;
 
     if (name) {
@@ -5207,6 +5215,7 @@ OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
     const OP * const kid = cUNOPo->op_first;
+    PERL_UNUSED_CONTEXT;
     if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
            !(kUNOP->op_first->op_flags & OPf_MOD))
         o->op_flags |= OPf_STACKED;
@@ -5502,9 +5511,9 @@ Perl_ck_rvconst(pTHX_ register OP *o)
            kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
            SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
            GvIN_PAD_on(gv);
-           PAD_SETSV(kPADOP->op_padix, (SV*) SvREFCNT_inc(gv));
+           PAD_SETSV(kPADOP->op_padix, (SV*) SvREFCNT_inc_simple_NN(gv));
 #else
-           kid->op_sv = SvREFCNT_inc(gv);
+           kid->op_sv = SvREFCNT_inc_simple_NN(gv);
 #endif
            kid->op_private = 0;
            kid->op_ppaddr = PL_ppaddr[OP_GV];
@@ -5520,7 +5529,7 @@ Perl_ck_ftst(pTHX_ OP *o)
     const I32 type = o->op_type;
 
     if (o->op_flags & OPf_REF) {
-       /* nothing */
+       /*EMPTY*/;
     }
     else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
        SVOP * const kid = (SVOP*)cUNOPo->op_first;
@@ -5824,7 +5833,7 @@ Perl_ck_glob(pTHX_ OP *o)
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
        glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV);
        GvCV(gv) = GvCV(glob_gv);
-       (void)SvREFCNT_inc((SV*)GvCV(gv));
+       SvREFCNT_inc_void((SV*)GvCV(gv));
        GvIMPORTED_CV_on(gv);
        LEAVE;
     }
@@ -5897,7 +5906,7 @@ Perl_ck_grep(pTHX_ OP *o)
     gwop->op_other = LINKLIST(kid);
     kid->op_next = (OP*)gwop;
     offset = pad_findmy("$_");
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
        o->op_private = gwop->op_private = 0;
        gwop->op_targ = pad_alloc(type, SVs_PADTMP);
     }
@@ -6091,7 +6100,7 @@ Perl_ck_match(pTHX_ OP *o)
     dVAR;
     if (o->op_type != OP_QR && PL_compcv) {
        const I32 offset = pad_findmy("$_");
-       if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) {
+       if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
            o->op_targ = offset;
            o->op_private |= OPpTARGET_MY;
        }
@@ -6127,6 +6136,7 @@ Perl_ck_method(pTHX_ OP *o)
 OP *
 Perl_ck_null(pTHX_ OP *o)
 {
+    PERL_UNUSED_CONTEXT;
     return o;
 }
 
@@ -6761,6 +6771,7 @@ Perl_ck_subr(pTHX_ OP *o)
 OP *
 Perl_ck_svconst(pTHX_ OP *o)
 {
+    PERL_UNUSED_CONTEXT;
     SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }
@@ -7114,7 +7125,7 @@ Perl_peep(pTHX_ register OP *o)
            if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
                break;
            lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
-           if (!(SvFLAGS(lexname) & SVpad_TYPED))
+           if (!SvPAD_TYPED(lexname))
                break;
            fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
@@ -7163,7 +7174,7 @@ Perl_peep(pTHX_ register OP *o)
            }
                    
            lexname = *av_fetch(PL_comppad_name, rop->op_targ, TRUE);
-           if (!(SvFLAGS(lexname) & SVpad_TYPED))
+           if (!SvPAD_TYPED(lexname))
                break;
            fields = (GV**)hv_fetchs(SvSTASH(lexname), "FIELDS", FALSE);
            if (!fields || !GvHV(*fields))
@@ -7507,6 +7518,7 @@ const_sv_xsub(pTHX_ CV* cv)
     dVAR;
     dXSARGS;
     if (items != 0) {
+       /*EMPTY*/;
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));