X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=ae8cb6fdb88c2147ef2b95a40d6b1b14b9f11fab;hb=1cc8b4c566f7901a54e4b576f09608beb4c81f86;hp=658a89042a9979a00da886b41306705768bd7bd2;hpb=6de678708ca27d8ff9604030551fb53b27f5c5be;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 658a890..ae8cb6f 100644
--- a/pp.c
+++ b/pp.c
@@ -467,8 +467,8 @@ S_refto(pTHX_ SV *sv)
 	SvTEMP_off(sv);
 	(void)SvREFCNT_inc(sv);
     }
-    else if (SvPADTMP(sv))
-	sv = newSVsv(sv);
+    else if (SvPADTMP(sv) && !IS_PADGV(sv))
+        sv = newSVsv(sv);
     else {
 	SvTEMP_off(sv);
 	(void)SvREFCNT_inc(sv);
@@ -999,29 +999,111 @@ PP(pp_multiply)
 PP(pp_divide)
 {
     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
-    {
-      dPOPPOPnnrl;
-      NV value;
-      if (right == 0.0)
-	DIE(aTHX_ "Illegal division by zero");
+    /* 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
+            to preserve))
+       The assumption is that it is better to use floating point divide
+       whenever possible, only doing integer divide first if we can't be sure.
+       If NV_PRESERVES_UV is true then we know at compile time that no UV
+       can be too large to preserve, so don't need to compile the code to
+       test the size of UVs.  */
+
 #ifdef SLOPPYDIVIDE
-      /* insure that 20./5. == 4. */
-      {
-	IV k;
-	if ((NV)I_V(left)  == left &&
-	    (NV)I_V(right) == right &&
-	    (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
-	    value = k;
-	}
-	else {
-	    value = left / right;
-	}
-      }
+#  define PERL_TRY_UV_DIVIDE
+    /* ensure that 20./5. == 4. */
 #else
-      value = left / right;
+#  ifdef PERL_PRESERVE_IVUV
+#    ifndef NV_PRESERVES_UV
+#      define PERL_TRY_UV_DIVIDE
+#    endif
+#  endif
 #endif
-      PUSHn( value );
-      RETURN;
+
+#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);
+            UV left;
+            UV right;
+
+            if (right_non_neg) {
+                right = SvUVX(TOPs);
+            }
+	    else {
+                IV biv = SvIVX(TOPs);
+                if (biv >= 0) {
+                    right = biv;
+                    right_non_neg = TRUE; /* effectively it's a UV now */
+                }
+		else {
+                    right = -biv;
+                }
+            }
+            /* historically undef()/0 gives a "Use of uninitialized value"
+               warning before dieing, hence this test goes here.
+               If it were immediately before the second SvIV_please, then
+               DIE() would be invoked before left was even inspected, so
+               no inpsection would give no warning.  */
+            if (right == 0)
+                DIE(aTHX_ "Illegal division by zero");
+
+            if (left_non_neg) {
+                left = SvUVX(TOPm1s);
+            }
+	    else {
+                IV aiv = SvIVX(TOPm1s);
+                if (aiv >= 0) {
+                    left = aiv;
+                    left_non_neg = TRUE; /* effectively it's a UV now */
+                }
+		else {
+                    left = -aiv;
+                }
+            }
+
+            if (left >= right
+#ifdef SLOPPYDIVIDE
+                /* For sloppy divide we always attempt integer division.  */
+#else
+                /* Otherwise we only attempt it if either or both operands
+                   would not be preserved by an NV.  If both fit in NVs
+                   we fall through to the NV divide code below.  */
+                && ((left > ((UV)1 << NV_PRESERVES_UV_BITS))
+                    || (right > ((UV)1 << NV_PRESERVES_UV_BITS)))
+#endif
+                ) {
+                /* Integer division can't overflow, but it can be imprecise.  */
+                UV result = left / right;
+                if (result * right == left) {
+                    SP--; /* result is valid */
+                    if (left_non_neg == right_non_neg) {
+                        /* signs identical, result is positive.  */
+                        SETu( result );
+                        RETURN;
+                    }
+                    /* 2s complement assumption */
+                    if (result <= (UV)IV_MIN)
+                        SETi( -result );
+                    else {
+                        /* It's exact but too negative for IV. */
+                        SETn( -(NV)result );
+                    }
+                    RETURN;
+                } /* tried integer divide but it was not an integer result */
+            } /* else (abs(result) < 1.0) or (both UVs in range for NV) */
+        } /* left wasn't SvIOK */
+    } /* right wasn't SvIOK */
+#endif /* PERL_TRY_UV_DIVIDE */
+    {
+	dPOPPOPnnrl;
+	if (right == 0.0)
+	    DIE(aTHX_ "Illegal division by zero");
+	PUSHn( left / right );
+	RETURN;
     }
 }
 
@@ -1139,8 +1221,10 @@ PP(pp_repeat)
 	MEXTEND(MARK, max);
 	if (count > 1) {
 	    while (SP > MARK) {
-		if (*SP)
-		    SvTEMP_off((*SP));
+		if (*SP) {
+		    *SP = sv_2mortal(newSVsv(*SP));
+		    SvREADONLY_on(*SP);
+		}
 		SP--;
 	    }
 	    MARK++;
@@ -2931,6 +3015,8 @@ PP(pp_sprintf)
     dSP; dMARK; dORIGMARK; dTARGET;
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
+    if (DO_UTF8(*(MARK+1)))
+	SvUTF8_on(TARG);
     SP = ORIGMARK;
     PUSHTARG;
     RETURN;
@@ -3013,8 +3099,10 @@ PP(pp_ucfirst)
 	    SvTAINTED_on(sv);
 	    uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
 	}
-	else
-	    uv = toTITLE_utf8(s);
+	else {
+	    uv   = toTITLE_utf8(s);
+	    ulen = UNISKIP(uv);
+	}
 	
 	tend = uvchr_to_utf8(tmpbuf, uv);
 
@@ -3072,8 +3160,10 @@ PP(pp_lcfirst)
 	    SvTAINTED_on(sv);
 	    uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
 	}
