X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=6d6958993720d17adb0261a4fb51750bfc44dbf3;hb=37be2b3976e33708042402101fbafebc36dcb7a3;hp=5171e57569581031bad3039d37cd1fff9b91f15e;hpb=fe5bfecd71ca735f83568f7bc2b9f22cc82e3d61;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 5171e57..6d69589 100644
--- a/pp.c
+++ b/pp.c
@@ -416,7 +416,7 @@ PP(pp_prototype)
 		char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
 		if (code == -KEY_chop || code == -KEY_chomp
-			|| code == -KEY_exec || code == -KEY_system || code == -KEY_err)
+			|| code == -KEY_exec || code == -KEY_system)
 		    goto set;
 		if (code == -KEY_mkdir) {
 		    ret = sv_2mortal(newSVpvs("_;$"));
@@ -921,28 +921,30 @@ PP(pp_postdec)
 
 PP(pp_pow)
 {
-    dVAR; dSP; dATARGET;
+    dVAR; dSP; dATARGET; SV *svl, *svr;
 #ifdef PERL_PRESERVE_IVUV
     bool is_int = 0;
 #endif
     tryAMAGICbin(pow,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
 #ifdef PERL_PRESERVE_IVUV
     /* For integer to integer power, we do the calculation by hand wherever
        we're sure it is safe; otherwise we call pow() and try to convert to
        integer afterwards. */
     {
-	SvIV_please(TOPs);
-	if (SvIOK(TOPs)) {
-	    SvIV_please(TOPm1s);
-	    if (SvIOK(TOPm1s)) {
+	SvIV_please(svr);
+	if (SvIOK(svr)) {
+	    SvIV_please(svl);
+	    if (SvIOK(svl)) {
 		UV power;
 		bool baseuok;
 		UV baseuv;
 
-		if (SvUOK(TOPs)) {
-		    power = SvUVX(TOPs);
+		if (SvUOK(svr)) {
+		    power = SvUVX(svr);
 		} else {
-		    const IV iv = SvIVX(TOPs);
+		    const IV iv = SvIVX(svr);
 		    if (iv >= 0) {
 			power = iv;
 		    } else {
@@ -950,11 +952,11 @@ PP(pp_pow)
 		    }
 		}
 
-		baseuok = SvUOK(TOPm1s);
+		baseuok = SvUOK(svl);
 		if (baseuok) {
-		    baseuv = SvUVX(TOPm1s);
+		    baseuv = SvUVX(svl);
 		} else {
-		    const IV iv = SvIVX(TOPm1s);
+		    const IV iv = SvIVX(svl);
 		    if (iv >= 0) {
 			baseuv = iv;
 			baseuok = TRUE; /* effectively it's a UV now */
@@ -989,7 +991,7 @@ PP(pp_pow)
 		    }
                     SP--;
                     SETn( result );
-                    SvIV_please(TOPs);
+                    SvIV_please(svr);
                     RETURN;
 		} else {
 		    register unsigned int highbit = 8 * sizeof(UV);
@@ -1038,7 +1040,9 @@ PP(pp_pow)
   float_it:
 #endif    
     {
-	dPOPTOPnnrl;
+	NV right = SvNV(svr);
+	NV left  = SvNV(svl);
+	(void)POPs;
 
 #if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
     /*
@@ -1082,7 +1086,7 @@ PP(pp_pow)
 
 #ifdef PERL_PRESERVE_IVUV
 	if (is_int)
-	    SvIV_please(TOPs);
+	    SvIV_please(svr);
 #endif
 	RETURN;
     }
@@ -1090,18 +1094,21 @@ PP(pp_pow)
 
 PP(pp_multiply)
 {
-    dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+    dVAR; dSP; dATARGET; SV *svl, *svr;
+    tryAMAGICbin(mult,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
 #ifdef PERL_PRESERVE_IVUV
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
+    SvIV_please(svr);
+    if (SvIOK(svr)) {
 	/* Unless the left argument is integer in range we are going to have to
 	   use NV maths. Hence only attempt to coerce the right argument if
 	   we know the left is integer.  */
 	/* Left operand is defined, so is it IV? */
-	SvIV_please(TOPm1s);
-	if (SvIOK(TOPm1s)) {
-	    bool auvok = SvUOK(TOPm1s);
-	    bool buvok = SvUOK(TOPs);
+	SvIV_please(svl);
+	if (SvIOK(svl)) {
+	    bool auvok = SvUOK(svl);
+	    bool buvok = SvUOK(svr);
 	    const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
 	    const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
 	    UV alow;
@@ -1110,9 +1117,9 @@ PP(pp_multiply)
 	    UV bhigh;
 
 	    if (auvok) {
-		alow = SvUVX(TOPm1s);
+		alow = SvUVX(svl);
 	    } else {
-		const IV aiv = SvIVX(TOPm1s);
+		const IV aiv = SvIVX(svl);
 		if (aiv >= 0) {
 		    alow = aiv;
 		    auvok = TRUE; /* effectively it's a UV now */
@@ -1121,9 +1128,9 @@ PP(pp_multiply)
 		}
 	    }
 	    if (buvok) {
-		blow = SvUVX(TOPs);
+		blow = SvUVX(svr);
 	    } else {
-		const IV biv = SvIVX(TOPs);
+		const IV biv = SvIVX(svr);
 		if (biv >= 0) {
 		    blow = biv;
 		    buvok = TRUE; /* effectively it's a UV now */
@@ -1197,11 +1204,13 @@ PP(pp_multiply)
 		    }
 		} /* product_middle too large */
 	    } /* ahigh && bhigh */
-	} /* SvIOK(TOPm1s) */
-    } /* SvIOK(TOPs) */
+	} /* SvIOK(svl) */
+    } /* SvIOK(svr) */
 #endif
     {
-      dPOPTOPnnrl;
+      NV right = SvNV(svr);
+      NV left  = SvNV(svl);
+      (void)POPs;
       SETn( left * right );
       RETURN;
     }
@@ -1209,7 +1218,10 @@ PP(pp_multiply)
 
 PP(pp_divide)
 {
-    dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+    dVAR; dSP; dATARGET; SV *svl, *svr;
+    tryAMAGICbin(div,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
     /* Only try to do UV divide first
        if ((SLOPPYDIVIDE is true) or
            (PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
@@ -1232,20 +1244,20 @@ PP(pp_divide)
 #endif
 
 #ifdef PERL_TRY_UV_DIVIDE
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
-        SvIV_please(TOPm1s);
-        if (SvIOK(TOPm1s)) {
-            bool left_non_neg = SvUOK(TOPm1s);
-            bool right_non_neg = SvUOK(TOPs);
+    SvIV_please(svr);
+    if (SvIOK(svr)) {
+        SvIV_please(svl);
+        if (SvIOK(svl)) {
+            bool left_non_neg = SvUOK(svl);
+            bool right_non_neg = SvUOK(svr);
             UV left;
             UV right;
 
             if (right_non_neg) {
-                right = SvUVX(TOPs);
+                right = SvUVX(svr);
             }
 	    else {
-		const IV biv = SvIVX(TOPs);
+		const IV biv = SvIVX(svr);
                 if (biv >= 0) {
                     right = biv;
                     right_non_neg = TRUE; /* effectively it's a UV now */
@@ -1263,10 +1275,10 @@ PP(pp_divide)
                 DIE(aTHX_ "Illegal division by zero");
 
             if (left_non_neg) {
-                left = SvUVX(TOPm1s);
+                left = SvUVX(svl);
             }
 	    else {
-		const IV aiv = SvIVX(TOPm1s);
+		const IV aiv = SvIVX(svl);
                 if (aiv >= 0) {
                     left = aiv;
                     left_non_neg = TRUE; /* effectively it's a UV now */
@@ -1314,7 +1326,9 @@ PP(pp_divide)
     } /* right wasn't SvIOK */
 #endif /* PERL_TRY_UV_DIVIDE */
     {
-	dPOPPOPnnrl;
+	NV right = SvNV(svr);
+	NV left  = SvNV(svl);
+	(void)POPs;(void)POPs;
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
 	if (! Perl_isnan(right) && right == 0.0)
 #else
@@ -1338,14 +1352,15 @@ PP(pp_modulo)
 	bool dright_valid = FALSE;
 	NV dright = 0.0;
 	NV dleft  = 0.0;
-
-        SvIV_please(TOPs);
-        if (SvIOK(TOPs)) {
-            right_neg = !SvUOK(TOPs);
+        SV * svl;
+        SV * const svr = sv_2num(TOPs);
+        SvIV_please(svr);
+        if (SvIOK(svr)) {
+            right_neg = !SvUOK(svr);
             if (!right_neg) {
-                right = SvUVX(POPs);
+                right = SvUVX(svr);
             } else {
-		const IV biv = SvIVX(POPs);
+		const IV biv = SvIVX(svr);
                 if (biv >= 0) {
                     right = biv;
                     right_neg = FALSE; /* effectively it's a UV now */
@@ -1355,7 +1370,7 @@ PP(pp_modulo)
             }
         }
         else {
-	    dright = POPn;
+	    dright = SvNV(svr);
 	    right_neg = dright < 0;
 	    if (right_neg)
 		dright = -dright;
@@ -1366,18 +1381,20 @@ PP(pp_modulo)
                 use_double = TRUE;
             }
 	}
+	sp--;
 
         /* At this point use_double is only true if right is out of range for
            a UV.  In range NV has been rounded down to nearest UV and
            use_double false.  */
-        SvIV_please(TOPs);
-	if (!use_double && SvIOK(TOPs)) {
-            if (SvIOK(TOPs)) {
-                left_neg = !SvUOK(TOPs);
+        svl = sv_2num(TOPs);
+        SvIV_please(svl);
+	if (!use_double && SvIOK(svl)) {
+            if (SvIOK(svl)) {
+                left_neg = !SvUOK(svl);
                 if (!left_neg) {
-                    left = SvUVX(POPs);
+                    left = SvUVX(svl);
                 } else {
-		    const IV aiv = SvIVX(POPs);
+		    const IV aiv = SvIVX(svl);
                     if (aiv >= 0) {
                         left = aiv;
                         left_neg = FALSE; /* effectively it's a UV now */
@@ -1388,7 +1405,7 @@ PP(pp_modulo)
             }
         }
 	else {
-	    dleft = POPn;
+	    dleft = SvNV(svl);
 	    left_neg = dleft < 0;
 	    if (left_neg)
 		dleft = -dleft;
@@ -1416,6 +1433,7 @@ PP(pp_modulo)
                 }
             }
         }
+	sp--;
 	if (use_double) {
 	    NV dans;
 
@@ -1581,13 +1599,16 @@ PP(pp_repeat)
 
 PP(pp_subtract)
 {
-    dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
-    useleft = USE_LEFT(TOPm1s);
+    dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+    tryAMAGICbin(subtr,opASSIGN);
+    svl = sv_2num(TOPm1s);
+    svr = sv_2num(TOPs);
+    useleft = USE_LEFT(svl);
 #ifdef PERL_PRESERVE_IVUV
     /* See comments in pp_add (in pp_hot.c) about Overflow, and how
        "bad things" happen if you rely on signed integers wrapping.  */
-    SvIV_please(TOPs);
-    if (SvIOK(TOPs)) {
+    SvIV_please(svr);
+    if (SvIOK(svr)) {
 	/* Unless the left argument is integer in range we are going to have to
 	   use NV maths. Hence only attempt to coerce the right argument if
 	   we know the left is integer.  */
@@ -1601,12 +1622,12 @@ PP(pp_subtract)
 	    /* left operand is undef, treat as zero.  */
 	} else {
 	    /* Left operand is defined, so is it IV? */
-	    SvIV_please(TOPm1s);
-	    if (SvIOK(TOPm1s)) {
-		if ((auvok = SvUOK(TOPm1s)))
-		    auv = SvUVX(TOPm1s);
+	    SvIV_please(svl);
+	    if (SvIOK(svl)) {
+		if ((auvok = SvUOK(svl)))
+		    auv = SvUVX(svl);
 		else {
-		    register const IV aiv = SvIVX(TOPm1s);
+		    register const IV aiv = SvIVX(svl);
 		    if (aiv >= 0) {
 			auv = aiv;
 			auvok = 1;	/* Now acting as a sign flag.  */
@@ -1621,12 +1642,12 @@ PP(pp_subtract)
 	    bool result_good = 0;
 	    UV result;
 	    register UV buv;
-	    bool buvok = SvUOK(TOPs);
+	    bool buvok = SvUOK(svr);
 	
 	    if (buvok)
-		buv = SvUVX(TOPs);
+		buv = SvUVX(svr);
 	    else {
-		register const IV biv = SvIVX(TOPs);
+		register const IV biv = SvIVX(svr);
 		if (biv >= 0) {
 		    buv = biv;
 		    buvok = 1;
@@ -1683,15 +1704,16 @@ PP(pp_subtract)
 	}
     }
 #endif
-    useleft = USE_LEFT(TOPm1s);
     {
-	dPOPnv;
+	NV value = SvNV(svr);
+	(void)POPs;
+
 	if (!useleft) {
 	    /* left operand is undef, treat as zero - value */
 	    SETn(-value);
 	    RETURN;
 	}
-	SETn( TOPn - value );
+	SETn( SvNV(svl) - value );
 	RETURN;
     }
 }
@@ -2373,7 +2395,7 @@ PP(pp_negate)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(neg);
     {
-	dTOPss;
+	SV * const sv = sv_2num(TOPs);
 	const int flags = SvFLAGS(sv);
 	SvGETMAGIC(sv);
 	if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
@@ -2874,22 +2896,24 @@ PP(pp_int)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(int);
     {
-      const IV iv = TOPi; /* attempt to convert to IV if possible. */
+      SV * const sv = sv_2num(TOPs);
+      const IV iv = SvIV(sv);
       /* XXX it's arguable that compiler casting to IV might be subtly
 	 different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
 	 else preferring IV has introduced a subtle behaviour change bug. OTOH
 	 relying on floating point to be accurate is a bug.  */
 
-      if (!SvOK(TOPs))
+      if (!SvOK(sv)) {
         SETu(0);
-      else if (SvIOK(TOPs)) {
-	if (SvIsUV(TOPs)) {
-	    const UV uv = TOPu;
-	    SETu(uv);
-	} else
+      }
+      else if (SvIOK(sv)) {
+	if (SvIsUV(sv))
+	    SETu(SvUV(sv));
+	else
 	    SETi(iv);
-      } else {
-	  const NV value = TOPn;
+      }
+      else {
+	  const NV value = SvNV(sv);
 	  if (value >= 0.0) {
 	      if (value < (NV)UV_MAX + 0.5) {
 		  SETu(U_V(value));
@@ -2913,15 +2937,17 @@ PP(pp_abs)
 {
     dVAR; dSP; dTARGET; tryAMAGICun(abs);
     {
+      SV * const sv = sv_2num(TOPs);
       /* This will cache the NV value if string isn't actually integer  */
-      const IV iv = TOPi;
+      const IV iv = SvIV(sv);
 
-      if (!SvOK(TOPs))
+      if (!SvOK(sv)) {
         SETu(0);
-      else if (SvIOK(TOPs)) {
+      }
+      else if (SvIOK(sv)) {
 	/* IVX is precise  */
-	if (SvIsUV(TOPs)) {
-	  SETu(TOPu);	/* force it to be numeric only */
+	if (SvIsUV(sv)) {
+	  SETu(SvUV(sv));	/* force it to be numeric only */
 	} else {
 	  if (iv >= 0) {
 	    SETi(iv);
@@ -2936,7 +2962,7 @@ PP(pp_abs)
 	  }
 	}
       } else{
-	const NV value = TOPn;
+	const NV value = SvNV(sv);
 	if (value < 0.0)
 	  SETn(-value);
 	else
@@ -4420,12 +4446,17 @@ PP(pp_push)
 	PUSHi( AvFILL(ary) + 1 );
     }
     else {
+	PL_delaymagic = DM_DELAY;
 	for (++MARK; MARK <= SP; MARK++) {
 	    SV * const sv = newSV(0);
 	    if (*MARK)
 		sv_setsv(sv, *MARK);
 	    av_store(ary, AvFILLp(ary)+1, sv);
 	}
+	if (PL_delaymagic & DM_ARRAY)
+	    mg_set((SV*)ary);
+
+	PL_delaymagic = 0;
 	SP = ORIGMARK;
 	PUSHi( AvFILLp(ary) + 1 );
     }
@@ -4927,6 +4958,19 @@ PP(pp_split)
     RETURN;
 }
 
+PP(pp_once)
+{
+    dSP;
+    SV *const sv = PAD_SVl(PL_op->op_targ);
+
+    if (SvPADSTALE(sv)) {
+	/* First time. */
+	SvPADSTALE_off(sv);
+	RETURNOP(cLOGOP->op_other);
+    }
+    RETURNOP(cLOGOP->op_next);
+}
+
 PP(pp_lock)
 {
     dVAR;