+ simplify support for ifn (based on patch by Florian)

git-svn-id: branches/fpc_2_3@6381 -

.gitattributes

@@ -8035,6 +8035,7 @@ tests/webtbs/tw8232.pp svneol=native#text/plain
 tests/webtbs/tw8258.pp svneol=native#text/plain
 tests/webtbs/tw8258a.pp svneol=native#text/plain
 tests/webtbs/tw8264.pp svneol=native#text/plain
+tests/webtbs/tw8282.pp svneol=native#text/plain
 tests/webtbs/tw8283.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/nflw.pas

@@ -84,6 +84,9 @@ interface
           constructor create(l,r,_t1 : tnode);virtual;reintroduce;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
+          function simplify : tnode;override;
+         private
+          function internalsimplify(warn: boolean) : tnode;
        end;
        tifnodeclass = class of tifnode;
 
@@ -658,6 +661,42 @@ implementation
       end;
 
 
+    function tifnode.internalsimplify(warn: boolean) : tnode;
+      begin
+        result:=nil;
+        { optimize constant expressions }
+        if left.nodetype=ordconstn then
+          begin
+             if tordconstnode(left).value=1 then
+               begin
+                  if assigned(right) then
+                    result:=right
+                  else
+                    result:=cnothingnode.create;
+                  right:=nil;
+                  if warn and assigned(t1) then
+                    CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
+               end
+             else
+               begin
+                  if assigned(t1) then
+                    result:=t1
+                  else
+                    result:=cnothingnode.create;
+                  t1:=nil;
+                  if warn and assigned(right) then
+                    CGMessagePos(right.fileinfo,cg_w_unreachable_code);
+               end;
+          end;
+      end;
+
+
+    function tifnode.simplify : tnode;
+      begin
+        result:=internalsimplify(false);
+      end;
+
+
     function tifnode.pass_typecheck:tnode;
       begin
          result:=nil;
@@ -685,31 +724,7 @@ implementation
              else
                Message1(type_e_boolean_expr_expected,left.resultdef.typename);
            end;
-
-         { optimize constant expressions }
-         if left.nodetype=ordconstn then
-           begin
-              if tordconstnode(left).value=1 then
-                begin
-                   if assigned(right) then
-                     result:=right
-                   else
-                     result:=cnothingnode.create;
-                   right:=nil;
-                   if assigned(t1) then
-                     CGMessagePos(t1.fileinfo,cg_w_unreachable_code);
-                end
-              else
-                begin
-                   if assigned(t1) then
-                     result:=t1
-                   else
-                     result:=cnothingnode.create;
-                   t1:=nil;
-                   if assigned(right) then
-                     CGMessagePos(right.fileinfo,cg_w_unreachable_code);
-                end;
-           end;
+         result:=internalsimplify(true);
       end;
 
 

tests/webtbs/tw8282.pp

