diff --git a/compiler/llvm/hlcgllvm.pas b/compiler/llvm/hlcgllvm.pas index e9c7b8cb72..c8e681c15b 100644 --- a/compiler/llvm/hlcgllvm.pas +++ b/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 } - list.concat(taillvm.op_reg_size_reg_size(la_fptosi,tmpreg,fromsize,reg,tosize)) + begin + { 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 diff --git a/compiler/llvm/nllvmcnv.pas b/compiler/llvm/nllvmcnv.pas index 3efec9a9c4..36f78bab48 100644 --- a/compiler/llvm/nllvmcnv.pas +++ b/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; diff --git a/tests/webtbs/tw40550.pp b/tests/webtbs/tw40550.pp new file mode 100644 index 0000000000..986dab0bbe --- /dev/null +++ b/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.