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 (file)
--- 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 (executable)
--- 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;