* optimize away unnecessary implicit upcasts to int64 for subtractions

    of u32bit values on 32 bit platforms (after the int64 values have 
    already been used for overload selection etc, i.e., semantically
    nothing changes)
  + test which checks that not too many typecasts are optimized away


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@9664 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 214 insertions, 2 deletions

diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index e36fef7e5c..848a017fb2 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -1162,6 +1162,16 @@ implementation
                    begin
                      if nodetype<>subn then
                        CGMessage(type_w_mixed_signed_unsigned);
+                     { mark as internal in case added for a subn, so }
+                     { ttypeconvnode.simplify can remove the 64 bit  }
+                     { typecast again if semantically correct. Even  }
+                     { if we could detect that here already, we      }
+                     { mustn't do it here because that would change  }
+                     { overload choosing behaviour etc. The code in  }
+                     { ncnv.pas is run after that is already decided }
+                     if not is_signed(left.resultdef) and
+                        not is_signed(right.resultdef) then
+                       include(flags,nf_internal);
                      inserttypeconv(left,s64inttype);
                      inserttypeconv(right,s64inttype);
                    end
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 7553a59a44..7709a5254c 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -1953,6 +1953,96 @@ implementation
       end;
 
 
+{$ifndef cpu64bit}
+
+    { checks whether we can safely remove 64 bit typeconversions }
+    { in case range and overflow checking are off, and in case   }
+    { the result of thise node tree is downcasted again to a     }
+    { 8/16/32 bit value afterwards                               }
+    function checkremove64bittypeconvs(n: tnode): boolean;
+
+      { checks whether a node is either an u32bit, or originally }
+      { was one but was implicitly converted to s64bit           }
+      function wasoriginallyuint32(n: tnode): boolean;
+        begin
+          if (n.resultdef.typ<>orddef) then
+            exit(false);
+          if (torddef(n.resultdef).ordtype=u32bit) then
+            exit(true);
+          result:=
+            (torddef(n.resultdef).ordtype=s64bit) and
+            { nf_explicit is also set for explicitly typecasted }
+            { ordconstn's                                       }
+            ([nf_internal,nf_explicit]*n.flags=[]) and
+            { either a typeconversion node coming from u32bit }
+            (((n.nodetype=typeconvn) and
+              (ttypeconvnode(n).left.resultdef.typ=orddef) and
+              (torddef(ttypeconvnode(n).left.resultdef).ordtype=u32bit)) or
+            { or an ordconstnode which was/is a valid cardinal }
+             ((n.nodetype=ordconstn) and
+              (tordconstnode(n).value>=0) and
+              (tordconstnode(n).value<=high(cardinal))));
+        end;
+
+    
+      begin
+        result:=false;
+        if wasoriginallyuint32(n) then
+          exit(true);
+        case n.nodetype of
+          subn:
+            begin
+              { nf_internal is set by taddnode.typecheckpass in  }
+              { case the arguments of this subn were u32bit, but }
+              { upcasted to s64bit for calculation correctness   }
+              { (normally only needed when range checking, but   }
+              {  also done otherwise so there is no difference   }
+              {  in overload choosing etc between $r+ and $r-)   }
+              if (nf_internal in n.flags) then
+                result:=true
+              else
+                result:=
+                  checkremove64bittypeconvs(tbinarynode(n).left) and
+                  checkremove64bittypeconvs(tbinarynode(n).right);
+            end;
+          addn,muln,divn,modn,xorn,andn,orn:
+            begin
+              result:=
+                checkremove64bittypeconvs(tbinarynode(n).left) and
+                checkremove64bittypeconvs(tbinarynode(n).right);
+            end;
+        end;
+      end;
+
+
+    procedure doremove64bittypeconvs(var n: tnode; todef: tdef);
+      begin
+        case n.nodetype of
+          subn,addn,muln,divn,modn,xorn,andn,orn:
+            begin
+              exclude(n.flags,nf_internal);
+              if is_signed(n.resultdef) then
+                begin
+                  doremove64bittypeconvs(tbinarynode(n).left,s32inttype);
+                  doremove64bittypeconvs(tbinarynode(n).right,s32inttype);
+                  n.resultdef:=s32inttype
+                end
+              else
+                begin
+                  doremove64bittypeconvs(tbinarynode(n).left,u32inttype);
+                  doremove64bittypeconvs(tbinarynode(n).right,u32inttype);
+                  n.resultdef:=u32inttype
+                end;
+            end;
+          ordconstn:
+            inserttypeconv_internal(n,todef);
+          typeconvn:
+            n.resultdef:=todef;
+        end;
+      end;
+{$endif not cpu64bit}
+
+
     function ttypeconvnode.simplify: tnode;
       var
         hp: tnode;
@@ -2041,7 +2131,10 @@ implementation
                 begin
                    { replace the resultdef and recheck the range }
                    if ([nf_explicit,nf_internal] * flags <> []) then
-                     include(left.flags, nf_explicit);
+                     include(left.flags, nf_explicit)
+                   else
+                     { no longer an ordconst with an explicit typecast }
+                     exclude(left.flags, nf_explicit);
                    testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
                    left.resultdef:=resultdef;
                    result:=left;
@@ -2057,7 +2150,10 @@ implementation
                 begin
                    left.resultdef:=resultdef;
                    if ([nf_explicit,nf_internal] * flags <> []) then
-                     include(left.flags, nf_explicit);
+                     include(left.flags, nf_explicit)
+                   else
+                     { no longer an ordconst with an explicit typecast }
+                     exclude(left.flags, nf_explicit);
                    result:=left;
                    left:=nil;
                    exit;
@@ -2074,6 +2170,28 @@ implementation
                 end;
             end;
         end;
+        
+{$ifndef cpu64bit}
+        { must be done before code below, because we need the
+          typeconversions for ordconstn's as well }
+        case convtype of
+          tc_int_2_int:
+            begin
+              if (localswitches * [cs_check_range,cs_check_overflow] = []) and
+                 (resultdef.typ in [pointerdef,orddef,enumdef]) and
+                 (resultdef.size <= 4) and
+                 is_64bitint(left.resultdef) and
+                 (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn]) and
+                 checkremove64bittypeconvs(left) then
+                begin
+                  { avoid unnecessary widening of intermediary calculations }
+                  { to 64 bit                                               }
+                  doremove64bittypeconvs(left,generrordef);
+                end;
+            end;
+        end;
+{$endif cpu64bit}
+
       end;
 
 
diff --git a/compiler/node.pas b/compiler/node.pas
index b9bde1f14f..b60e39fe9f 100644
--- a/compiler/node.pas
+++ b/compiler/node.pas
@@ -240,6 +240,7 @@ interface
          nf_novariaallowed,
 
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
+         { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
          nf_explicit,
          nf_internal,  { no warnings/hints generated }
          nf_load_procvar,
diff --git a/tests/tbs/tb0543.pp b/tests/tbs/tb0543.pp
new file mode 100644
index 0000000000..e4a276e04c
--- /dev/null
+++ b/tests/tbs/tb0543.pp
@@ -0,0 +1,83 @@
+procedure check(l: longint; v,c: int64);
+begin
+  if (v<>c) then
+    begin
+      writeln('error near ',l);
+      halt(l);
+    end;
+end;
+
+var
+  l1,l2,l3: longint;
+  c1,c2,c3: cardinal;
+  i: int64;
+begin
+  l1:=low(longint);
+  l2:=-2;
+  c1:=$80000000;
+  c2:=cardinal(-2);
+
+
+  l3:=$80000000 div l2;
+  writeln(l3);
+  check(1,l3,-1073741824);
+  c3:=$80000000 div l2;
+  writeln(c3);
+  check(2,c3,3221225472);
+  i:=$80000000 div l2;
+  writeln(i);
+  check(3,i,-1073741824);
+
+  l3:=c1 div -2;
+  writeln(l3);
+  check(4,l3,-1073741824);
+  c3:=c1 div -2;
+  writeln(c3);
+  check(5,c3,3221225472);
+  i:=c1 div -2;
+  writeln(i);
+  check(6,i,-1073741824);
+
+  l3:=c1 div l2;
+  writeln(l3);
+  check(7,l3,-1073741824);
+  c3:=c1 div l2;
+  writeln(c3);
+  check(8,c3,3221225472);
+  i:=c1 div l2;
+  writeln(i);
+  check(9,i,-1073741824);
+
+
+  l3:=l1 div c2;
+  writeln(l3);
+  check(10,l3,0);
+  c3:=l1 div c2;
+  check(11,c3,0);
+  writeln(c3);
+  i:=l1 div c2;
+  writeln(i);
+  check(12,i,0);
+
+  l3:=l1 div cardinal(-2);
+  writeln(l3);
+  check(13,l3,0);
+  c3:=l1 div cardinal(-2);
+  writeln(c3);
+  check(14,c3,0);
+  i:=l1 div cardinal(-2);
+  writeln(i);
+  check(15,i,0);
+
+  l3:=low(longint) div c2;
+  writeln(l3);
+  check(16,l3,0);
+  c3:=low(longint) div c2;
+  writeln(c3);
+  check(17,c3,0);
+  i:=low(longint) div c2;
+  writeln(i);
+  check(18,i,0);
+
+end.
+