+ added ability for (mainly 32bit) code generators to directly handle

32bit*32bit->64bit          
  + implemented the above for ppc32 (note: does not happen very often
    in practice, at least not in the compiler and rtl)       
  + test for the above

git-svn-id: trunk@2735 -

.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

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

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
+        if not(cmpop) then
-           (location.register = NR_NO) then
+          begin
-         begin
+            if (location.register = NR_NO) then
-           location.register := cg.getintregister(exprasmlist,OS_INT);
+              location.register := cg.getintregister(exprasmlist,OS_INT);
-           if is_64bit(resulttype.def) then
+            if is_64bit(resulttype.def) and
-             location.register64.reghi := cg.getintregister(exprasmlist,OS_INT);
+               (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
+        load_left_right(cmpop,((cs_check_overflow in aktlocalswitches) and
-            (nodetype in [addn,subn]));
+            (nodetype in [addn,subn])) or (nodetype = muln));
 
-        if not(cs_check_overflow in aktlocalswitches) or
+        if (nodetype <> muln) and
-           not(nodetype in [addn,subn]) then
+           (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 (nodetype <> muln) then
-            if not(is_signed(resulttype.def)) then
+              begin
-              if nodetype = addn then
+                exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi,
-                exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,location.register64.reghi,left.location.register64.reghi))
+                   right.location.register64.reghi,left.location.register64.reghi));
-              else
+                if not(is_signed(resulttype.def)) then
-                exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register64.reghi,location.register64.reghi));
+                  if nodetype = addn then
-            cg.g_overflowcheck(exprasmlist,location,resulttype.def);
+                    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;

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.