Selaa lähdekoodia

* 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: trunk@9664 -

Jonas Maebe 17 vuotta sitten
vanhempi
commit
84159b3cbb
5 muutettua tiedostoa jossa 215 lisäystä ja 2 poistoa
  1. 1 0
      .gitattributes
  2. 10 0
      compiler/nadd.pas
  3. 120 2
      compiler/ncnv.pas
  4. 1 0
      compiler/node.pas
  5. 83 0
      tests/tbs/tb0543.pp

+ 1 - 0
.gitattributes

@@ -6585,6 +6585,7 @@ tests/tbs/tb0539.pp svneol=native#text/plain
 tests/tbs/tb0540.pp svneol=native#text/x-pascal
 tests/tbs/tb0541.pp svneol=native#text/plain
 tests/tbs/tb0542.pp svneol=native#text/plain
+tests/tbs/tb0543.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain

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

+ 120 - 2
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;
 
 

+ 1 - 0
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,

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