From abd893cac41bc01ecd9f702f7dcd130ef5b5633a Mon Sep 17 00:00:00 2001 From: svenbarth Date: Fri, 4 May 2018 15:44:40 +0000 Subject: [PATCH] * fix for Mantis #33635: correctly working SSE2 based Frac() implementation by J. Gareth Moreton + added test git-svn-id: trunk@38903 - --- .gitattributes | 1 + rtl/x86_64/math.inc | 15 ++++-- tests/tbs/tb0643.pp | 121 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 132 insertions(+), 5 deletions(-) create mode 100644 tests/tbs/tb0643.pp diff --git a/.gitattributes b/.gitattributes index 29d3ad87e2..d99f64265d 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/x86_64/math.inc b/rtl/x86_64/math.inc index 50e3c1acad..6155f32911 100644 --- a/rtl/x86_64/math.inc +++ b/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} diff --git a/tests/tbs/tb0643.pp b/tests/tbs/tb0643.pp new file mode 100644 index 0000000000..754f7afa44 --- /dev/null +++ b/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.