* 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 -

.gitattributes

@@ -13436,6 +13436,7 @@ tests/tbs/tb0679.pp svneol=native#text/pascal
 tests/tbs/tb0680.pp svneol=native#text/pascal
 tests/tbs/tb0681.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/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

compiler/defutil.pas

@@ -229,6 +229,9 @@ interface
     {# Returns true, if def is a currency type }
     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 }
     function is_single(def : tdef) : boolean;
 
@@ -265,7 +268,10 @@ interface
     {# Returns true, if def is a 64 bit integer type }
     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;
 
     { returns true, if def is a longint type }
@@ -408,6 +414,12 @@ implementation
       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 }
     function is_single(def : tdef) : boolean;
       begin
@@ -1009,6 +1021,7 @@ implementation
          result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit,pasbool32,bool32bit])
       end;
 
+
     { true, if def is a 64 bit int type }
     function is_64bitint(def : tdef) : boolean;
       begin
@@ -1016,6 +1029,12 @@ implementation
       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 }
     function is_64bit(def : tdef) : boolean;
       begin

compiler/ninl.pas

@@ -2820,7 +2820,10 @@ implementation
 
     function tinlinenode.pass_typecheck:tnode;
 
-      procedure setfloatresultdef;
+      type
+        tfloattypeset = set of tfloattype;
+
+      function removefloatupcasts(var p: tnode; const floattypes: tfloattypeset): tdef;
         var
           hnode: tnode;
         begin
@@ -2830,25 +2833,54 @@ implementation
             which typechecks the arguments, possibly inserting conversion to valreal.
             To handle smaller types without excess precision, we need to remove
             these extra typecasts. }
-          if (left.nodetype=typeconvn) and
-            (ttypeconvnode(left).left.resultdef.typ=floatdef) and
-            (left.flags*[nf_explicit,nf_internal]=[]) and
-            (tfloatdef(ttypeconvnode(left).left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
+          if (p.nodetype=typeconvn) and
+             (ttypeconvnode(p).left.resultdef.typ=floatdef) and
+             (p.flags*[nf_explicit,nf_internal]=[]) and
+             (tfloatdef(ttypeconvnode(p).left.resultdef).floattype in (floattypes*[s32real,s64real,s80real,sc80real,s128real])) then
             begin
-              hnode:=ttypeconvnode(left).left;
-              ttypeconvnode(left).left:=nil;
-              left.free;
-              left:=hnode;
-              resultdef:=left.resultdef;
+              hnode:=ttypeconvnode(p).left;
+              ttypeconvnode(p).left:=nil;
+              p.free;
+              p:=hnode;
+              result:=p.resultdef;
             end
-          else if (left.resultdef.typ=floatdef) and
-            (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then
-            resultdef:=left.resultdef
+          else if (p.nodetype=typeconvn) and
+             (p.flags*[nf_explicit,nf_internal]=[]) and
+             (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
             begin
-              if (left.nodetype <> ordconstn) then
-                inserttypeconv(left,pbestrealtype^);
-              resultdef:=pbestrealtype^;
+              { for variant parameters; the rest has been converted by the
+                call node already }
+              if not(p.nodetype in [ordconstn,realconstn]) then
+                inserttypeconv(P,pbestrealtype^);
+              result:=p.resultdef
             end;
         end;
 
@@ -3595,18 +3627,29 @@ implementation
                   { on i8086, the int64 result is returned in a var param, because
                     it's too big to fit in a register or a pair of registers. In
                     that case we have 2 parameters and left.nodetype is a callparan. }
-                  if left.nodetype = callparan then
-                    temp_pnode := @tcallparanode(left).left
+                  if left.nodetype=callparan then
+                    temp_pnode:=@tcallparanode(left).left
                   else
-                    temp_pnode := @left;
+                    temp_pnode:=@left;
                   set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
-                  { for direct float rounding, no best real type cast should be necessary }
-                  if not((temp_pnode^.resultdef.typ=floatdef) and
-                         (tfloatdef(temp_pnode^.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and
-                     { converting an int64 to double on platforms without }
-                     { extended can cause precision loss                  }
-                     not(temp_pnode^.nodetype in [ordconstn,realconstn]) then
-                    inserttypeconv(temp_pnode^,pbestrealtype^);
+                  { on platforms where comp and currency are "type int64", this is
+                    handled via inlined system helpers (-> no need for special
+                    handling of s64currency/s64comp for them) }
+                  if inlinenumber=in_trunc_real then
+                    removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real,s64currency,s64comp])
+                  else
+                    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;
                 end;
 
@@ -3633,7 +3676,7 @@ implementation
                   else
                     temp_pnode := @left;
                   set_varstate(temp_pnode^,vs_read,[vsf_must_be_valid]);
-                  setfloatresultdef;
+                  resultdef:=removefloatupcasts(temp_pnode^,[s32real,s64real,s80real,sc80real,s128real]);
                 end;
 
 {$ifdef SUPPORT_MMX}

tests/tbs/tb0683.pp

@@ -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}