* backup commit of more dfa stuff

git-svn-id: trunk@7287 -

compiler/node.pas

@@ -203,6 +203,7 @@ interface
          nf_pass1_done,
          nf_write,       { Node is written to            }
          nf_isproperty,
+         nf_processing,
 
          { taddrnode }
          nf_typedaddr,
@@ -250,6 +251,7 @@ interface
 
          { tblocknode }
          nf_block_with_exit
+
        );
 
        tnodeflags = set of tnodeflag;
@@ -359,6 +361,9 @@ interface
          procedure printnodetree(var t:text);virtual;
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
+
+         { ensures that the optimizer info record is allocated }
+         function allocoptinfo : poptinfo;inline;
       end;
 
       tnodeclass = class of tnode;
@@ -775,6 +780,8 @@ implementation
          if firstpasscount>maxfirstpasscount then
             maxfirstpasscount:=firstpasscount;
 {$endif EXTDEBUG}
+         if assigned(optinfo) then
+           dispose(optinfo);
       end;
 
 
@@ -905,6 +912,14 @@ implementation
       end;
 
 
+    { ensures that the optimizer info record is allocated }
+    function tnode.allocoptinfo : poptinfo;inline;
+      begin
+        if not(assigned(optinfo)) then
+          new(optinfo);
+        result:=optinfo;
+      end;
+
 {****************************************************************************
                                  TUNARYNODE
  ****************************************************************************}

compiler/optbase.pas

@@ -29,17 +29,127 @@ unit optbase;
       globtype;
 
     type
+      { this should maybe replaced by a spare set,
+        using a dyn. array makes assignments cheap }
       tdfaset = array of byte;
 
       toptinfo = record
         { index of the current node inside the dfa sets, aword(-1) if no entry }
         index : aword;
-        defined_nodes : tdfaset;
-        used_nodes : tdfaset;
+        def : tdfaset;
+        use : tdfaset;
+        life : tdfaset;
       end;
 
       poptinfo = ^toptinfo;
 
+    { basic set operations for dfa sets }
+    procedure TDFASetInclude(var s : tdfaset;e : integer);
+    procedure TDFASetExclude(var s : tdfaset;e : integer);
+    function TDFASetIn(const s : tdfaset;e : integer) : boolean;
+    procedure TDFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
+    procedure TDFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
+    procedure TDFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
+    function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
+
   implementation
 
+    uses
+      cutils;
+
+    procedure TDFASetInclude(var s : tdfaset;e : integer);
+      var
+        e8 : Integer;
+      begin
+        e8:=e div 8;
+        if e8>high(s) then
+          SetLength(s,e8+1);
+        s[e8]:=s[e8] or (1 shl (e mod 8));
+      end;
+
+
+    procedure TDFASetExclude(var s : tdfaset;e : integer);
+      var
+        e8 : Integer;
+      begin
+        e8:=e div 8;
+        if e8>high(s) then
+          SetLength(s,e8+1);
+        s[e8]:=s[e8] and not(1 shl (e mod 8));
+      end;
+
+
+    function TDFASetIn(const s : tdfaset;e : integer) : boolean;
+      var
+        e8 : Integer;
+      begin
+        result:=false;
+        e8:=e div 8;
+        if e8>high(s) then
+          exit;
+        result:=(s[e8] and (1 shl (e mod 8)))<>0;
+      end;
+
+
+    procedure TDFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
+      var
+        i : integer;
+      begin
+        SetLength(d,max(Length(s1),Length(s2)));
+        for i:=0 to high(s1) do
+          d[i]:=s1[i];
+        for i:=0 to high(s2) do
+          d[i]:=d[i] or s2[i];
+      end;
+
+
+    procedure TDFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
+      var
+        i : integer;
+      begin
+        SetLength(d,min(Length(s1),Length(s2)));
+        for i:=0 to min(high(s1),high(s2)) do
+          d[i]:=s1[i] and s2[i];
+      end;
+
+
+    procedure TDFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
+      var
+        i : integer;
+      begin
+        SetLength(d,min(Length(s1),Length(s2)));
+        for i:=0 to min(high(s1),high(s2)) do
+          d[i]:=s1[i] and not(s2[i]);
+      end;
+
+
+    function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
+      var
+        i : integer;
+      begin
+        result:=true;
+        { one set could be larger than the other }
+        if length(s1)>length(s2) then
+          begin
+            for i:=0 to high(s2) do
+              if s1[i]<>s2[i] then
+                exit;
+            { check remaining part being zero }
+            for i:=length(s2) to high(s1) do
+              if s1[i]<>0 then
+                exit;
+          end
+        else
+          begin
+            for i:=0 to high(s1) do
+              if s1[i]<>s2[i] then
+                exit;
+            { check remaining part being zero }
+            for i:=length(s1) to high(s2) do
+              if s2[i]<>0 then
+                exit;
+          end;
+        result:=false;
+      end;
+
 end.

compiler/optdfa.pas

@@ -28,6 +28,10 @@ unit optdfa;
     uses
       node;
 
+    { reset all dfa info, this is required before creating dfa info
+      if the tree has been changed without updating dfa }
+    procedure resetdfainfo(node : tnode);
+
     procedure createoptinfo(node : tnode);
 
   implementation
@@ -54,8 +58,6 @@ unit optdfa;
       end;
 
 
