From 50812415d8e990f448b7be4ca2c74a944befcf2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A1roly=20Balogh?= <karoly@freepascal.org>
Date: Mon, 19 Jun 2017 01:12:00 +0000
Subject: [PATCH] m68k: add a modified version of the generic fpc_round_real,
 which takes some m68k FPU oddities into account

git-svn-id: trunk@36531 -
---
 rtl/m68k/math.inc | 70 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

diff --git a/rtl/m68k/math.inc b/rtl/m68k/math.inc
index 43fb699303..c0783c04f3 100644
--- a/rtl/m68k/math.inc
+++ b/rtl/m68k/math.inc
@@ -19,3 +19,73 @@ begin
   result:=result - (qword(1) shl 52);
 end;
 {$endif FPC_INCLUDE_SOFTWARE_LONGWORD_TO_DOUBLE}
+
+{$if defined(FPU68881) or defined(FPUCOLDFIRE)}
+{$ifndef FPC_SYSTEM_HAS_ROUND}
+{$define FPC_SYSTEM_HAS_ROUND}
+    function fpc_round_real(d : ValReal) : int64;compilerproc;
+    type
+      float64 = record
+        high,low: longint;
+      end;
+    var
+      tmp: double;
+      j0: longint;
+      hx: longword;
+      sx: longint;
+    const
+      H2_52: array[0..1] of double = (
+        4.50359962737049600000e+15,
+       -4.50359962737049600000e+15
+      );
+    Begin
+      { This basically calculates trunc((d+2**52)-2**52) }
+      hx:=float64(d).high;
+      j0:=((hx shr 20) and $7ff) - $3ff;
+      sx:=hx shr 31;
+      hx:=(hx and $fffff) or $100000;
+
+      if j0>=52 then         { No fraction bits, already integer }
+        begin
+          if j0>=63 then     { Overflow, let trunc() raise an exception }
+            exit(trunc(d))   { and/or return +/-MaxInt64 if it's masked }
+          else
+            result:=((int64(hx) shl 32) or float64(d).low) shl (j0-52);
+        end
+      else
+        begin
+          { Rounding happens here. It is important that the expression is not
+            optimized by selecting a larger type to store 'tmp'. }
+
+          { The double cast should enforce a memory store and reload, which is the
+            fastest way on a 68881/2 to enforce the rounding to double precision.
+            The internal operation of the '88x is always in extended. If the rounding
+            of the FPU is set to a different precision in the FPCR, the result is a
+            a large performance penalty, according to the 68881/68882 Users Manual
+            Section 2.2.2. So we keep the FPU in extended, but this means the rounding
+            to double trick might conflict with tmp being a regvar. (KB) }
+{$ifdef FPU68881}
+          tmp:=double(float64(H2_52[sx]+d));
+{$else}
+          { The above doesn't affect the CF FPU. Its maximum precision is double. }
+          tmp:=H2_52[sx]+d;
+{$endif}
+          d:=tmp-H2_52[sx];
+          hx:=float64(d).high;
+          j0:=((hx shr 20) and $7ff)-$3ff;
+          hx:=(hx and $fffff) or $100000;
+          if j0<=20 then
+            begin
+              if j0<0 then
+                exit(0)
+              else           { more than 32 fraction bits, low dword discarded }
+                result:=hx shr (20-j0);
+            end
+          else
+            result:=(int64(hx) shl (j0-20)) or (float64(d).low shr (52-j0));
+        end;
+      if sx<>0 then
+        result:=-result;
+    end;
+{$endif FPC_SYSTEM_HAS_ROUND}
+{$endif defined(FPU68881) or defined(FPUCOLDFIRE)}