LLVM: only round currency values when storing them back to memory

Resolves #40550

compiler/llvm/hlcgllvm.pas

@@ -1386,7 +1386,10 @@ implementation
 
   procedure thlcgllvm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tdef; reg: tregister; const ref: treference);
     var
+       pd: tprocdef;
+       roundpara, respara: tcgpara;
        tmpreg: tregister;
+       tmploc: tlocation;
        href: treference;
        fromcompcurr,
        tocompcurr: boolean;
@@ -1407,8 +1410,23 @@ implementation
          begin
            tmpreg:=getfpuregister(list,tosize);
            if tocompcurr then
-             { store back an int64 rather than an extended }
+             begin
-             list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize))
+               { store back an int64 rather than an extended }
+               pd:=search_system_proc('fpc_round_real');
+               roundpara.init;
+               paramanager.getcgtempparaloc(list,pd,1,roundpara);
+               a_load_reg_cgpara(list,fromsize,reg,roundpara);
+               respara:=g_call_system_proc(list,pd,[@roundpara],nil);
+               if not assigned(respara.location) or
+                  (respara.location^.loc<>LOC_REGISTER) then
+                 internalerror(2023120510);
+               location_reset(tmploc,respara.location^.loc,def_cgsize(tosize));
+               tmploc.register:=tmpreg;
+               gen_load_cgpara_loc(list,respara.location^.def,respara,tmploc,false);
+               respara.resetiftemp;
+               respara.done;
+               roundpara.done;
+             end
            else
              a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
          end

compiler/llvm/nllvmcnv.pas

@@ -37,7 +37,7 @@ interface
           function first_int_to_real: tnode; override;
           function first_int_to_bool: tnode; override;
           function first_nil_to_methodprocvar: tnode; override;
-          function first_real_to_real: tnode; override;
+         { function first_real_to_real: tnode; override; }
          { procedure second_int_to_int;override; }
          { procedure second_string_to_string;override; }
          { procedure second_cstring_to_pchar;override; }
@@ -172,29 +172,6 @@ function tllvmtypeconvnode.first_nil_to_methodprocvar: tnode;
   end;
 
 
-function tllvmtypeconvnode.first_real_to_real: tnode;
-  begin
-    result:=inherited;
-    if assigned(result) then
-      exit;
-    { fptosui always uses round to zero, while we have to use the current
-      rounding mode when converting from another floating point type to
-      currency/comp to be compatible with the regular code generators ->
-      call round() instead }
-    if (tfloatdef(resultdef).floattype in [s64currency,s64comp]) and
-       not(tfloatdef(left.resultdef).floattype in [s64currency,s64comp]) and
-       not(nf_internal in flags) then
-      begin
-        result:=ccallnode.createinternfromunit('SYSTEM','ROUND',
-          ccallparanode.create(left,nil));
-        left:=nil;
-        { left was already been multiplied by 10000 by typecheck_real_to_real
-          -> ensure we don't do that again with the result of round }
-        result:=ctypeconvnode.create_internal(result,resultdef);
-      end;
-  end;
-
-
 procedure tllvmtypeconvnode.second_pointer_to_array;
   var
     hreg: tregister;

tests/webtbs/tw40550.pp

@@ -0,0 +1,45 @@
+program LLVMCurrency;
+
+uses
+    Math;
+
+var
+    Ccy1,
+        Ccy2    : Currency;
+    Dbl         : Double;
+begin
+    Dbl := 1.50125;
+    Ccy1 := 1000000;
+    Dbl := Dbl * Ccy1;
+    WriteLn('(Double) Dbl * Ccy1 = ', Dbl:6:0, ' expected 1_501_250 SameValue: ', SameValue(Dbl, Double(1501250)));
+    if not SameValue(Dbl, Double(1501250)) then
+      halt(1);
+
+    Dbl := 1.50125;
+    Ccy1 := 1;
+    Dbl := Dbl * Ccy1;
+    WriteLn('(Double) Dbl * Ccy1 = ', Dbl:6:6, ' expected 1.50125 SameValue: ', SameValue(Dbl, 1.50125));
+    if not SameValue(Dbl, 1.50125) then
+      halt(2);
+
+    Dbl := 1.50125;
+    Ccy1 := 1000000;
+    Ccy2 := Dbl * Ccy1;
+    WriteLn('(Currency) Dbl * Ccy1 = ', Ccy2:6:0, ' expected 1_501_250 SameValue: ', SameValue(Ccy2, Currency(1501250)));
+    if not SameValue(Ccy2, Currency(1501250)) then
+      halt(3);
+
+    Dbl := 1.50125;
+    Ccy1 := 1000000;
+    Dbl := (Dbl * Int64(Ccy1)) / 10000;
+    WriteLn('(Double) Dbl * Int64(Ccy1)) / 10000 = ', Dbl:6:0, ' expected 1_501_250 SameValue: ', SameValue(Dbl, Double(1501250)));
+    if not SameValue(Dbl, Double(1501250)) then
+      halt(4);
+
+    Dbl := 1501250;
+    Ccy1 := 1000000;
+    Dbl := Dbl / Ccy1;
+    WriteLn('Dbl / Ccy1 =  ', Dbl:6:6, ' expected 1.50125 SameValue: ', SameValue(Dbl, Double(1.50125)));
+    if not SameValue(Dbl, Double(1.50125)) then
+      halt(5);
+end.