From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Tue, 6 Apr 1999 01:40:36 +0000 (-0400)
Subject: Make % use fmod()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=787eafbd5502f34cb6300ce384514251ed273d04;p=p5sagit%2Fp5-mst-13.2.git

Make % use fmod()

	Message-ID: <19990406014035.A1238@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@3318
---

diff --git a/pp.c b/pp.c
index e6a2e11..8c0fba7 100644
--- a/pp.c
+++ b/pp.c
@@ -959,48 +959,99 @@ PP(pp_modulo)
 {
     djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
-      UV left;
-      UV right;
-      bool left_neg;
-      bool right_neg;
-      UV ans;
-
-      if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
-	IV i = SvIVX(POPs);
-	right = (right_neg = (i < 0)) ? -i : i;
-      }
-      else {
-	double n = POPn;
-	right = U_V((right_neg = (n < 0)) ? -n : n);
-      }
+	UV left;
+	UV right;
+	bool left_neg;
+	bool right_neg;
+	bool use_double = 0;
+	double dright;
+	double dleft;
+
+	if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+	    IV i = SvIVX(POPs);
+	    right = (right_neg = (i < 0)) ? -i : i;
+	}
+	else {
+	    dright = POPn;
+	    use_double = 1;
+	    right_neg = dright < 0;
+	    if (right_neg)
+		dright = -dright;
+	}
 
-      if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
-	IV i = SvIVX(POPs);
-	left = (left_neg = (i < 0)) ? -i : i;
-      }
-      else {
-	double n = POPn;
-	left = U_V((left_neg = (n < 0)) ? -n : n);
-      }
+	if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
+	    IV i = SvIVX(POPs);
+	    left = (left_neg = (i < 0)) ? -i : i;
+	}
+	else {
+	    dleft = POPn;
+	    if (!use_double) {
+	      use_double = 1;
+	      dright = right;
+	    }
+	    left_neg = dleft < 0;
+	    if (left_neg)
+		dleft = -dleft;
+	}
 
-      if (!right)
-	DIE("Illegal modulus zero");
+	if (use_double) {
+	    double dans;
 
-      ans = left % right;
-      if ((left_neg != right_neg) && ans)
-	ans = right - ans;
-      if (right_neg) {
-	/* XXX may warn: unary minus operator applied to unsigned type */
-	/* could change -foo to be (~foo)+1 instead	*/
-	if (ans <= ~((UV)IV_MAX)+1)
-	  sv_setiv(TARG, ~ans+1);
-	else
-	  sv_setnv(TARG, -(double)ans);
-      }
-      else
-	sv_setuv(TARG, ans);
-      PUSHTARG;
-      RETURN;
+#if 1
+	    /* Tried: DOUBLESIZE <= UV_SIZE = Precision of UV more than of NV.
+	     * But in fact this is an optimization - trunc may be slow */
+
+/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
+#  if CASTFLAGS & 2
+#    define CAST_D2UV(d) U_V(d)
+#  else
+#    define CAST_D2UV(d) ((UV)(d))
+#  endif
+
+	    if (dright <= UV_MAX && dleft <= UV_MAX) {
+		right = CAST_D2UV(dright);
+		left  = CAST_D2UV(dleft);
+		goto do_uv;
+	    }
+#endif
+
+	    /* Backward-compatibility clause: */
+	    dright = trunc(dright + 0.5);
+	    dleft  = trunc(dleft + 0.5);
+
+	    if (!dright)
+		DIE("Illegal modulus zero");
+
+	    dans = fmod(dleft, dright);
+	    if ((left_neg != right_neg) && dans)
+		dans = dright - dans;
+	    if (right_neg)
+		dans = -dans;
+	    sv_setnv(TARG, dans);
+	}
+	else {
+	    UV ans;
+
+	do_uv:
+	    if (!right)
+		DIE("Illegal modulus zero");
+
+	    ans = left % right;
+	    if ((left_neg != right_neg) && ans)
+		ans = right - ans;
+	    if (right_neg) {
+		/* XXX may warn: unary minus operator applied to unsigned type */
+		/* could change -foo to be (~foo)+1 instead	*/
+		if (ans <= ~((UV)IV_MAX)+1)
+		    sv_setiv(TARG, ~ans+1);
+		else
+		    sv_setnv(TARG, -(double)ans);
+	    }
+	    else
+		sv_setuv(TARG, ans);
+	}
+	PUSHTARG;
+	RETURN;
     }
 }
 
diff --git a/t/op/arith.t b/t/op/arith.t
index 43af807..f1bd827 100755
--- a/t/op/arith.t
+++ b/t/op/arith.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..4\n";
+print "1..8\n";
 
 sub try ($$) {
    print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
@@ -10,3 +10,7 @@ try 1,  13 %  4 ==  1;
 try 2, -13 %  4 ==  3;
 try 3,  13 % -4 == -3;
 try 4, -13 % -4 == -1;
+try 5, abs( 13e21 %  4e21 -  1e21) < 1e6;
+try 6, abs(-13e21 %  4e21 -  3e21) < 1e6;
+try 7, abs( 13e21 % -4e21 - -3e21) < 1e6;
+try 8, abs(-13e21 % -4e21 - -1e21) < 1e6;