X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=24af67eb63e5b42221ac9dec0594876d5e5c9fcd;hb=06c0cc96ebd866767a6d107ed78967600f7e0395;hp=8298026457b26a8b84d52d6d1e0db191d053b65d;hpb=f9bc45eff51a0e2fac1537ecee1124be910c832e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index 8298026..24af67e 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -100,7 +100,8 @@ PP(pp_and)
     if (!SvTRUE(TOPs))
 	RETURN;
     else {
-	--SP;
+        if (PL_op->op_type == OP_AND)
+	    --SP;
 	RETURNOP(cLOGOP->op_other);
     }
 }
@@ -169,8 +170,7 @@ PP(pp_concat)
     }
     else { /* TARG == left */
         STRLEN llen;
-	if (SvGMAGICAL(left))
-	    mg_get(left);		/* or mg_get(left) may happen here */
+	SvGETMAGIC(left);		/* or mg_get(left) may happen here */
 	if (!SvOK(TARG))
 	    sv_setpvn(left, "", 0);
 	(void)SvPV_nomg_const(left, llen);    /* Needed to set UTF8 flag */
@@ -320,44 +320,63 @@ PP(pp_or)
     if (SvTRUE(TOPs))
 	RETURN;
     else {
-	--SP;
+	if (PL_op->op_type == OP_OR)
+            --SP;
 	RETURNOP(cLOGOP->op_other);
     }
 }
 
-PP(pp_dor)
+PP(pp_defined)
 {
-    /* Most of this is lifted straight from pp_defined */
     dSP;
-    register SV* const sv = TOPs;
+    register SV* sv = NULL;
+    bool defined = FALSE;
+    const int op_type = PL_op->op_type;
+
+    if(op_type == OP_DOR || op_type == OP_DORASSIGN) {
+        sv = TOPs;
+        if (!sv || !SvANY(sv)) {
+	    if (op_type == OP_DOR)
+		--SP;
+            RETURNOP(cLOGOP->op_other);
+        }
+    } else if (op_type == OP_DEFINED) {
+        sv = POPs;
+        if (!sv || !SvANY(sv))
+            RETPUSHNO;
+    } else
+        DIE(aTHX_ "panic:  Invalid op (%s) in pp_defined()", OP_NAME(PL_op));
 
-    if (!sv || !SvANY(sv)) {
-	--SP;
-	RETURNOP(cLOGOP->op_other);
-    }
-    
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
 	if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-	    RETURN;
+	    defined = TRUE;
 	break;
     case SVt_PVHV:
 	if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-	    RETURN;
+	    defined = TRUE;
 	break;
     case SVt_PVCV:
 	if (CvROOT(sv) || CvXSUB(sv))
-	    RETURN;
+	    defined = TRUE;
 	break;
     default:
-	if (SvGMAGICAL(sv))
-	    mg_get(sv);
+	SvGETMAGIC(sv);
 	if (SvOK(sv))
-	    RETURN;
+	    defined = TRUE;
     }
     
-    --SP;
-    RETURNOP(cLOGOP->op_other);
+    if(op_type == OP_DOR || op_type == OP_DORASSIGN) {
+        if(defined) 
+            RETURN; 
+        if(op_type == OP_DOR)
+            --SP;
+        RETURNOP(cLOGOP->op_other);
+    }
+    /* assuming OP_DEFINED */
+    if(defined) 
+        RETPUSHYES;
+    RETPUSHNO;
 }
 
 PP(pp_add)
@@ -555,7 +574,7 @@ PP(pp_pushre)
      * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
      * will be enough to hold an OP*.
      */
-    SV* sv = sv_newmortal();
+    SV* const sv = sv_newmortal();
     sv_upgrade(sv, SVt_PVLV);
     LvTYPE(sv) = '/';
     Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
@@ -660,12 +679,12 @@ PP(pp_print)
 	}
     }
     SP = ORIGMARK;
