paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 11:38:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Set softfloat_rounding_mode indise SetRoundMode function for all CPUs.

Browse Source 
* SetRoundMode returns previous rounding mode value for all CPUs.

git-svn-id: trunk@48018 -
This commit is contained in:
pierre 2021-01-03 21:44:18 +00:00
parent 9592c033e5
commit 3362abb30c
14 changed files with 29 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/aarch64/mathu.inc
View File

@ -51,7 +51,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
rm2bits: array[TFPURoundingMode] of byte = (0,2,1,3);
begin
softfloat_rounding_mode:=RoundMode;
SetRoundMode:=RoundMode;
SetRoundMode:=GetRoundMode;
setfpcr((getfpcr and $ff3fffff) or (rm2bits[RoundMode] shl 22));
end;

3
rtl/arm/mathu.inc
View File

@ -62,9 +62,10 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
var
c: dword;
begin
softfloat_rounding_mode:=RoundMode;
Reslut:=GetRoundMode;
c:=Ord(RoundMode) shl 16;
c:=_controlfp(c, _MCW_RC);
Result:=TFPURoundingMode((c shr 16) and 3);
end;
function GetPrecisionMode: TFPUPrecisionMode;

1
rtl/i386/mathu.inc
View File

@ -147,6 +147,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
var
CtlWord: Word;
begin
softfloat_rounding_mode:=RoundMode;
CtlWord := Get8087CW;
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
if has_sse_support then

1
rtl/i8086/mathu.inc
View File

@ -155,6 +155,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
var
CtlWord: Word;
begin
softfloat_rounding_mode:=RoundMode;
CtlWord := Get8087CW;
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
{ if has_sse_support then

2
rtl/m68k/mathu.inc
View File

@ -137,10 +137,10 @@ const
var
FPCR: DWord;
begin
Result:=GetRoundMode;
FPCR:=GetFPCR and not FPU68K_ROUND_MASK;
SetFPCR(FPCR or FPCToFPURoundingMode[RoundMode]);
softfloat_rounding_mode:=RoundMode;
Result:=RoundMode;
end;
function GetPrecisionMode: TFPUPrecisionMode;

1
rtl/mips/mathu.inc
View File

@ -62,6 +62,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
begin
fsr:=get_fsr;
result:=fsr2roundmode[fsr and fpu_rounding_mask];
softfloat_rounding_mode:=RoundMode;
set_fsr((fsr and not fpu_rounding_mask) or roundmode2fsr[RoundMode]);
end;

2
rtl/powerpc/mathu.inc
View File

@ -101,12 +101,12 @@ begin
mode := FP_RND_RM;
end;
end;
result := GetRoundMode;
{$ifndef aix}
setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
{$else not aix}
fp_swap_rnd(mode);
{$endif not aix}
result := RoundMode;
end;

2
rtl/powerpc64/mathu.inc
View File

@ -109,12 +109,12 @@ begin
mode := FP_RND_RM;
end;
end;
result := GetRoundMode;
{$ifndef aix}
setFPSCR((getFPSCR and (not RoundModeMask)) or mode);
{$else not aix}
fp_swap_rnd(mode);
{$endif not aix}
result := RoundMode;
end;

2
rtl/riscv64/mathu.inc
View File

@ -50,7 +50,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
rm2bits : array[TFPURoundingMode] of byte = (0,2,3,1);
begin
softfloat_rounding_mode:=RoundMode;
SetRoundMode:=RoundMode;
SetRoundMode:=GetRoundMode;
setrm(rm2bits[RoundMode]);
end;

1
rtl/sparc/mathu.inc
View File

@ -32,6 +32,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
cw: dword;
begin
cw:=get_fsr;
softfloat_rounding_mode:=RoundMode;
result:=TFPURoundingMode(cw shr 30);
set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
end;

1
rtl/sparc64/mathu.inc
View File

@ -31,6 +31,7 @@ function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
cw: dword;
begin
cw:=get_fsr;
softfloat_rounding_mode:=RoundMode;
result:=TFPURoundingMode(cw shr 30);
set_fsr((cw and $3fffffff) or (rm2bits[RoundMode] shl 30));
end;

1
rtl/x86_64/mathu.inc
View File

@ -201,6 +201,7 @@ var
begin
CtlWord:=Get8087CW;
SSECSR:=GetMXCSR;
softfloat_rounding_mode:=RoundMode;
Set8087CW((CtlWord and $F3FF) or (Ord(RoundMode) shl 10));
SetMXCSR((SSECSR and $ffff9fff) or (dword(RoundMode) shl 13));
{$ifdef FPC_HAS_TYPE_EXTENDED}

1
rtl/xtensa/mathu.inc
View File

@ -20,6 +20,7 @@ function GetRoundMode: TFPURoundingMode;
function SetRoundMode(const RoundMode: TFPURoundingMode): TFPURoundingMode;
begin
SetRoundMode:=softfloat_rounding_mode;
softfloat_rounding_mode:=RoundMode;
end;

17
tests/test/units/math/trndcurr.pp
View File

@ -1,13 +1,20 @@
uses
Math;
const
failure_count : longint = 0;
first_error : longint = 0;
{$ifndef SKIP_CURRENCY_TEST}
procedure testround(const c, expected: currency; error: longint);
begin
if round(c)<>expected then
begin
writeln('round(',c,') = ',round(c),' instead of ', expected);
halt(error);
inc(failure_count);
if first_error=0 then
first_error:=error;
end;
end;
@ -31,7 +38,11 @@ begin
testround(-1.4,-1.0,154);
writeln('Rounding mode: rmUp');
SetRoundMode(rmUp);
if SetRoundMode(rmUp)<>rmNearest then
writeln('Warning: previous mode was not rmNearest');
if GetRoundMode <> rmUp then
begin
end;
testround(0.5,1.0,5);
testround(1.5,2.0,6);
testround(-0.5,0.0,7);
@ -75,4 +86,6 @@ begin
testround(-0.4,0.0,165);
testround(-1.4,-1.0,166);
{$endif}
if failure_count>0 then
halt(first_error);
end.