X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ce6f1cbce90e089336a9b1ef9c0f6a86b261d30d..3b6547f5bf85b73b309ae78aa34853ad20561fb6:/op.c

diff --git a/op.c b/op.c
index 9668905..ae5c6a8 100644
--- a/op.c
+++ b/op.c
@@ -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)));