diff --git a/.gitattributes b/.gitattributes index 7a78f0c5d6..68e3e51b62 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5546,6 +5546,7 @@ tests/test/cg/tlohi.pp svneol=native#text/plain tests/test/cg/tmanypar.pp svneol=native#text/plain tests/test/cg/tmoddiv.pp svneol=native#text/plain tests/test/cg/tmoddiv2.pp svneol=native#text/plain +tests/test/cg/tmul3264.pp svneol=native#text/plain tests/test/cg/tneg.pp svneol=native#text/plain tests/test/cg/tnot.pp svneol=native#text/plain tests/test/cg/tobjsiz2.pp svneol=native#text/plain diff --git a/compiler/nadd.pas b/compiler/nadd.pas index ebaf9f3afd..0bd5854000 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -49,6 +49,13 @@ interface { the code generator for performance reasons (JM) } function first_add64bitint: tnode; virtual; + { override and return false if you can handle 32x32->64 } + { bit multiplies directly in your code generator. If } + { this function is overridden to return false, you can } + { get multiplies with left/right both s32bit or u32bit, } + { and resulttype of the muln s64bit or u64bit } + function use_generic_mul32to64: boolean; virtual; + { This routine calls internal runtime library helpers for all floating point arithmetic in the case where the emulation switches is on. Otherwise @@ -56,6 +63,10 @@ interface the code generation phase. } function first_addfloat : tnode; virtual; + private + { checks whether a muln can be calculated as a 32bit } + { * 32bit -> 64 bit } + function try_make_mul32to64: boolean; end; taddnodeclass = class of taddnode; @@ -1742,6 +1753,71 @@ implementation end; + function taddnode.use_generic_mul32to64: boolean; + begin + result := true; + end; + + + function taddnode.try_make_mul32to64: boolean; + + function canbe32bitint(v: tconstexprint; fromdef: torddef; todefsigned: boolean): boolean; + begin + if (fromdef.typ <> u64bit) then + result := + ((v >= 0) or + todefsigned) and + (v >= low(longint)) and + (v <= high(longint)) + else + result := + (qword(v) >= low(cardinal)) and + (qword(v) <= high(cardinal)) + end; + + var + temp: tnode; + begin + result := false; + if ((left.nodetype = typeconvn) and + is_integer(ttypeconvnode(left).left.resulttype.def) and + (not(torddef(ttypeconvnode(left).left.resulttype.def).typ in [u64bit,s64bit])) and + (((right.nodetype = ordconstn) and + canbe32bitint(tordconstnode(right).value,torddef(right.resulttype.def),is_signed(left.resulttype.def))) or + ((right.nodetype = typeconvn) and + is_integer(ttypeconvnode(right).left.resulttype.def) and + not(torddef(ttypeconvnode(right).left.resulttype.def).typ in [u64bit,s64bit])) and + (is_signed(ttypeconvnode(left).left.resulttype.def) = + is_signed(ttypeconvnode(right).left.resulttype.def)))) then + begin + temp := ttypeconvnode(left).left; + ttypeconvnode(left).left := nil; + left.free; + left := temp; + if (right.nodetype = typeconvn) then + begin + temp := ttypeconvnode(right).left; + ttypeconvnode(right).left := nil; + right.free; + right := temp; + end; + if (is_signed(left.resulttype.def)) then + begin + inserttypeconv(left,s32inttype); + inserttypeconv(right,s32inttype); + end + else + begin + inserttypeconv(left,u32inttype); + inserttypeconv(right,u32inttype); + end; + firstpass(left); + firstpass(right); + result := true; + end; + end; + + function taddnode.first_add64bitint: tnode; var procname: string[31]; @@ -1775,6 +1851,10 @@ implementation exit; end; + if not(use_generic_mul32to64) and + try_make_mul32to64 then + exit; + { when currency is used set the result of the parameters to s64bit, so they are not converted } if is_currency(resulttype.def) then diff --git a/compiler/powerpc/nppcadd.pas b/compiler/powerpc/nppcadd.pas index 649419e7cb..ff85cbddfb 100644 --- a/compiler/powerpc/nppcadd.pas +++ b/compiler/powerpc/nppcadd.pas @@ -32,6 +32,8 @@ interface tppcaddnode = class(tcgaddnode) function pass_1: tnode; override; procedure pass_2;override; + protected + function use_generic_mul32to64: boolean; override; private procedure pass_left_and_right; procedure load_left_right(cmpop, load_constants: boolean); @@ -81,6 +83,11 @@ interface end; + function tppcaddnode.use_generic_mul32to64: boolean; + begin + result := false; + end; + {***************************************************************************** Helpers *****************************************************************************} @@ -105,7 +112,9 @@ interface begin case n.location.loc of LOC_REGISTER: - if not cmpop then + if (not cmpop) and + ((nodetype <> muln) or + not is_64bit(resulttype.def)) then begin location.register := n.location.register; if is_64bit(n.resulttype.def) then @@ -114,7 +123,9 @@ interface LOC_REFERENCE,LOC_CREFERENCE: begin location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false); - if not cmpop then + if (not cmpop) and + ((nodetype <> muln) or + not is_64bit(resulttype.def)) then begin location.register := n.location.register; if is_64bit(n.resulttype.def) then @@ -126,7 +137,9 @@ interface if load_constants then begin location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false); - if not cmpop then + if (not cmpop) and + ((nodetype <> muln) or + not is_64bit(resulttype.def)) then begin location.register := n.location.register; if is_64bit(n.resulttype.def) then @@ -140,12 +153,13 @@ interface begin load_node(left); load_node(right); - if not(cmpop) and - (location.register = NR_NO) then - begin - location.register := cg.getintregister(exprasmlist,OS_INT); - if is_64bit(resulttype.def) then - location.register64.reghi := cg.getintregister(exprasmlist,OS_INT); + if not(cmpop) then + begin + if (location.register = NR_NO) then + location.register := cg.getintregister(exprasmlist,OS_INT); + if is_64bit(resulttype.def) and + (location.register64.reghi = NR_NO) then + location.register64.reghi := cg.getintregister(exprasmlist,OS_INT); end; end; @@ -799,7 +813,11 @@ interface muln: begin { should be handled in pass_1 (JM) } - internalerror(200109051); + if not(torddef(left.resulttype.def).typ in [U32bit,s32bit]) or + (torddef(left.resulttype.def).typ <> torddef(right.resulttype.def).typ) then + internalerror(200109051); + { handled separately } + op := OP_NONE; end; else internalerror(2002072705); @@ -808,11 +826,12 @@ interface if not cmpop then location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def)); - load_left_right(cmpop,(cs_check_overflow in aktlocalswitches) and - (nodetype in [addn,subn])); + load_left_right(cmpop,((cs_check_overflow in aktlocalswitches) and + (nodetype in [addn,subn])) or (nodetype = muln)); - if not(cs_check_overflow in aktlocalswitches) or - not(nodetype in [addn,subn]) then + if (nodetype <> muln) and + (not(cs_check_overflow in aktlocalswitches) or + not(nodetype in [addn,subn])) then begin case nodetype of ltn,lten, @@ -1007,6 +1026,11 @@ interface op1 := A_SUBC; op2 := A_SUBFEO; end; + muln: + begin + op1 := A_MULLW; + op2 := A_MULHW + end; else internalerror(2002072806); end @@ -1024,18 +1048,33 @@ interface op1 := A_SUBC; op2 := A_SUBFE; end; + muln: + begin + op1 := A_MULLW; + op2 := A_MULHWU + end; end; end; exprasmlist.concat(taicpu.op_reg_reg_reg(op1,location.register64.reglo, left.location.register64.reglo,right.location.register64.reglo)); - exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi, - right.location.register64.reghi,left.location.register64.reghi)); - if not(is_signed(resulttype.def)) then - if nodetype = addn then - exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,location.register64.reghi,left.location.register64.reghi)) - else - exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register64.reghi,location.register64.reghi)); - cg.g_overflowcheck(exprasmlist,location,resulttype.def); + + if (nodetype <> muln) then + begin + exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi, + right.location.register64.reghi,left.location.register64.reghi)); + if not(is_signed(resulttype.def)) then + if nodetype = addn then + exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,location.register64.reghi,left.location.register64.reghi)) + else + exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register64.reghi,location.register64.reghi)); + cg.g_overflowcheck(exprasmlist,location,resulttype.def); + end + else + begin + { 32 * 32 -> 64 cannot overflow } + exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi, + left.location.register64.reglo,right.location.register64.reglo)); + end end; { set result location } @@ -1264,7 +1303,8 @@ interface exit; end { 64bit operations } - else if is_64bit(left.resulttype.def) then + else if is_64bit(resulttype.def) or + is_64bit(left.resulttype.def) then begin second_add64bit; exit; diff --git a/tests/test/cg/tmul3264.pp b/tests/test/cg/tmul3264.pp new file mode 100644 index 0000000000..4cb8c03653 --- /dev/null +++ b/tests/test/cg/tmul3264.pp @@ -0,0 +1,68 @@ +var + gl: longint; + gc: cardinal; + +procedure testsigned; +var + l1, l2: longint; + b1: byte; + i: int64; +begin + + l1 := longint($80000000); + gl := longint($80000000); + l2 := $11; + b1 := $11; + + i := int64(l1)*l2; + if (i <> int64($fffffff780000000)) then + halt(1); + + i := int64(l1)*$11; + if (i <> int64($fffffff780000000)) then + halt(2); + + i := int64(gl)*$11; + if (i <> int64($fffffff780000000)) then + halt(3); + + i := int64(gl)*b1; + if (i <> int64($fffffff780000000)) then + halt(4); +end; + + +procedure testunsigned; +var + l1, l2: cardinal; + b1: byte; + i: qword; +begin + + l1 := $80000000; + l2 := $11; + gc := $80000000; + b1 := $11; + + i := qword(l1)*l2; + if (i <> $880000000) then + halt(5); + + i := qword(l1)*$11; + if (i <> $880000000) then + halt(6); + + i := qword(gc)*$11; + if (i <> $880000000) then + halt(7); + + i := qword(gc)*b1; + if (i <> $880000000) then + halt(8); +end; + + +begin + testsigned; + testunsigned; +end.