@@ -0,0 +1,137 @@
+{ %opt=-O2 -Sew }
+
+{$inline on}
+
+type
+  Int96 = packed record
+    case Integer of
+      0:
+        (
+          {$IFDEF ENDIAN_LITTLE}
+          Lo32 : DWord;
+          case Integer of
+            0:
+              (
+                Mid32 : DWord;
+                Hi32 : LongInt;
+              );
+            1:
+              ( Hi64: Int64; );
+          {$ELSE ENDIAN_LITTLE}
+          Hi32 : LongInt;
+          case Integer of
+            0:
+              (
+                Mid32 : DWord;
+                Lo32 : DWord;
+              );
+            1:
+              ( Lo64: QWord; );
+          {$ENDIF ENDIAN_LITTLE}
+        );
+      1:
+        (
+          {$IFDEF ENDIAN_LITTLE}
+          Lo64 : QWord;
+          {$ELSE ENDIAN_LITTLE}
+          Hi64 : Int64;
+          {$ENDIF ENDIAN_LITTLE}
+        );
+  end;
+
+operator shl (const Left: Int96; const Right: LongInt) Result : Int96; forward;
+
+operator shr (const Left: Int96; const Right: LongInt) Result : Int96; inline;
+begin
+  if Right >= 0 then
+    if Right = 32 then begin
+      Result.Lo32 := Left.Mid32;
+      Result.Mid32 := Left.Hi32;
+      Result.Hi32 := 0;
+    end else if Right = 0 then begin
+      Result.Lo32 := Left.Lo32;
+      Result.Mid32 := Left.Mid32;
+      Result.Hi32 := Left.Hi32;
+    end else if Right = 64 then begin
+      Result.Lo32 := Left.Hi32;
+      Result.Mid32 := 0;
+      Result.Hi32 := 0;
+    end else if Right < 32 then begin
+      Result.Hi32 := Left.Hi32 shr Right;
+      Result.Mid32 := (Left.Mid32 shr Right) or (Left.Hi32 shl (32 - Right));
+      Result.Lo32 := (Left.Lo32 shr Right) or (Left.Mid32 shl (32 - Right));
+    end else if Right < 64 then begin
+      Result.Hi32 := 0;
+      Result.Mid32 := Left.Hi32 shr (Right-32);
+      Result.Lo32 := (Left.Mid32 shr (Right-32)) or (Left.Hi32 shl (64 - Right));
+    end else if Right < 96 then begin
+      Result.Hi32 := 0;
+      Result.Mid32 := 0;
+      Result.Lo32 := Left.Hi32 shr (Right-64);
+    end else begin
+      Result.Lo32 := 0;
+      Result.Mid32 := 0;
+      Result.Hi32 := 0;
+    end
+  else
+    Result := Left shl (-Right);
+end;
+
+operator shl (const Left: Int96; const Right: LongInt) Result : Int96; inline;
+begin
+  { ToDo: optimized code for 64bit cpu's }
+  if Right >= 0 then
+    if Right = 32 then begin
+      Result.Lo32 := 0;
+      Result.Mid32 := Left.Lo32;
+      Result.Hi32 := Left.Mid32;
+    end else if Right = 0 then begin
+      Result.Lo32 := Left.Lo32;
+      Result.Mid32 := Left.Mid32;
+      Result.Hi32 := Left.Hi32;
+    end else if Right = 64 then begin
+      Result.Lo32 := 0;
+      Result.Mid32 := 0;
+      Result.Hi32 := Left.Lo32;
+    end else if Right < 32 then begin
+      Result.Lo32 := Left.Lo32 shl Right;
+      Result.Mid32 := (Left.Mid32 shl Right) or (Left.Lo32 shr (32 - Right));
+      Result.Hi32 := (Left.Hi32 shl Right) or (Left.Mid32 shr (32 - Right));
+    end else if Right < 64 then begin
+      Result.Lo32 := 0;
+      Result.Mid32 := Left.Lo32 shl (Right-32);
+      Result.Hi32 := (Left.Mid32 shl (Right-32)) or (Left.Lo32 shr (64 - Right));
+    end else if Right < 96 then begin
+      Result.Lo32 := 0;
+      Result.Mid32 := 0;
+      Result.Hi32 := Left.Lo32 shl (Right-64);
+    end else begin
+      Result.Lo32 := 0;
+      Result.Mid32 := 0;
+      Result.Hi32 := 0;
+    end
+  else
+    Result := Left shr (-Right);
+end;
+
+operator := (const Right: QWord) Result : Int96; inline;
+begin
+  Result.Lo64  := Right;
+  Result.Hi32  := 0;
+end;
+
+
+procedure t;
+var
+  a: int96;
+begin
+  a := 500000000000000;
+  a := a shr 1;
+  if (a.lo64 <> (500000000000000 shr 1)) or
+     (a.hi32 <> 0) then
+    halt(1);
+end;
+
+begin
+  t;
+end.