mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-01 22:30:30 +02:00
+ Implemented IEEE 754-compliant checking for unordered results of floating-point compares on x86 targets. Mantis #9362.
git-svn-id: trunk@27581 -
This commit is contained in:
sergei
parent
5eae80ebb0
commit
07e90aaa24
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -12316,6 +12316,7 @@ tests/test/units/fpwidestring/twide2fpwidestring.pp svneol=native#text/pascal
|
||||
tests/test/units/fpwidestring/twide6fpwidestring.pp svneol=native#text/pascal
|
||||
tests/test/units/fpwidestring/twide7fpwidestring.pp svneol=native#text/pascal
|
||||
tests/test/units/lineinfo/tlininfo.pp svneol=native#text/plain
|
||||
tests/test/units/math/tcmpnan.pp svneol=native#text/plain
|
||||
tests/test/units/math/tdivmod.pp svneol=native#text/plain
|
||||
tests/test/units/math/tmask.inc svneol=native#text/plain
|
||||
tests/test/units/math/tmask.pp svneol=native#text/plain
|
||||
|
||||
@ -2116,23 +2116,75 @@ unit cgx86;
|
||||
procedure tcgx86.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
|
||||
var
|
||||
ai : taicpu;
|
||||
hl : tasmlabel;
|
||||
f2 : tresflags;
|
||||
begin
|
||||
hl:=nil;
|
||||
f2:=f;
|
||||
case f of
|
||||
F_FNE:
|
||||
begin
|
||||
ai:=Taicpu.op_sym(A_Jcc,S_NO,l);
|
||||
ai.SetCondition(C_P);
|
||||
ai.is_jmp:=true;
|
||||
list.concat(ai);
|
||||
f2:=F_NE;
|
||||
end;
|
||||
F_FE,F_FA,F_FAE,F_FB,F_FBE:
|
||||
begin
|
||||
{ JP before JA/JAE is redundant, but it must be generated here
|
||||
and left for peephole optimizer to remove. }
|
||||
current_asmdata.getjumplabel(hl);
|
||||
ai:=Taicpu.op_sym(A_Jcc,S_NO,hl);
|
||||
ai.SetCondition(C_P);
|
||||
ai.is_jmp:=true;
|
||||
list.concat(ai);
|
||||
f2:=FPUFlags2Flags[f];
|
||||
end;
|
||||
end;
|
||||
ai := Taicpu.op_sym(A_Jcc,S_NO,l);
|
||||
ai.SetCondition(flags_to_cond(f));
|
||||
ai.SetCondition(flags_to_cond(f2));
|
||||
ai.is_jmp := true;
|
||||
list.concat(ai);
|
||||
if assigned(hl) then
|
||||
a_label(list,hl);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgx86.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
|
||||
var
|
||||
ai : taicpu;
|
||||
hreg : tregister;
|
||||
f2 : tresflags;
|
||||
hreg,hreg2 : tregister;
|
||||
op: tasmop;
|
||||
begin
|
||||
hreg2:=NR_NO;
|
||||
op:=A_AND;
|
||||
f2:=f;
|
||||
case f of
|
||||
F_FE,F_FNE,F_FB,F_FBE:
|
||||
begin
|
||||
hreg2:=getintregister(list,OS_8);
|
||||
ai:=Taicpu.op_reg(A_SETcc,S_B,hreg2);
|
||||
if (f=F_FNE) then { F_FNE means "PF or (not ZF)" }
|
||||
begin
|
||||
ai.setcondition(C_P);
|
||||
op:=A_OR;
|
||||
end
|
||||
else
|
||||
ai.setcondition(C_NP);
|
||||
list.concat(ai);
|
||||
f2:=FPUFlags2Flags[f];
|
||||
end;
|
||||
F_FA,F_FAE: { These do not need PF check }
|
||||
f2:=FPUFlags2Flags[f];
|
||||
end;
|
||||
hreg:=makeregsize(list,reg,OS_8);
|
||||
ai:=Taicpu.op_reg(A_SETcc,S_B,hreg);
|
||||
ai.setcondition(flags_to_cond(f));
|
||||
ai.setcondition(flags_to_cond(f2));
|
||||
list.concat(ai);
|
||||
if (hreg2<>NR_NO) then
|
||||
list.concat(taicpu.op_reg_reg(op,S_B,hreg2,hreg));
|
||||
if reg<>hreg then
|
||||
a_load_reg_reg(list,OS_8,size,hreg,reg);
|
||||
end;
|
||||
@ -2142,13 +2194,24 @@ unit cgx86;
|
||||
var
|
||||
ai : taicpu;
|
||||
tmpref : treference;
|
||||
f2 : tresflags;
|
||||
begin
|
||||
f2:=f;
|
||||
case f of
|
||||
F_FE,F_FNE,F_FB,F_FBE:
|
||||
begin
|
||||
inherited g_flags2ref(list,size,f,ref);
|
||||
exit;
|
||||
end;
|
||||
F_FA,F_FAE:
|
||||
f2:=FPUFlags2Flags[f];
|
||||
end;
|
||||
tmpref:=ref;
|
||||
make_simple_ref(list,tmpref);
|
||||
if not(size in [OS_8,OS_S8]) then
|
||||
a_load_const_ref(list,size,0,tmpref);
|
||||
ai:=Taicpu.op_ref(A_SETcc,S_B,tmpref);
|
||||
ai.setcondition(flags_to_cond(f));
|
||||
ai.setcondition(flags_to_cond(f2));
|
||||
list.concat(ai);
|
||||
{$ifndef cpu64bitalu}
|
||||
if size in [OS_S64,OS_64] then
|
||||
|
||||
@ -247,8 +247,16 @@ uses
|
||||
type
|
||||
TResFlags = (F_E,F_NE,F_G,F_L,F_GE,F_LE,F_C,F_NC,
|
||||
F_A,F_AE,F_B,F_BE,
|
||||
F_S,F_NS,F_O,F_NO);
|
||||
F_S,F_NS,F_O,F_NO,
|
||||
{ For IEEE-compliant floating-point compares,
|
||||
same as normal counterparts but additionally check PF }
|
||||
F_FE,F_FNE,F_FA,F_FAE,F_FB,F_FBE);
|
||||
|
||||
const
|
||||
FPUFlags = [F_FE,F_FNE,F_FA,F_FAE,F_FB,F_FBE];
|
||||
FPUFlags2Flags: array[F_FE..F_FBE] of TResFlags = (
|
||||
F_E,F_NE,F_A,F_AE,F_B,F_BE
|
||||
);
|
||||
|
||||
{*****************************************************************************
|
||||
Constants
|
||||
@ -478,7 +486,8 @@ implementation
|
||||
inv_flags: array[TResFlags] of TResFlags =
|
||||
(F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
|
||||
F_BE,F_B,F_AE,F_A,
|
||||
F_NS,F_S,F_NO,F_O);
|
||||
F_NS,F_S,F_NO,F_O,
|
||||
F_FNE,F_FE,F_FBE,F_FB,F_FAE,F_FA);
|
||||
begin
|
||||
f:=inv_flags[f];
|
||||
end;
|
||||
@ -487,9 +496,12 @@ implementation
|
||||
function flags_to_cond(const f: TResFlags) : TAsmCond;
|
||||
const
|
||||
flags_2_cond : array[TResFlags] of TAsmCond =
|
||||
(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE,C_S,C_NS,C_O,C_NO);
|
||||
(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE,C_S,C_NS,C_O,C_NO,
|
||||
C_None,C_None,C_None,C_None,C_None,C_None);
|
||||
begin
|
||||
result := flags_2_cond[f];
|
||||
if (result=C_None) then
|
||||
InternalError(2014041301);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -35,6 +35,7 @@ unit nx86add;
|
||||
tx86addnode = class(tcgaddnode)
|
||||
protected
|
||||
function getresflags(unsigned : boolean) : tresflags;
|
||||
function getfpuresflags : tresflags;
|
||||
procedure left_must_be_reg(opdef: tdef; opsize:TCGSize;noswap:boolean);
|
||||
procedure force_left_and_right_fpureg;
|
||||
procedure prepare_x87_locations(out refnode: tnode);
|
||||
@ -400,6 +401,32 @@ unit nx86add;
|
||||
end;
|
||||
|
||||
|
||||
function tx86addnode.getfpuresflags : tresflags;
|
||||
begin
|
||||
if (nodetype=equaln) then
|
||||
result:=F_FE
|
||||
else if (nodetype=unequaln) then
|
||||
result:=F_FNE
|
||||
else if (nf_swapped in flags) then
|
||||
case nodetype of
|
||||
ltn : result:=F_FA;
|
||||
lten : result:=F_FAE;
|
||||
gtn : result:=F_FB;
|
||||
gten : result:=F_FBE;
|
||||
else
|
||||
internalerror(2014031402);
|
||||
end
|
||||
else
|
||||
case nodetype of
|
||||
ltn : result:=F_FB;
|
||||
lten : result:=F_FBE;
|
||||
gtn : result:=F_FA;
|
||||
gten : result:=F_FAE;
|
||||
else
|
||||
internalerror(2014031403);
|
||||
end;
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
AddSmallSet
|
||||
*****************************************************************************}
|
||||
@ -1093,7 +1120,7 @@ unit nx86add;
|
||||
internalerror(200402223);
|
||||
end;
|
||||
end;
|
||||
location.resflags:=getresflags(true);
|
||||
location.resflags:=getfpuresflags;
|
||||
location_freetemp(current_asmdata.CurrAsmList,left.location);
|
||||
location_freetemp(current_asmdata.CurrAsmList,right.location);
|
||||
end;
|
||||
@ -1259,7 +1286,7 @@ unit nx86add;
|
||||
end;
|
||||
|
||||
location_reset(location,LOC_FLAGS,OS_NO);
|
||||
location.resflags:=getresflags(true);
|
||||
location.resflags:=getfpuresflags;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
62
tests/test/units/math/tcmpnan.pp
Normal file
62
tests/test/units/math/tcmpnan.pp
Normal file
@ -0,0 +1,62 @@
|
||||
{ Tests unordered comparison results. This is a basic codegeneration test, but it needs
|
||||
Math unit to silence exceptions. }
|
||||
uses math;
|
||||
|
||||
const
|
||||
kNan = Sqrt(-1);
|
||||
kX = 5.8E-7;
|
||||
var
|
||||
vNan, vX: real;
|
||||
code: longint;
|
||||
b: boolean;
|
||||
begin
|
||||
code:=0;
|
||||
SetExceptionMask( [exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
|
||||
if kNan = kX then code:=1;
|
||||
if kNan < kX then code:=code or 2;
|
||||
if kNan <= kX then code:=code or 4;
|
||||
if kNan > kX then code:=code or 8;
|
||||
if kNan >= kX then code:=code or 16;
|
||||
code:=code or 32;
|
||||
if kX <> kNan then code:=code and (not 32);
|
||||
|
||||
vNan:= kNan;
|
||||
vX:= kX;
|
||||
|
||||
{ Test g_flag2reg/ref }
|
||||
b:=(vNan = vX);
|
||||
if b then code:=code or 64;
|
||||
b:=(vNan < vX);
|
||||
if b then code:=code or 128;
|
||||
b:=(vNan <= vX);
|
||||
if b then code:=code or 256;
|
||||
b:=(vNan > vX);
|
||||
if b then code:=code or 512;
|
||||
b:=(vNan >= vX);
|
||||
if b then code:=code or 1024;
|
||||
b:=(vNan <> vX);
|
||||
if (not b) then code:=code or 2048;
|
||||
|
||||
{ Test a_jmp_flags }
|
||||
if vNan = vX then
|
||||
code:=code or 4096;
|
||||
if vNan < vX then
|
||||
code:=code or 8192;
|
||||
if vNan <= vX then
|
||||
code:=code or 16384;
|
||||
if vNan > vX then
|
||||
code:=code or 32768;
|
||||
if vNan >= vX then
|
||||
code:=code or 65536;
|
||||
|
||||
code:=code or 131072;
|
||||
if vNan <> vX then
|
||||
code:=code and (not 131072);
|
||||
|
||||
if code=0 then
|
||||
writeln('ok')
|
||||
else
|
||||
writeln('error: ',hexstr(code,8));
|
||||
Halt(code);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user