Ver Fonte

* fold shifting of constants equally to cpus
* test adapted, e.g. 1 shl 63 needs now an explicit cast to qword for the one: qword(1) shl 63

git-svn-id: trunk@26295 -

florian há 11 anos atrás
pai
commit
89663e499b
4 ficheiros alterados com 33 adições e 5 exclusões
  1. 30 2
      compiler/nmat.pas
  2. 1 1
      tests/tbs/tb0295.pp
  3. 1 1
      tests/webtbs/tw16328.pp
  4. 1 1
      tests/webtbs/tw22133.pp

+ 30 - 2
compiler/nmat.pas

@@ -573,16 +573,44 @@ implementation
  ****************************************************************************}
  ****************************************************************************}
 
 
     function tshlshrnode.simplify(forinline : boolean):tnode;
     function tshlshrnode.simplify(forinline : boolean):tnode;
+      var
+        lvalue,rvalue : Tconstexprint;
       begin
       begin
         result:=nil;
         result:=nil;
         { constant folding }
         { constant folding }
         if is_constintnode(left) and is_constintnode(right) then
         if is_constintnode(left) and is_constintnode(right) then
           begin
           begin
+             { x86 wraps around }
+             { shl/shr are unsigned operations, so cut off upper bits }
+             case resultdef.size of
+               1:
+                 begin
+                   rvalue:=tordconstnode(right).value and byte($7);
+                   lvalue:=tordconstnode(left).value and byte($ff);
+                 end;
+               2:
+                 begin
+                   rvalue:=tordconstnode(right).value and byte($f);
+                   lvalue:=tordconstnode(left).value and word($ffff);
+                 end;
+               4:
+                 begin
+                   rvalue:=tordconstnode(right).value and byte($1f);
+                   lvalue:=tordconstnode(left).value and dword($ffffffff);
+                 end;
+               8:
+                 begin
+                   rvalue:=tordconstnode(right).value and byte($3f);
+                   lvalue:=tordconstnode(left).value and qword($ffffffffffffffff);
+                 end;
+               else
+                 internalerror(2013122301);
+             end;
              case nodetype of
              case nodetype of
                 shrn:
                 shrn:
-                  result:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline);
+                  result:=create_simplified_ord_const(lvalue shr rvalue,resultdef,forinline);
                 shln:
                 shln:
-                  result:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline);
+                  result:=create_simplified_ord_const(lvalue shl rvalue,resultdef,forinline);
              end;
              end;
           end;
           end;
       end;
       end;

+ 1 - 1
tests/tbs/tb0295.pp

@@ -11,7 +11,7 @@ Var
 begin
 begin
   I:=2;
   I:=2;
   Writeln(i);
   Writeln(i);
-  K:=1 shl 62;
+  K:=qword(1) shl 62;
   For j:=1 to 61 do
   For j:=1 to 61 do
     begin
     begin
     I:=I*2;
     I:=I*2;

+ 1 - 1
tests/webtbs/tw16328.pp

@@ -10,7 +10,7 @@ const
 type
 type
   TmydbID = type Longword;
   TmydbID = type Longword;
   TmydbCLSID = type Word;
   TmydbCLSID = type Word;
-  TmydbDBID   = 0..(1 shl 48)-1;  // Unique ID of the database
+  TmydbDBID   = 0..(qword(1) shl 48)-1;  // Unique ID of the database
   TmydbDBTYPE = type Byte;
   TmydbDBTYPE = type Byte;
 
 
   tarr = bitpacked array[0..10] of TmydbDBID;
   tarr = bitpacked array[0..10] of TmydbDBID;

+ 1 - 1
tests/webtbs/tw22133.pp

@@ -19,7 +19,7 @@ begin
 end;
 end;
 
 
 begin
 begin
-  T64:=UInt64(1 shl 63);
+  T64:=UInt64(qword(1) shl 63);
   if T64<>uint64(high(int64)+1) then
   if T64<>uint64(high(int64)+1) then
     halt(1);
     halt(1);
   T64:=UInt64(1) shl 63;
   T64:=UInt64(1) shl 63;