* generate more efficient code for trunc(currency), trunc(comp), and

round(comp) on platforms where currency and comp are handled using the FPU
   o also fixes trunc(comp) and trunc(currency) compilation for x86 on LLVM
     with -Oofastmath
 * add missing removal of excess fpu precision typecasts for trunc/round

git-svn-id: trunk@47854 -
This commit is contained in:
Jonas Maebe 2020-12-27 13:18:47 +00:00
parent c0c0acbcb9
commit 3e047d3691
4 changed files with 113 additions and 28 deletions

1
.gitattributes vendored
View File

@ -13436,6 +13436,7 @@ tests/tbs/tb0679.pp svneol=native#text/pascal
tests/tbs/tb0680.pp svneol=native#text/pascal tests/tbs/tb0680.pp svneol=native#text/pascal
tests/tbs/tb0681.pp svneol=native#text/pascal tests/tbs/tb0681.pp svneol=native#text/pascal
tests/tbs/tb0682.pp svneol=native#text/pascal tests/tbs/tb0682.pp svneol=native#text/pascal
tests/tbs/tb0683.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain
tests/tbs/ub0119.pp svneol=native#text/plain tests/tbs/ub0119.pp svneol=native#text/plain

View File

@ -229,6 +229,9 @@ interface
{# Returns true, if def is a currency type } {# Returns true, if def is a currency type }
function is_currency(def : tdef) : boolean; function is_currency(def : tdef) : boolean;
{# Returns true, if def is a comp type (handled by the fpu) }
function is_fpucomp(def : tdef) : boolean;
{# Returns true, if def is a single type } {# Returns true, if def is a single type }
function is_single(def : tdef) : boolean; function is_single(def : tdef) : boolean;
@ -265,7 +268,10 @@ interface
{# Returns true, if def is a 64 bit integer type } {# Returns true, if def is a 64 bit integer type }
function is_64bitint(def : tdef) : boolean; function is_64bitint(def : tdef) : boolean;
{# Returns true, if def is a 64 bit type } {# Returns true, if def is a 64 bit signed integer type }
function is_s64bitint(def : tdef) : boolean;
{# Returns true, if def is a 64 bit ordinal type }
function is_64bit(def : tdef) : boolean; function is_64bit(def : tdef) : boolean;
{ returns true, if def is a longint type } { returns true, if def is a longint type }
@ -408,6 +414,12 @@ implementation
end; end;
function is_fpucomp(def: tdef): boolean;
begin
result:=(def.typ=floatdef) and
(tfloatdef(def).floattype=s64comp);
end;
{ returns true, if def is a single type } { returns true, if def is a single type }
function is_single(def : tdef) : boolean; function is_single(def : tdef) : boolean;
begin begin
@ -1009,6 +1021,7 @@ implementation
result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit]) result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit])
end; end;
{ true, if def is a 64 bit int type } { true, if def is a 64 bit int type }
function is_64bitint(def : tdef) : boolean; function is_64bitint(def : tdef) : boolean;
begin begin
@ -1016,6 +1029,12 @@ implementation
end; end;
function is_s64bitint(def: tdef): boolean;
begin
is_s64bitint:=(def.typ=orddef) and (torddef(def).ordtype=s64bit)
end;
{ true, if def is a 64 bit type } { true, if def is a 64 bit type }
function is_64bit(def : tdef) : boolean; function is_64bit(def : tdef) : boolean;
begin begin

View File

@ -2820,7 +2820,10 @@ implementation
function tinlinenode.pass_typecheck:tnode; function tinlinenode.pass_typecheck:tnode;
procedure setfloatresultdef; type
tfloattypeset = set of tfloattype;
function removefloatupcasts(var p: tnode; const floattypes: tfloattypeset): tdef;
var var
hnode: tnode; hnode: tnode;
begin begin
@ -2830,25 +2833,54 @@ implementation
which typechecks the arguments, possibly inserting conversion to valreal. which typechecks the arguments, possibly inserting conversion to valreal.
To handle smaller types without excess precision, we need to remove To handle smaller types without excess precision, we need to remove
these extra typecasts. } these extra typecasts. }
if (left.nodetype=typeconvn) and if (p.nodetype=typeconvn) and
(ttypeconvnode(left).left.resultdef.typ=floatdef) and (ttypeconvnode(p).left.resultdef.typ=floatdef) and
(left.flags*[nf_explicit,nf_internal]=[]) and (p.flags*[nf_explicit,nf_internal]=[]) and
(tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then (tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
begin begin
hnode:=ttypeconvnode(left).left; hnode:=ttypeconvnode(p).left;
ttypeconvnode(left).left:=nil; ttypeconvnode(p).left:=nil;
left.free; p.free;
left:=hnode; p:=hnode;
resultdef:=left.resultdef; result:=p.resultdef;
end end
else if (left.resultdef.typ=floatdef) and else if (p.nodetype=typeconvn) and
(tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then (p.flags*[nf_explicit,nf_internal]=[]) and
resultdef:=left.resultdef (ttypeconvnode(p).left.resultdef.typ=floatdef) and
(tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s64currency,s64comp])) then
begin
hnode:=ttypeconvnode(p).left;
ttypeconvnode(p).left:=nil;
p.free;
p:=hnode;
if is_currency(p.resultdef) then
begin
if (nf_is_currency in p.flags) and
(p.nodetype=slashn) and
(taddnode(p).right.nodetype=realconstn) and
(trealconstnode(taddnode(p).right).value_real=10000.0) and
not(nf_is_currency in taddnode(p).left.flags) then
begin
hnode:=taddnode(p).left;
taddnode(p).left:=nil;
p.free;
p:=hnode;
end;
end;
result:=p.resultdef;
end
{ in case the system helper was declared with overloads for different types,
keep those }
else if (p.resultdef.typ=floatdef) and
(tfloatdef(p.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
result:=p.resultdef
else else
begin begin
if (left.nodetype <> ordconstn) then { for variant parameters; the rest has been converted by the
inserttypeconv(left,pbestrealtype^); call node already }
resultdef:=pbestrealtype^; if not(p.nodetype in [ordconstn,realconstn]) then
inserttypeconv(P,pbestrealtype^);
result:=p.resultdef
end; end;
end; end;
@ -3600,13 +3632,24 @@ implementation
else else
temp_pnode:=@left; temp_pnode:=@left;
set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]); set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
{ for direct float rounding, no best real type cast should be necessary } { on platforms where comp and currency are "type int64", this is
if not((temp_pnode^.resultdef.typ=floatdef) and handled via inlined system helpers (-> no need for special
(tfloatdef(temp_pnode^.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and handling of s64currency/s64comp for them) }
{ converting an int64 to double on platforms without } if inlinenumber=in_trunc_real then
{ extended can cause precision loss } removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64currency,s64comp])
not(temp_pnode^.nodetype in [ordconstn,realconstn]) then else
inserttypeconv(temp_pnode^,pbestrealtype^); removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64comp]);
if (inlinenumber=in_trunc_real) and
is_currency(temp_pnode^.resultdef) then
begin
result:=cmoddivnode.create(divn,ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype),genintconstnode(10000));
exit;
end
else if is_fpucomp(temp_pnode^.resultdef) then
begin
result:=ctypeconvnode.create_internal(temp_pnode^.getcopy,s64inttype);
exit;
end;
resultdef:=s64inttype; resultdef:=s64inttype;
end; end;
@ -3633,7 +3676,7 @@ implementation
else else
temp_pnode := @left; temp_pnode := @left;
set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]); set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
setfloatresultdef; resultdef:=removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real]);
end; end;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}

22
tests/tbs/tb0683.pp Normal file
View File

@ -0,0 +1,22 @@
{$ifndef SKIP_CURRENCY_TEST}
var
c: currency;
co: comp;
i: int64;
begin
c:=10.25;
co:=12;
i:=trunc(c);
if i<>10 then
halt(1);
i:=trunc(co);
if i<>12 then
halt(2);
i:=round(co);
if i<>12 then
halt(3);
end.
{$else}
begin
end.
{$endif}