paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 07:34:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* apply patch from J. Gareth Moreton to implement Int() for SSE (currently only used on Win64)

Browse Source 
+ added test

git-svn-id: trunk@38993 -
This commit is contained in:
svenbarth 2018-05-14 21:08:04 +00:00
parent cd4eb4738c
commit 7990b2e3f3
3 changed files with 145 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11528,6 +11528,7 @@ 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/tb0644.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

15
rtl/x86_64/math.inc
View File

@ -356,6 +356,21 @@ const
{$else FPC_HAS_TYPE_EXTENDED}
{$ifndef FPC_SYSTEM_HAS_INT}
{$define FPC_SYSTEM_HAS_INT}
function fpc_int_real(d : ValReal) : ValReal;compilerproc; assembler; nostackframe;
asm
movq %xmm0, %rax
shr $48, %rax
and $0x7ff0,%ax
cmp $0x4330,%ax
jge .L0
cvttsd2si %xmm0, %rax
cvtsi2sd %rax, %xmm0
.L0:
end;
{$endif FPC_SYSTEM_HAS_INT}
{$ifndef FPC_SYSTEM_HAS_TRUNC}
{$define FPC_SYSTEM_HAS_TRUNC}
function fpc_trunc_real(d : ValReal) : int64;compilerproc; assembler; nostackframe;

129
tests/tbs/tb0644.pp Normal file
View File

@ -0,0 +1,129 @@
{ this test is geared towards Double values }
program tb0644;
{$mode objfpc}
uses
Math, sysutils;
type
TDataset = record
Value: Double;
AsIs: Double;
More: Double;
Less: Double;
Exc: Boolean;
end;
const
DataSet: array[0..23] of TDataset = (
(Value: 1.5; AsIs: 1; More: 2; Less: 1; Exc: False),
(Value: 0; AsIs: 0; More: 0; Less: 0; Exc: False),
(Value: 2251799813685248; AsIs: 2251799813685248; More: 2251799813685248; Less: 2251799813685247; Exc: False),
(Value: 4503599627370496; AsIs: 4503599627370496; More: 4503599627370496; Less: 4503599627370495; Exc: False),
(Value: 9223372036854775808.0; AsIs: 9223372036854775808.0; More: 9223372036854775808.0; Less: 9223372036854775808.0; Exc: False),
(Value: 9223372036854775809.0; AsIs: 9223372036854775809.0; More: 9223372036854775809.0; Less: 9223372036854775809.0; Exc: False),
(Value: 18446744073709551616.0; AsIs: 18446744073709551616.0; More: 18446744073709551616.0; Less: 18446744073709551616.0; Exc: False),
(Value: -9223372036854775808.0; AsIs: -9223372036854775808.0; More: -9223372036854775808.0; Less: -9223372036854775808.0; Exc: False),
(Value: -9223372036854775809.0; AsIs: -9223372036854775809.0; More: -9223372036854775809.0; Less: -9223372036854775809.0; Exc: False),
(Value: -18446744073709551616.0; AsIs: -18446744073709551616.0; More: -18446744073709551616.0; Less: -18446744073709551616.0; Exc: False),
(Value: 1E300; AsIs: 1E300; More: 1E300; Less: 1E300; Exc: False),
(Value: 0.125; AsIs: 0; More: 0; Less: 0; Exc: False),
(Value: 3.6415926535897932384626433832795; AsIs: 3; More: 4; Less: 3; Exc: False),
(Value: -1.5; AsIs: -1; More: -1; Less: -2; Exc: False),
(Value: -2251799813685248; AsIs: -2251799813685248; More: -2251799813685247; Less: -2251799813685248; Exc: False),
(Value: -4503599627370496; AsIs: -4503599627370496; More: -4503599627370495; Less: -4503599627370496; Exc: False),
(Value: -1E300; AsIs: -1E300; More: -1E300; Less: -1E300; Exc: False),
(Value: -0.125; AsIs: 0; More: 0; Less: 0; Exc: False),
(Value: -3.6415926535897932384626433832795; AsIs: -3; More: -3; Less: -4; Exc: False),
(Value: 1E1000; AsIs: 1E1000; More: 1E1000; Less: 1E1000; Exc: False),
(Value: -1E1000; AsIs: -1E1000; More: -1E1000; Less: -1E1000; Exc: False),
(Value: Infinity; AsIs: Infinity; More: Infinity; Less: Infinity; Exc: False),
(Value: NegInfinity; AsIs: NegInfinity; More: NegInfinity; Less: NegInfinity; Exc: False),
(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 := Int(ds.Value);
if not SameValue(v, ds.AsIs) then begin
Writeln('Int(', ds.Value, ') failed: expected ', ds.AsIs, ', but got ', v);
Halt(1);
end;
v := Int(ds.Value + 0.5);
if not SameValue(v, ds.More) then begin
Writeln('Int(', ds.Value, ' + 0.5) failed: expected ', ds.More, ', but got ', v);
Halt(2);
end;
v := Int(ds.Value - 0.5);
if not SameValue(v, ds.Less) then begin
Writeln('Int(', 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 := Int(ds.Value);
if not SameValue(v, ds.AsIs) then begin
Writeln('Int(', ds.Value, ') failed: expected ', ds.AsIs, ', but got ', v);
Halt(1);
end;
v := Int(ds.Value + 0.5);
if not SameValue(v, ds.More) then begin
Writeln('Int(', ds.Value, ' + 0.5) failed: expected ', ds.More, ', but got ', v);
Halt(2);
end;
v := Int(ds.Value - 0.5);
if not SameValue(v, ds.Less) then begin
Writeln('Int(', 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.