* fix for Mantis #33635: correctly working SSE2 based Frac() implementation by J. Gareth Moreton

+ added test

git-svn-id: trunk@38903 -

.gitattributes

@@ -11522,6 +11522,7 @@ tests/tbs/tb0638.pp svneol=native#text/pascal
 tests/tbs/tb0639.pp svneol=native#text/pascal
 tests/tbs/tb0641.pp svneol=native#text/pascal
 tests/tbs/tb0642.pp svneol=native#text/pascal
+tests/tbs/tb0643.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain

rtl/x86_64/math.inc

@@ -372,18 +372,23 @@ const
       end;
     {$endif FPC_SYSTEM_HAS_ROUND}
 
-    {$ifdef ENABLE_RESTRICTED_SSE_FRAC}
     {$ifndef FPC_SYSTEM_HAS_FRAC}
     {$define FPC_SYSTEM_HAS_FRAC}
     function fpc_frac_real(d: ValReal) : ValReal;compilerproc; assembler; nostackframe;
       asm
-        cvttsd2si   %xmm0,%rax
         { Windows defines %xmm4 and %xmm5 as first non-parameter volatile registers;
           on SYSV systems all are considered as such, so use %xmm4 }
-        cvtsi2sd    %rax,%xmm4
-        subsd       %xmm4,%xmm0
+        movq      %xmm0,  %rax
+        movapd    %xmm0,  %xmm4
+        shr       $48,    %rax
+        and       $0x7ff0,%ax
+        cmp       $0x4330,%ax
+        jge       .L0
+        cvttsd2si %xmm0,  %rax
+        cvtsi2sd  %rax,   %xmm4
+  .L0:
+        subsd     %xmm4,  %xmm0
       end;
     {$endif FPC_SYSTEM_HAS_FRAC}
-    {$endif ENABLE_RESTRICTED_SSE_FRAC}
 
 {$endif FPC_HAS_TYPE_EXTENDED}

tests/tbs/tb0643.pp

@@ -0,0 +1,121 @@
+{ this test is geared towards Double values }
+
+program tb0643;
+
+{$mode objfpc}
+
+uses
+  Math, sysutils;
+
+type
+  TDataset = record
+    Value: Double;
+    AsIs: Double;
+    More: Double;
+    Less: Double;
+    Exc: Boolean;
+  end;
+
+var
+  DataSet: array[0..15] of TDataset = (
+    (Value: 1.5;              AsIs: 0.5;   More: 0;     Less: 0;        Exc: False),
+    (Value: 0;                AsIs: 0;     More: 0.5;   Less: -0.5;     Exc: False),
+    (Value: 2251799813685248; AsIs: 0;     More: 0.5;   Less: 0.5;      Exc: False),
+    (Value: 4503599627370496; AsIs: 0;     More: 0;     Less: 0.5;      Exc: False),
+    (Value: 1E300;            AsIs: 0;     More: 0;     Less: 0;        Exc: False),
+    (Value: 0.125;            AsIs: 0.125; More: 0.625; Less: -0.375;   Exc: False),
+    (Value: 3.6415926535897932384626433832795; AsIs: 0.64159265358979312; More: 0.14159265358979312; Less: 0.14159265358979312; Exc: False),
+    (Value: -1.5;              AsIs: -0.5;   More: 0;     Less: 0;      Exc: False),
+    (Value: -2251799813685248; AsIs: 0;      More: -0.5;  Less: -0.5;   Exc: False),
+    (Value: -4503599627370496; AsIs: 0;      More: -0.5;  Less: 0;      Exc: False),
+    (Value: -1E300;            AsIs: 0;      More: 0;     Less: 0;      Exc: False),
+    (Value: -0.125;            AsIs: -0.125; More: 0.375; Less: -0.625; Exc: False),
+    (Value: -3.6415926535897932384626433832795; AsIs: -0.64159265358979312; More: -0.14159265358979312; Less: -0.14159265358979312; Exc: False),
+    (Value: Infinity;          AsIs: NaN;    More: NaN;   Less: NaN;    Exc: True),
+    (Value: NegInfinity;       AsIs: NaN;    More: NaN;   Less: NaN;    Exc: True),
+    (Value: NaN;               AsIs: NaN;    More: NaN;   Less: NaN;    Exc: False)
+  );
+
+function SameValue(aGot, aExpected: Double): Boolean;
+begin
+  if IsNan(aExpected) then
+    Result := IsNan(aGot)
+  else
+    Result := aGot = aExpected;
+end;
+
+var
+  ds: TDataSet;
+  v: Double;
+  hadexc: Boolean;
+  orgmask: TFPUExceptionMask;
+begin
+{$if defined(FPC_HAS_TYPE_EXTENDED) or not defined(FPC_HAS_TYPE_DOUBLE)}
+  { we rely on the floating point values to be doubles, so only test on systems
+    that use double as their largest type }
+  Exit;
+{$endif}
+
+  orgmask := GetExceptionMask;
+
+  Writeln('Testing with exceptions disabled');
+  SetExceptionMask(orgmask + [exPrecision, exInvalidOp]);
+  for ds in DataSet do begin
+    Writeln('Testing value ', ds.Value);
+    v := Frac(ds.Value);
+    if not SameValue(v, ds.AsIs) then begin
+      Writeln('Frac(', ds.Value, ') failed: expected ', ds.AsIs, ', but got ', v);
+      Halt(1);
+    end;
+    v := Frac(ds.Value + 0.5);
+    if not SameValue(v, ds.More) then begin
+      Writeln('Frac(', ds.Value, ' + 0.5) failed: expected ', ds.More, ', but got ', v);
+      Halt(2);
+    end;
+    v := Frac(ds.Value - 0.5);
+    if not SameValue(v, ds.Less) then begin
+      Writeln('Frac(', ds.Value, ' - 0.5) failed: expected ', ds.Less, ', but got ', v);
+      Halt(3);
+    end;
+  end;
+
+  Writeln('Testing with exceptions enabled');
+  SetExceptionMask(orgmask);
+
+  for ds in DataSet do begin
+    hadexc := False;
+    try
+      Writeln('Testing value ', ds.Value);
+      v := Frac(ds.Value);
+      if not SameValue(v, ds.AsIs) then begin
+        Writeln('Frac(', ds.Value, ') failed: expected ', ds.AsIs, ', but got ', v);
+        Halt(1);
+      end;
+      v := Frac(ds.Value + 0.5);
+      if not SameValue(v, ds.More) then begin
+        Writeln('Frac(', ds.Value, ' + 0.5) failed: expected ', ds.More, ', but got ', v);
+        Halt(2);
+      end;
+      v := Frac(ds.Value - 0.5);
+      if not SameValue(v, ds.Less) then begin
+        Writeln('Frac(', ds.Value, ' - 0.5) failed: expected ', ds.Less, ', but got ', v);
+        Halt(3);
+      end;
+    except
+      on e: EMathError do begin
+        if ds.Exc then begin
+          Writeln('Got expected exception for value ', ds.Value);
+          hadexc := True;
+        end else
+          Writeln('Unexpected math exception for value ', ds.Value, ': ', e.Message);
+      end else
+        Writeln('Unexpected exception for value ', ds.Value, ': ', ExceptObject.ClassName);
+    end;
+    if ds.Exc and not hadexc then begin
+      Writeln('Exception expected, but none caught');
+      Halt(4);
+    end;
+  end;
+
+  Writeln('ok');
+end.