-    PUSHs(&PL_sv_yes);
+    XPUSHs(&PL_sv_yes);
     RETURN;
 
   just_say_no:
     SP = ORIGMARK;
-    PUSHs(&PL_sv_undef);
+    XPUSHs(&PL_sv_undef);
     RETURN;
 }
 
@@ -775,7 +794,7 @@ PP(pp_rv2av)
 	if (SvRMAGICAL(av)) {
 	    U32 i;
 	    for (i=0; i < (U32)maxarg; i++) {
-		SV **svp = av_fetch(av, i, FALSE);
+		SV ** const svp = av_fetch(av, i, FALSE);
 		/* See note in pp_helem, and bug id #27839 */
 		SP[i+1] = svp
 		    ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
@@ -1161,9 +1180,9 @@ PP(pp_aassign)
 PP(pp_qr)
 {
     dSP;
-    register PMOP *pm = cPMOP;
-    SV *rv = sv_newmortal();
-    SV *sv = newSVrv(rv, "Regexp");
+    register PMOP * const pm = cPMOP;
+    SV * const rv = sv_newmortal();
+    SV * const sv = newSVrv(rv, "Regexp");
     if (pm->op_pmdynflags & PMdf_TAINTED)
         SvTAINTED_on(rv);
     sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
@@ -1175,8 +1194,8 @@ PP(pp_match)
     dSP; dTARG;
     register PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
-    const register char *t;
-    const register char *s;
+    register const char *t;
+    register const char *s;
     const char *strend;
     I32 global;
     I32 r_flags = REXEC_CHECKED;
@@ -1376,7 +1395,7 @@ yup:					/* Confirmed by INTUIT */
 	rx->subbeg = (char *) truebase;
 	rx->startp[0] = s - truebase;
 	if (RX_MATCH_UTF8(rx)) {
-	    char *t = (char*)utf8_hop((U8*)s, rx->minlen);
+	    char * const t = (char*)utf8_hop((U8*)s, rx->minlen);
 	    rx->endp[0] = t - truebase;
 	}
 	else {
@@ -1612,7 +1631,7 @@ Perl_do_readline(pTHX)
 	     const U8 *f;
 	     
 	     if (ckWARN(WARN_UTF8) &&
-		    !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+		    !is_utf8_string_loc(s, len, &f))
 		  /* Emulate :encoding(utf8) warning in the same case. */
 		  Perl_warner(aTHX_ packWARN(WARN_UTF8),
 			      "utf8 \"\\x%02X\" does not map to Unicode",
@@ -1869,11 +1888,8 @@ PP(pp_iter)
 	    RETPUSHNO;
 
 	if (SvMAGICAL(av) || AvREIFY(av)) {
-	    SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
-	    if (svp)
-		sv = *svp;
-	    else
-		sv = Nullsv;
+	    SV ** const svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+	    sv = svp ? *svp : Nullsv;
 	}
 	else {
 	    sv = AvARRAY(av)[cx->blk_loop.iterix--];
@@ -1885,11 +1901,8 @@ PP(pp_iter)
 	    RETPUSHNO;
 
 	if (SvMAGICAL(av) || AvREIFY(av)) {
-	    SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
-	    if (svp)
-		sv = *svp;
-	    else
-		sv = Nullsv;
+	    SV ** const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+	    sv = svp ? *svp : Nullsv;
 	}
 	else {
 	    sv = AvARRAY(av)[++cx->blk_loop.iterix];
@@ -1954,7 +1967,7 @@ PP(pp_subst)
     register REGEXP *rx = PM_GETRE(pm);
     STRLEN len;
     int force_on_match = 0;
-    I32 oldsave = PL_savestack_ix;
+    const I32 oldsave = PL_savestack_ix;
     STRLEN slen;
     bool doutf8 = FALSE;
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -2284,7 +2297,7 @@ PP(pp_grepwhile)
     /* All done yet? */
     if (PL_stack_base + *PL_markstack_ptr > SP) {
 	I32 items;
-	I32 gimme = GIMME_V;
+	const I32 gimme = GIMME_V;
 
 	LEAVE;					/* exit outer scope */
 	(void)POPMARK;				/* pop src */
@@ -2293,7 +2306,7 @@ PP(pp_grepwhile)
 	SP = PL_stack_base + POPMARK;		/* pop original mark */
 	if (gimme == G_SCALAR) {
 	    if (PL_op->op_private & OPpGREP_LEX) {
-		SV* sv = sv_newmortal();
+		SV* const sv = sv_newmortal();
 		sv_setiv(sv, items);
 		PUSHs(sv);
 	    }
@@ -2333,6 +2346,9 @@ PP(pp_leavesub)
     register PERL_CONTEXT *cx;
     SV *sv;
 
+    if (CxMULTICALL(&cxstack[cxstack_ix]))
+	return 0;
+
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
 
@@ -2393,6 +2409,9 @@ PP(pp_leavesublv)
     register PERL_CONTEXT *cx;
     SV *sv;
 
+    if (CxMULTICALL(&cxstack[cxstack_ix]))
+	return 0;
+
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
 
@@ -2546,7 +2565,7 @@ PP(pp_leavesublv)
 STATIC CV *
 S_get_db_sub(pTHX_ SV **svp, CV *cv)
 {
-    SV *dbsv = GvSVn(PL_DBsub);
+    SV * const dbsv = GvSVn(PL_DBsub);
 
     save_item(dbsv);
     if (!PERLDB_SUB_NN) {
@@ -2559,7 +2578,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 		    && (gv = (GV*)*svp) ))) {
 	    /* Use GV from the stack as a fallback. */
 	    /* GV is potentially non-unique, or contain different CV. */
-	    SV *tmp = newRV((SV*)cv);
+	    SV * const tmp = newRV((SV*)cv);
 	    sv_setsv(dbsv, tmp);
 	    SvREFCNT_dec(tmp);
 	}
@@ -2630,7 +2649,7 @@ PP(pp_entersub)
 	}
   got_rv:
 	{
-	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
+	    SV * const * sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
 	    tryAMAGICunDEREF(to_cv);
 	}	
 	cv = (CV*)SvRV(sv);
@@ -2668,7 +2687,7 @@ PP(pp_entersub)
 	/* This path taken at least 75% of the time   */
 	dMARK;
 	register I32 items = SP - MARK;
-	AV* padlist = CvPADLIST(cv);
+	AV* const padlist = CvPADLIST(cv);
 	PUSHBLOCK(cx, CXt_SUB, MARK);
 	PUSHSUB(cx);
 	cx->blk_sub.retop = PL_op->op_next;
@@ -2686,12 +2705,7 @@ PP(pp_entersub)
 	PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
 	if (hasargs)
 	{
-	    AV* av;
-#if 0
-	    DEBUG_S(PerlIO_printf(Perl_debug_log,
-	    			  "%p entersub preparing @_\n", thr));
-#endif
-	    av = (AV*)PAD_SVl(0);
+	    AV* const av = (AV*)PAD_SVl(0);
 	    if (AvREAL(av)) {
 		/* @_ is normally not REAL--this should only ever
 		 * happen when DB::sub() calls things that modify @_ */
@@ -2859,7 +2873,7 @@ PP(pp_aelem)
     SV** svp;
     SV* const elemsv = POPs;
     IV elem = SvIV(elemsv);
-    AV* av = (AV*)POPs;
+    AV* const av = (AV*)POPs;
     const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
     const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
     SV *sv;
@@ -2914,8 +2928,7 @@ PP(pp_aelem)
 void
 Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
 {
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (!SvOK(sv)) {
 	if (SvREADONLY(sv))
 	    Perl_croak(aTHX_ PL_no_modify);
@@ -2985,8 +2998,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     if (!sv)
 	Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
 
-    if (SvGMAGICAL(sv))
-	mg_get(sv);
+    SvGETMAGIC(sv);
     if (SvROK(sv))
 	ob = (SV*)SvRV(sv);
     else {