+ nmat refactored to have simplify

git-svn-id: trunk@142 -

compiler/nmat.pas

@@ -1,5 +1,5 @@
 {
-    Copyright (c) 2000-2002 by Florian Klaempfl
+    Copyright (c) 2000-2005 by Florian Klaempfl
 
     Type checking and register allocation for math nodes
 
@@ -32,6 +32,7 @@ interface
        tmoddivnode = class(tbinopnode)
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function simplify : tnode;override;
          protected
 {$ifndef cpu64bit}
           { override the following if you want to implement }
@@ -46,6 +47,7 @@ interface
        tshlshrnode = class(tbinopnode)
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function simplify : tnode;override;
 {$ifndef cpu64bit}
           { override the following if you want to implement }
           { parts explicitely in the code generator (CEC)
@@ -61,6 +63,7 @@ interface
           constructor create(expr : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function simplify : tnode;override;
        end;
        tunaryminusnodeclass = class of tunaryminusnode;
 
@@ -68,6 +71,7 @@ interface
           constructor create(expr : tnode);virtual;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
+          function simplify : tnode;override;
        {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif}
@@ -80,7 +84,6 @@ interface
        cunaryminusnode : tunaryminusnodeclass;
        cnotnode : tnotnodeclass;
 
-
 implementation
 
     uses
@@ -96,11 +99,47 @@ implementation
                               TMODDIVNODE
  ****************************************************************************}
 
+    function tmoddivnode.simplify:tnode;
+      var
+        t : tnode;
+        rd,ld : torddef;
+        rv,lv : tconstexprint;
+      begin
+        result:=nil;
+
+        if is_constintnode(right) and is_constintnode(left) then
+          begin
+            rd:=torddef(right.resulttype.def);
+            ld:=torddef(left.resulttype.def);
+
+            rv:=tordconstnode(right).value;
+            lv:=tordconstnode(left).value;
+
+            case nodetype of
+              modn:
+                if (torddef(ld).typ <> u64bit) or
+                   (torddef(rd).typ <> u64bit) then
+                  t:=genintconstnode(lv mod rv)
+                else
+                  t:=genintconstnode(int64(qword(lv) mod qword(rv)));
+              divn:
+                if (torddef(ld).typ <> u64bit) or
+                   (torddef(rd).typ <> u64bit) then
+                  t:=genintconstnode(lv div rv)
+                else
+                  t:=genintconstnode(int64(qword(lv) div qword(rv)));
+            end;
+            result:=t;
+            exit;
+         end;
+      end;
+
+
     function tmoddivnode.det_resulttype:tnode;
       var
-         hp,t : tnode;
+        hp,t : tnode;
-         rd,ld : torddef;
+        rd,ld : torddef;
-         rv,lv : tconstexprint;
+        rv : tconstexprint;
       begin
          result:=nil;
          resulttypepass(left);
@@ -131,29 +170,12 @@ implementation
                  { recover }
                  rv:=1;
                end;
-             if is_constintnode(left) then
-               begin
-                 lv:=tordconstnode(left).value;
-
-                 case nodetype of
-                   modn:
-                     if (torddef(ld).typ <> u64bit) or
-                        (torddef(rd).typ <> u64bit) then
-                       t:=genintconstnode(lv mod rv)
-                     else
-                       t:=genintconstnode(int64(qword(lv) mod qword(rv)));
-                   divn:
-                     if (torddef(ld).typ <> u64bit) or
-                        (torddef(rd).typ <> u64bit) then
-                       t:=genintconstnode(lv div rv)
-                     else
-                       t:=genintconstnode(int64(qword(lv) div qword(rv)));
-                 end;
-                 result:=t;
-                 exit;
-              end;
             end;
 
+         result:=simplify;
+         if assigned(result) then
+           exit;
+
          { allow operator overloading }
          t:=self;
          if isbinaryoverloaded(t) then
@@ -425,6 +447,27 @@ implementation
                               TSHLSHRNODE
  ****************************************************************************}
 
+    function tshlshrnode.simplify:tnode;
+      var
+        t : tnode;
+      begin
+        result:=nil;
+        { constant folding }
+        if is_constintnode(left) and is_constintnode(right) then
+          begin
+             case nodetype of
+                shrn:
+                  t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
+                shln:
+                  t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
+             end;
+             result:=t;
+             exit;
+          end;
+
+      end;
+
+
     function tshlshrnode.det_resulttype:tnode;
       var
          t : tnode;
@@ -437,18 +480,9 @@ implementation
          if codegenerror then
            exit;
 
-         { constant folding }
+         result:=simplify;
-         if is_constintnode(left) and is_constintnode(right) then
+         if assigned(result) then
-           begin
+           exit;
-              case nodetype of
-                 shrn:
-                   t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
-                 shln:
-                   t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
-              end;
-              result:=t;
-              exit;
-           end;
 
          { allow operator overloading }
          t:=self;
@@ -535,6 +569,25 @@ implementation
       end;
 
 
+    function tunaryminusnode.simplify:tnode;
+      begin
+        result:=nil;
+        { constant folding }
+        if is_constintnode(left) then
+          begin
+             result:=genintconstnode(-tordconstnode(left).value);
+             exit;
+          end;
+        if is_constrealnode(left) then
+          begin
+             trealconstnode(left).value_real:=-trealconstnode(left).value_real;
+             result:=left;
+             left:=nil;
+             exit;
+          end;
+      end;
+
+
     function tunaryminusnode.det_resulttype : tnode;
       var
          t : tnode;
@@ -545,19 +598,9 @@ implementation
          if codegenerror then
            exit;
 
-         { constant folding }
+         result:=simplify;
-         if is_constintnode(left) then
+         if assigned(result) then
-           begin
+           exit;
-              result:=genintconstnode(-tordconstnode(left).value);
-              exit;
-           end;
-         if is_constrealnode(left) then
-           begin
-              trealconstnode(left).value_real:=-trealconstnode(left).value_real;
-              result:=left;
-              left:=nil;
-              exit;
-           end;
 
          resulttype:=left.resulttype;
          if (left.resulttype.def.deftype=floatdef) then
@@ -666,11 +709,78 @@ implementation
       end;
 
 
+    function tnotnode.simplify:tnode;
+      var
+        v : tconstexprint;
+        t : tnode;
+        tt : ttype;
+      begin
+        result:=nil;
+        { Try optmimizing ourself away }
+        if left.nodetype=notn then
+          begin
+            { Double not. Remove both }
+            result:=Tnotnode(left).left;
+            tnotnode(left).left:=nil;
+            exit;
+          end;
+
+        if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
+         begin
+           { Not of boolean expression. Turn around the operator and remove
+             the not. This is not allowed for sets with the gten/lten,
+             because there is no ltn/gtn support }
+           if (taddnode(left).left.resulttype.def.deftype<>setdef) or
+              (left.nodetype in [equaln,unequaln]) then
+            begin
+              result:=left;
+              left.nodetype:=boolean_reverse[left.nodetype];
+              left:=nil;
+              exit;
+            end;
+         end;
+
+        { constant folding }
+        if (left.nodetype=ordconstn) then
+          begin
+             v:=tordconstnode(left).value;
+             tt:=left.resulttype;
+             case torddef(left.resulttype.def).typ of
+               bool8bit,
+               bool16bit,
+               bool32bit :
+                 begin
+                   { here we do a boolean(byte(..)) type cast because }
+                   { boolean(<int64>) is buggy in 1.00                }
+                   v:=byte(not(boolean(byte(v))));
+                 end;
+               uchar,
+               uwidechar,
+               u8bit,
+               s8bit,
+               u16bit,
+               s16bit,
+               u32bit,
+               s32bit,
+               s64bit,
+               u64bit :
+                 begin
+                   v:=int64(not int64(v)); { maybe qword is required }
+                   int_to_type(v,tt);
+                 end;
+               else
+                 CGMessage(type_e_mismatch);
+             end;
+             t:=cordconstnode.create(v,tt,true);
+             result:=t;
+             exit;
+          end;
+      end;
+
+
     function tnotnode.det_resulttype : tnode;
       var
          t : tnode;
-         tt : ttype;
-         v : tconstexprint;
       begin
          result:=nil;
          resulttypepass(left);
@@ -680,65 +790,9 @@ implementation
 
          resulttype:=left.resulttype;
 
-         { Try optmimizing ourself away }
+         result:=simplify;
-         if left.nodetype=notn then
+         if assigned(result) then
-           begin
+           exit;
-             { Double not. Remove both }
-             result:=Tnotnode(left).left;
-             Tnotnode(left).left:=nil;
-             exit;
-           end;
-
-         if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
-          begin
-            { Not of boolean expression. Turn around the operator and remove
-              the not. This is not allowed for sets with the gten/lten,
-              because there is no ltn/gtn support }
-            if (taddnode(left).left.resulttype.def.deftype<>setdef) or
-               (left.nodetype in [equaln,unequaln]) then
-             begin
-               result:=left;
-               left.nodetype:=boolean_reverse[left.nodetype];
-               left:=nil;
-               exit;
-             end;
-          end;
-
-         { constant folding }
-         if (left.nodetype=ordconstn) then
-           begin
-              v:=tordconstnode(left).value;
-              tt:=left.resulttype;
-              case torddef(left.resulttype.def).typ of
-                bool8bit,
-                bool16bit,
-                bool32bit :
-                  begin
-                    { here we do a boolean(byte(..)) type cast because }
-                    { boolean(<int64>) is buggy in 1.00                }
-                    v:=byte(not(boolean(byte(v))));
-                  end;
-                uchar,
-                uwidechar,
-                u8bit,
-                s8bit,
-                u16bit,
-                s16bit,
-                u32bit,
-                s32bit,
-                s64bit,
-                u64bit :
-                  begin
-                    v:=int64(not int64(v)); { maybe qword is required }
-                    int_to_type(v,tt);
-                  end;
-                else
-                  CGMessage(type_e_mismatch);
-              end;
-              t:=cordconstnode.create(v,tt,true);
-              result:=t;
-              exit;
-           end;
 
          if is_boolean(resulttype.def) then
            begin