-
-
     {
       x:=f;         read: [f]
 
@@ -83,16 +85,130 @@ unit optdfa;
 
     type
       tdfainfo = record
-        definitionlist : tfplist;
-        lifelist : tfplist;
+        use : TDFASet;
+        def : TDFASet;
+        map : TIndexedNodeSet
+      end;
+
+    procedure AddDefUse(s : TDFASet;m : ;n : tnode);
+      begin
+        while true do
+          begin
+            case n.nodetype of
+              typeconvn:
+                n:=ttypeconvnode(n).left;
+              loadn:
+                begin
+                  m.Add(n);
+                  TDFASetInclude(s,n.optinfo^.index);
+                end;
+              else
+                internalerror(2007050601);
+            end;
+          end;
       end;
 
+
+    procedure CreateLifeInfo(node : tnode);
+
+      var
+        changed : boolean;
+
+      procedure CreateInfo(node : tnode);
+
+        procedure updatelifeinfo(n : tnode;l : TDFASet);
+          begin
+            changed:=changed or DFASetNotEqual(l,n.life);
+            node.life:=l;
+          end;
+
+        procedure calclife(n : tnode);
+          var
+            l : TDFANode;
+          begin
+            if assigned(successor) then
+              begin
+                DFASetDiff(l,successor.optinfo^.life,n.optinfo^.def);
+                DFASetIncludeSet(l,n.optinfo^.use);
+                updatelifeinfo(n,l);
+              end
+          end
+
+        var
+          dfainfo : tdfainfo;
+        begin
+          if nf_processing in node.flags then
+            exit;
+          include(node,nf_processing);
+
+          if assigned(node.successor) then
+            CreateInfo(node.successor);
+
+          { life:=succesorlive-definition+use }
+
+          case node.nodetype of
+            whilen:
+              begin
+                { first, do things as usual, get life information from the successor }
+
+                { life:=succesorlive-definition+use }
+
+                { now iterate through the loop }
+                CreateInfo(twhilenode(node).left);
+
+                { update while node }
+                { life:=life+left.life }
+
+                { ... and a second iteration for fast convergence }
+                CreateInfo(twhilenode(node).left);
+              end;
+            statementn:
+              begin
+                { actually an expression doing something? }
+                case tstatementnode(node).statement.nodetype of
+                  assignn:
+                    begin
+                      tstatementnode(node).allocoptinfo;
+                      if not(assigned(tstatementnode(node).optinfo^.def)) or
+                        not(assigned(tstatementnode(node).optinfo^.use)) then
+                        begin
+                          dfainfo.use:=tstatementnode(node).optinfo^.use;
+                          dfainfo.def:=tstatementnode(node).optinfo^.def;
+                          Foreach
+                        end;
+                      calclife(node);
+                    end;
+                end;
+              end;
+            else
+              internalerror(2007050502);
+          end;
+
+          exclude(node,nf_processing);
+        end;
+
+      begin
+        repeat
+          changed:=false;
+          CreateInfo(node);
+        until not(changed);
+      end;
+
+
+    { reset all dfa info, this is required before creating dfa info
+      if the tree has been changed without updating dfa }
+    procedure resetdfainfo(node : tnode);
+      begin
+      end;
+
+
     procedure createdfainfo(node : tnode);
       begin
-        { first, add controll flow information }
+        { add controll flow information }
         SetNodeSucessors(node);
-        { now, collect life information }
 
+        { now, collect life information }
+        CreateLifeInfo(node);
       end;
 
 

compiler/optutils.pas

@@ -28,6 +28,19 @@ unit optutils;
     uses
       node;
 
+    type
+      { this implementation should be really improved,
+        its purpose is to find equal nodes }
+      TIndexedNodeSet = class(TFPList)
+        function Add(node : tnode) : boolean;
+        function Includes(node : tnode) : tnode;
+        function Remove(node : tnode) : boolean;
+      end;
+
+      TNodeMap = class(TNodeSet)
+        function (node : tnode) : boolean;
+      end;
+
     procedure SetNodeSucessors(p : tnode);
 
   implementation
@@ -35,6 +48,66 @@ unit optutils;
     uses
       nbas,nflw;
 
+    function TIndexedNodeSet.Add(node : tnode) : boolean;
+      var
+        i : Integer;
+        p : tnode;
+      begin
+        node.allocoptinfo;
+        p:=Includes(node);
+        if assigned(p) then
+          begin
+            result:=false;
+            node.optinfo^.index:=p.optinfo^.index;
+          end
+        else
+          begin
+            i:=Add(node);
+            node.optinfo^.index:=i;
+            result:=true;
+          end
+      end;
+
+
+    function TIndexedNodeSet.Includes(node : tnode) : tnode;
+      var
+        i : longint;
+      begin
+        for i:=0 to FCount-1 do
+          if tnode(FList^[i]).isequal(node) then
+            begin
+              result:=tnode(FList^[i]);
+              exit;
+            end;
+        result:=nil;
+      end;
+
+
+    function TIndexedNodeSet.Remove(node : tnode) : boolean;
+      var
+        p : tnode;
+      begin
+        result:=false;
+        p:=Includes(node);
+        if assigned(p) then
+          begin
+            if Remove(p)<>-1 then
+              result:=true;
+          end;
+      end;
+
+
+    procedure PrintIndexedNodeSet(f : text;s : TIndexedNodeSet);
+      begin
+        for i:=0 to high(s) do
+          begin
+            writeln(f,'=============================== Node ',i,' ===============================');
+            printnode(f,s[i]);
+            writeln(f);
+          end;
+      end;
+
+
     procedure SetNodeSucessors(p : tnode);
       var
         Continuestack : TFPList;