-	else
-	    uv = toLOWER_utf8(s);
+	else {
+	    uv   = toLOWER_utf8(s);
+	    ulen = UNISKIP(uv);
+	}
 	
 	tend = uvchr_to_utf8(tmpbuf, uv);
 
@@ -4047,6 +4137,8 @@ PP(pp_split)
     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
 	     (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
 
+    PL_reg_sv_utf8 = do_utf8;
+
     if (pm->op_pmreplroot) {
 #ifdef USE_ITHREADS
 	ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
@@ -4055,11 +4147,11 @@ PP(pp_split)
 #endif
     }
     else if (gimme != G_ARRAY)
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 	ary = (AV*)PL_curpad[0];
 #else
 	ary = GvAVn(PL_defgv);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     else
 	ary = Nullav;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
@@ -4315,7 +4407,7 @@ PP(pp_split)
     RETPUSHUNDEF;
 }
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
 void
 Perl_unlock_condpair(pTHX_ void *svv)
 {
@@ -4332,16 +4424,21 @@ Perl_unlock_condpair(pTHX_ void *svv)
 			  PTR2UV(thr), PTR2UV(svv)));
     MUTEX_UNLOCK(MgMUTEXP(mg));
 }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
 PP(pp_lock)
 {
     dSP;
     dTOPss;
     SV *retsv = sv;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     sv_lock(sv);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
+#ifdef USE_ITHREADS
+    shared_sv *ssv = Perl_sharedsv_find(aTHX_ sv);
+    if(ssv)
+        Perl_sharedsv_lock(aTHX_ ssv);
+#endif /* USE_ITHREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
 	|| SvTYPE(retsv) == SVt_PVCV) {
 	retsv = refto(retsv);
@@ -4352,7 +4449,7 @@ PP(pp_lock)
 
 PP(pp_threadsv)
 {
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     dSP;
     EXTEND(SP, 1);
     if (PL_op->op_private & OPpLVAL_INTRO)
@@ -4362,5 +4459,5 @@ PP(pp_threadsv)
     RETURN;
 #else
     DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 }