Browse Source

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

Jonas Maebe 19 years ago
parent
commit
07ce826be0
4 changed files with 212 additions and 23 deletions
  1. 1 0
      .gitattributes
  2. 80 0
      compiler/nadd.pas
  3. 63 23
      compiler/powerpc/nppcadd.pas
  4. 68 0
      tests/test/cg/tmul3264.pp

+ 1 - 0
.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/tmanypar.pp svneol=native#text/plain
 tests/test/cg/tmoddiv.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/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/tneg.pp svneol=native#text/plain
 tests/test/cg/tnot.pp svneol=native#text/plain
 tests/test/cg/tnot.pp svneol=native#text/plain
 tests/test/cg/tobjsiz2.pp svneol=native#text/plain
 tests/test/cg/tobjsiz2.pp svneol=native#text/plain

+ 80 - 0
compiler/nadd.pas

@@ -49,6 +49,13 @@ interface
           { the code generator for performance reasons (JM)                 }
           { the code generator for performance reasons (JM)                 }
           function first_add64bitint: tnode; virtual;
           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
           { This routine calls internal runtime library helpers
             for all floating point arithmetic in the case
             for all floating point arithmetic in the case
             where the emulation switches is on. Otherwise
             where the emulation switches is on. Otherwise
@@ -56,6 +63,10 @@ interface
             the code generation phase.
             the code generation phase.
           }
           }
           function first_addfloat : tnode; virtual;
           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;
        end;
        taddnodeclass = class of taddnode;
        taddnodeclass = class of taddnode;
 
 
@@ -1742,6 +1753,71 @@ implementation
       end;
       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;
     function taddnode.first_add64bitint: tnode;
       var
       var
         procname: string[31];
         procname: string[31];
@@ -1775,6 +1851,10 @@ implementation
             exit;
             exit;
           end;
           end;
 
 
+        if not(use_generic_mul32to64) and
+           try_make_mul32to64 then
+          exit;
+
         { when currency is used set the result of the
         { when currency is used set the result of the
           parameters to s64bit, so they are not converted }
           parameters to s64bit, so they are not converted }
         if is_currency(resulttype.def) then
         if is_currency(resulttype.def) then

+ 63 - 23
compiler/powerpc/nppcadd.pas

@@ -32,6 +32,8 @@ interface
        tppcaddnode = class(tcgaddnode)
        tppcaddnode = class(tcgaddnode)
           function pass_1: tnode; override;
           function pass_1: tnode; override;
           procedure pass_2;override;
           procedure pass_2;override;
+         protected
+          function use_generic_mul32to64: boolean; override;
          private
          private
           procedure pass_left_and_right;
           procedure pass_left_and_right;
           procedure load_left_right(cmpop, load_constants: boolean);
           procedure load_left_right(cmpop, load_constants: boolean);
@@ -81,6 +83,11 @@ interface
       end;
       end;
 
 
 
 
+   function tppcaddnode.use_generic_mul32to64: boolean;
+     begin
+       result := false;
+     end;
+
 {*****************************************************************************
 {*****************************************************************************
                                   Helpers
                                   Helpers
 *****************************************************************************}
 *****************************************************************************}
@@ -105,7 +112,9 @@ interface
         begin
         begin
           case n.location.loc of
           case n.location.loc of
             LOC_REGISTER:
             LOC_REGISTER:
-              if not cmpop then
+              if (not cmpop) and
+                 ((nodetype <> muln) or
+                  not is_64bit(resulttype.def)) then
                 begin
                 begin
                   location.register := n.location.register;
                   location.register := n.location.register;
                   if is_64bit(n.resulttype.def) then
                   if is_64bit(n.resulttype.def) then
@@ -114,7 +123,9 @@ interface
             LOC_REFERENCE,LOC_CREFERENCE:
             LOC_REFERENCE,LOC_CREFERENCE:
               begin
               begin
                 location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
                 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
                   begin
                     location.register := n.location.register;
                     location.register := n.location.register;
                     if is_64bit(n.resulttype.def) then
                     if is_64bit(n.resulttype.def) then
@@ -126,7 +137,9 @@ interface
                 if load_constants then
                 if load_constants then
                   begin
                   begin
                     location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
                     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
                       begin
                         location.register := n.location.register;
                         location.register := n.location.register;
                         if is_64bit(n.resulttype.def) then
                         if is_64bit(n.resulttype.def) then
@@ -140,12 +153,13 @@ interface
       begin
       begin
         load_node(left);
         load_node(left);
         load_node(right);
         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;
       end;
       end;
 
 
@@ -799,7 +813,11 @@ interface
           muln:
           muln:
             begin
             begin
               { should be handled in pass_1 (JM) }
               { 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;
             end;
           else
           else
             internalerror(2002072705);
             internalerror(2002072705);
@@ -808,11 +826,12 @@ interface
         if not cmpop then
         if not cmpop then
           location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
           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
           begin
             case nodetype of
             case nodetype of
               ltn,lten,
               ltn,lten,
@@ -1007,6 +1026,11 @@ interface
                       op1 := A_SUBC;
                       op1 := A_SUBC;
                       op2 := A_SUBFEO;
                       op2 := A_SUBFEO;
                     end;
                     end;
+                  muln:
+                    begin
+                      op1 := A_MULLW;
+                      op2 := A_MULHW
+                    end;
                   else
                   else
                     internalerror(2002072806);
                     internalerror(2002072806);
                 end
                 end
@@ -1024,18 +1048,33 @@ interface
                       op1 := A_SUBC;
                       op1 := A_SUBC;
                       op2 := A_SUBFE;
                       op2 := A_SUBFE;
                     end;
                     end;
+                  muln:
+                    begin
+                      op1 := A_MULLW;
+                      op2 := A_MULHWU
+                    end;
                 end;
                 end;
               end;
               end;
             exprasmlist.concat(taicpu.op_reg_reg_reg(op1,location.register64.reglo,
             exprasmlist.concat(taicpu.op_reg_reg_reg(op1,location.register64.reglo,
               left.location.register64.reglo,right.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;
           end;
 
 
         { set result location }
         { set result location }
@@ -1264,7 +1303,8 @@ interface
                    exit;
                    exit;
                  end
                  end
                { 64bit operations }
                { 64bit operations }
-               else if is_64bit(left.resulttype.def) then
+               else if is_64bit(resulttype.def) or
+                       is_64bit(left.resulttype.def) then
                  begin
                  begin
                    second_add64bit;
                    second_add64bit;
                    exit;
                    exit;

+ 68 - 0
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.