+ first basically working (not all node types yet) dfa implementation determining life information

git-svn-id: trunk@7294 -

compiler/defcmp.pas

@@ -914,6 +914,24 @@ implementation
                          eq:=te_convert_l1;
                        end;
                    end;
+{
+                 enumdef :
+                   begin
+                     { allow explicit typecasts from enums to pointer.
+		       Support for delphi compatibility
+                     }
+                     if (eq=te_incompatible) and
+                        (((cdo_explicit in cdoptions) and
+                          (m_delphi in current_settings.modeswitches)
+ 		         ) or
+			 (cdo_internal in cdoptions)
+			) then
+                       begin
+                         doconv:=tc_int_2_int;
+                         eq:=te_convert_l1;
+                       end;
+                   end;
+}
                  arraydef :
                    begin
                      { string constant (which can be part of array constructor)

compiler/globtype.pas

@@ -153,7 +153,8 @@ interface
        toptimizerswitch = (cs_opt_none,
          cs_opt_level1,cs_opt_level2,cs_opt_level3,
          cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
-         cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse
+         cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
+         cs_opt_nodedfa
        );
        toptimizerswitches = set of toptimizerswitch;
 
@@ -161,7 +162,7 @@ interface
        OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('',
          'LEVEL1','LEVEL2','LEVEL3',
          'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
-         'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE'
+         'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE','DFA'
        );
 
        { switches being applied to all CPUs at the given level }

compiler/optbase.pas

@@ -32,6 +32,7 @@ unit optbase;
       { this should maybe replaced by a spare set,
         using a dyn. array makes assignments cheap }
       tdfaset = array of byte;
+      PDFASet = ^TDFASet;
 
       toptinfo = record
         { index of the current node inside the dfa sets, aword(-1) if no entry }
@@ -44,31 +45,69 @@ unit optbase;
       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);
+
+    { add e to s }
+    procedure DFASetInclude(var s : tdfaset;e : integer);
+
+    { add s to d }
+    procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
+
+    { remove e from s }
+    procedure DFASetExclude(var s : tdfaset;e : integer);
+
+    { test if s contains e }
+    function DFASetIn(const s : tdfaset;e : integer) : boolean;
+
+    { d:=s1+s2; }
+    procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
+
+    { d:=s1*s2; }
+    procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
+
+    { d:=s1-s2; }
+    procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
+
+    { s1<>s2; }
     function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
 
+    { output DFA set }
+    procedure PrintDFASet(var f : text;s : TDFASet);
+
   implementation
 
     uses
       cutils;
 
-    procedure TDFASetInclude(var s : tdfaset;e : integer);
+    procedure DFASetInclude(var s : tdfaset;e : integer);
       var
+        i,
+        oldhigh,
         e8 : Integer;
       begin
         e8:=e div 8;
         if e8>high(s) then
-          SetLength(s,e8+1);
+          begin
+            oldhigh:=high(s);
+            SetLength(s,e8+1);
+            for i:=oldhigh+1 to high(s) do
+              s[i]:=0;
+          end;
         s[e8]:=s[e8] or (1 shl (e mod 8));
       end;
 
 
-    procedure TDFASetExclude(var s : tdfaset;e : integer);
+    procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
+      var
+        i : integer;
+      begin
+        if length(s)>length(d) then
+          SetLength(d,length(s));
+        for i:=0 to high(s) do
+          d[i]:=d[i] or s[i];
+      end;
+
+
+    procedure DFASetExclude(var s : tdfaset;e : integer);
       var
         e8 : Integer;
       begin
@@ -79,7 +118,7 @@ unit optbase;
       end;
 
 
-    function TDFASetIn(const s : tdfaset;e : integer) : boolean;
+    function DFASetIn(const s : tdfaset;e : integer) : boolean;
       var
         e8 : Integer;
       begin
@@ -91,7 +130,7 @@ unit optbase;
       end;
 
 
-    procedure TDFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
+    procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
       var
         i : integer;
       begin
@@ -103,7 +142,7 @@ unit optbase;
       end;
 
 
-    procedure TDFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
+    procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
       var
         i : integer;
       begin
@@ -113,13 +152,16 @@ unit optbase;
       end;
 
 
-    procedure TDFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
+    procedure DFASetDiff(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]);
+        SetLength(d,length(s1));
+        for i:=0 to high(d) do
+          if i>high(s2) then
+            d[i]:=s1[i]
+          else
+            d[i]:=s1[i] and not(s2[i]);
       end;
 
 
@@ -152,4 +194,24 @@ unit optbase;
         result:=false;
       end;
 
+
+    procedure PrintDFASet(var f : text;s : TDFASet);
+      var
+        i : integer;
+        first : boolean;
+      begin
+        first:=true;
+        for i:=0 to Length(s)*8 do
+          begin
+            if DFASetIn(s,i) then
+              begin
+                if not(first) then
+                  write(f,',');
+                write(f,i);
+                first:=false;
+              end;
+          end;
+      end;
+
+
 end.

compiler/optdfa.pas

@@ -19,6 +19,10 @@
 
  ****************************************************************************
 }
+
+{ $define DEBUG_DFA}
+
+{ this unit implements routines to perform dfa }
 unit optdfa;
 
 {$i fpcdefs.inc}
@@ -32,18 +36,21 @@ unit optdfa;
       if the tree has been changed without updating dfa }
     procedure resetdfainfo(node : tnode);
 
-    procedure createoptinfo(node : tnode);
+    procedure createdfainfo(node : tnode);
 
   implementation
 
     uses
       globtype,globals,
+      verbose,
       cpuinfo,
+      symdef,
       nutils,
       nbas,nflw,ncon,ninl,ncal,
-      optutils;
+      optbase,optutils;
 
 
+    (*
     function initnodes(var n:tnode; arg: pointer) : foreachnoderesult;
       begin
         { node worth to add? }
@@ -56,7 +63,7 @@ unit optdfa;
         else
           result:=fen_norecurse_false;
       end;
-
+    *)
 
     {
       x:=f;         read: [f]
@@ -85,61 +92,104 @@ unit optdfa;
 
     type
       tdfainfo = record
-        use : TDFASet;
-        def : TDFASet;
+        use : PDFASet;
+        def : PDFASet;
         map : TIndexedNodeSet
       end;
+      pdfainfo = ^tdfainfo;
 
-    procedure AddDefUse(s : TDFASet;m : ;n : tnode);
+    function AddDefUse(var n: tnode; arg: pointer): foreachnoderesult;
       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;
+        case n.nodetype of
+          loadn:
+            begin
+              pdfainfo(arg)^.map.Add(n);
+              if nf_write in n.flags then
+                DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index)
               else
-                internalerror(2007050601);
+                DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index);
+              {
+              write('Use Set: ');
+              PrintDFASet(output,pdfainfo(arg)^.use^);
+              write(' Def Set: ');
+              PrintDFASet(output,pdfainfo(arg)^.def^);
+              writeln;
+              }
             end;
-          end;
+        end;
+        result:=fen_false;
       end;
 
 
-    procedure CreateLifeInfo(node : tnode);
+    procedure CreateLifeInfo(node : tnode;map : TIndexedNodeSet);
 
       var
         changed : boolean;
 
       procedure CreateInfo(node : tnode);
 
+        { update life entry of a node with l, set changed if this changes
+          life info for the node
+        }
         procedure updatelifeinfo(n : tnode;l : TDFASet);
+          var
+            b : boolean;
           begin
-            changed:=changed or DFASetNotEqual(l,n.life);
-            node.life:=l;
+            b:=DFASetNotEqual(l,n.optinfo^.life);
+            {
+            if b then
+              begin
+                printnode(output,n);
+                printdfaset(output,l);
+                writeln;
+                printdfaset(output,n.optinfo^.life);
+                writeln;
+              end;
+            }
+            changed:=changed or b;
+            node.optinfo^.life:=l;
           end;
 
         procedure calclife(n : tnode);
           var
-            l : TDFANode;
+            l : TDFASet;
           begin
-            if assigned(successor) then
+            n.allocoptinfo;
+            if assigned(n.successor) then
               begin
-                DFASetDiff(l,successor.optinfo^.life,n.optinfo^.def);
+                {
+                write('Successor Life: ');
+                printdfaset(output,n.successor.optinfo^.life);
+                writeln;
+                write('Def.');
+                printdfaset(output,n.optinfo^.def);
+                writeln;
+                }
+                { ensure we can access optinfo }
+                DFASetDiff(l,n.successor.optinfo^.life,n.optinfo^.def);
+                {
+                printdfaset(output,l);
+                writeln;
+                }
                 DFASetIncludeSet(l,n.optinfo^.use);
-                updatelifeinfo(n,l);
+                DFASetIncludeSet(l,n.optinfo^.life);
               end
-          end
+            else
+              l:=n.optinfo^.use;
+            updatelifeinfo(n,l);
+          end;
 
         var
           dfainfo : tdfainfo;
+          l : TDFASet;
+
         begin
+          if node=nil then
+            exit;
+
           if nf_processing in node.flags then
             exit;
-          include(node,nf_processing);
+          include(node.flags,nf_processing);
 
           if assigned(node.successor) then
             CreateInfo(node.successor);
@@ -147,20 +197,36 @@ unit optdfa;
           { life:=succesorlive-definition+use }
 
           case node.nodetype of
-            whilen:
+            whilerepeatn:
               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);
+                calclife(node);
+                if lnf_testatbegin in twhilerepeatnode(node).loopflags then
+                  begin
+                    { first, do things as usual, get life information from the successor }
+                    node.allocoptinfo;
+                    if not(assigned(node.optinfo^.def)) and
+                       not(assigned(node.optinfo^.use)) then
+                      begin
+                        dfainfo.use:[email protected]^.use;
+                        dfainfo.def:[email protected]^.def;
+                        dfainfo.map:=map;
+                        foreachnodestatic(pm_postprocess,twhilerepeatnode(node).left,@AddDefUse,@dfainfo);
+                      end;
+                    calclife(node);
+
+                    { now iterate through the loop }
+                    CreateInfo(twhilerepeatnode(node).right);
+
+                    { update while node }
+                    { life:=life+use+right.life }
+                    l:=node.optinfo^.life;
+                    DFASetIncludeSet(l,node.optinfo^.use);
+                    DFASetIncludeSet(l,twhilerepeatnode(node).right.optinfo^.life);
+                    UpdateLifeInfo(node,l);
+
+                    { ... and a second iteration for fast convergence }
+                    CreateInfo(twhilerepeatnode(node).right);
+                  end;
               end;
             statementn:
               begin
@@ -168,30 +234,58 @@ unit optdfa;
                 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
+                      node.allocoptinfo;
+                      if not(assigned(node.optinfo^.def)) and
+                        not(assigned(node.optinfo^.use)) then
                         begin
-                          dfainfo.use:=tstatementnode(node).optinfo^.use;
-                          dfainfo.def:=tstatementnode(node).optinfo^.def;
-                          Foreach
+                          dfainfo.use:[email protected]^.use;
+                          dfainfo.def:[email protected]^.def;
+                          dfainfo.map:=map;
+                          foreachnodestatic(pm_postprocess,tstatementnode(node).left,@AddDefUse,@dfainfo);
                         end;
                       calclife(node);
                     end;
+                  else
+                    begin
+                      { nested statement }
+                      CreateInfo(tstatementnode(node).statement);
+                      { inherit info }
+                      node.allocoptinfo;
+                      node.optinfo^.life:=tstatementnode(node).statement.optinfo^.life;
+                    end;
                 end;
               end;
+            blockn:
+              begin
+                CreateInfo(tblocknode(node).statements);
+                node.allocoptinfo;
+                if assigned(tblocknode(node).statements) then
+                  node.optinfo^.life:=tblocknode(node).statements.optinfo^.life;
+              end;
             else
               internalerror(2007050502);
           end;
 
-          exclude(node,nf_processing);
+          exclude(node.flags,nf_processing);
         end;
 
+      var
+        runs : integer;
+
       begin
+        runs:=0;
         repeat
+          inc(runs);
           changed:=false;
           CreateInfo(node);
+{$ifdef DEBUG_DFA}
+          PrintIndexedNodeSet(output,map);
+          PrintDFAInfo(output,node);
+{$endif DEBUG_DFA}
         until not(changed);
+{$ifdef DEBUG_DFA}
+        writeln('DFA solver iterations: ',runs);
+{$endif DEBUG_DFA}
       end;
 
 
@@ -203,13 +297,17 @@ unit optdfa;
 
 
     procedure createdfainfo(node : tnode);
+      var
+        map : TIndexedNodeSet;
       begin
+        map:=TIndexedNodeSet.Create;
         { add controll flow information }
         SetNodeSucessors(node);
 
         { now, collect life information }
-        CreateLifeInfo(node);
-      end;
+        CreateLifeInfo(node,map);
 
+        map.free;
+      end;
 
 end.

compiler/optutils.pas

@@ -26,6 +26,7 @@ unit optutils;
   interface
 
     uses
+      cclasses,
       node;
 
     type
@@ -37,16 +38,16 @@ unit optutils;
         function Remove(node : tnode) : boolean;
       end;
 
-      TNodeMap = class(TNodeSet)
-        function (node : tnode) : boolean;
-      end;
-
     procedure SetNodeSucessors(p : tnode);
+    procedure PrintDFAInfo(var f : text;p : tnode);
+    procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
 
   implementation
 
     uses
-      nbas,nflw;
+      verbose,
+      optbase,
+      nbas,nflw,nutils;
 
     function TIndexedNodeSet.Add(node : tnode) : boolean;
       var
@@ -62,7 +63,7 @@ unit optutils;
           end
         else
           begin
-            i:=Add(node);
+            i:=inherited Add(node);
             node.optinfo^.index:=i;
             result:=true;
           end
@@ -73,10 +74,10 @@ unit optutils;
       var
         i : longint;
       begin
-        for i:=0 to FCount-1 do
-          if tnode(FList^[i]).isequal(node) then
+        for i:=0 to Count-1 do
+          if tnode(List^[i]).isequal(node) then
             begin
-              result:=tnode(FList^[i]);
+              result:=tnode(List^[i]);
               exit;
             end;
         result:=nil;
@@ -91,23 +92,47 @@ unit optutils;
         p:=Includes(node);
         if assigned(p) then
           begin
-            if Remove(p)<>-1 then
+            if inherited Remove(p)<>-1 then
               result:=true;
           end;
       end;
 
 
-    procedure PrintIndexedNodeSet(f : text;s : TIndexedNodeSet);
+    procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
+      var
+        i : integer;
       begin
-        for i:=0 to high(s) do
+        for i:=0 to s.count-1 do
           begin
             writeln(f,'=============================== Node ',i,' ===============================');
-            printnode(f,s[i]);
+            printnode(f,tnode(s[i]));
             writeln(f);
           end;
       end;
 
 
+    function PrintNodeDFA(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        if assigned(n.optinfo) and ((n.optinfo^.life<>nil) or (n.optinfo^.use<>nil) or (n.optinfo^.def<>nil)) then
+          begin
+            write(text(arg^),nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,') Life: ');
+            PrintDFASet(text(arg^),n.optinfo^.life);
+            write(text(arg^),' Def: ');
+            PrintDFASet(text(arg^),n.optinfo^.def);
+            write(text(arg^),' Use: ');
+            PrintDFASet(text(arg^),n.optinfo^.use);
+            writeln(text(arg^));
+          end;
+        result:=fen_false;
+      end;
+
+
+    procedure PrintDFAInfo(var f : text;p : tnode);
+      begin
+        foreachnodestatic(pm_postprocess,p,@PrintNodeDFA,@f);
+      end;
+
+
     procedure SetNodeSucessors(p : tnode);
       var
         Continuestack : TFPList;
@@ -119,6 +144,8 @@ unit optutils;
           hp1,hp2 : tnode;
         begin
           result:=nil;
+          if p=nil then
+            exit;
           case p.nodetype of
             statementn:
               begin
@@ -126,36 +153,41 @@ unit optutils;
                 result:=p;
                 while assigned(hp1) do
                   begin
-                    if assigned(tstatementnode(hp1).right) then
+                    { does another statement follow? }
+                    if assigned(tstatementnode(hp1).next) then
                       begin
                         hp2:=DoSet(tstatementnode(hp1).statement,tstatementnode(hp1).next);
                         if assigned(hp2) then
                           tstatementnode(hp1).successor:=hp2
                         else
-                          tstatementnode(hp1).successor:=tstatementnode(hp1).right;
+                          tstatementnode(hp1).successor:=tstatementnode(hp1).next;
                       end
                     else
                       begin
-                        hp2:=DoSet(tstatementnode(hp1).statement,successor);
+                        hp2:=DoSet(tstatementnode(hp1).statement,succ);
                         if assigned(hp2) then
                           tstatementnode(hp1).successor:=hp2
                         else
-                          tstatementnode(hp1).successor:=successor;
+                          tstatementnode(hp1).successor:=succ;
                       end;
+                    hp1:=tstatementnode(hp1).next;
                   end;
               end;
             blockn:
               begin
-                result:=DoSet(tblocknode(p).statements,successor);
+                result:=p;
+                DoSet(tblocknode(p).statements,succ);
+                p.successor:=succ;
               end;
             forn:
               begin
-                Breakstack.Add(successor);
+                Breakstack.Add(succ);
                 Continuestack.Add(p);
                 result:=p;
-                DoSet(tfornode(p).statements,successor);
-                Breakstack.Delete(Count-1);
-                Continuestack.Delete(Count-1);
+                { the successor of the last node of the for body is the for node itself }
+                DoSet(tfornode(p).t2,p);
+                Breakstack.Delete(Breakstack.Count-1);
+                Continuestack.Delete(Continuestack.Count-1);
               end;
             breakn:
               begin
@@ -167,6 +199,17 @@ unit optutils;
                 result:=p;
                 p.successor:=tnode(Continuestack.Last);
               end;
+            whilerepeatn:
+              begin
+                Breakstack.Add(succ);
+                Continuestack.Add(p);
+                result:=p;
+                { the successor of the last node of the for body is the while node itself }
+                DoSet(twhilerepeatnode(p).right,p);
+                p.successor:=succ;
+                Breakstack.Delete(Breakstack.Count-1);
+                Continuestack.Delete(Continuestack.Count-1);
+              end;
             { exit is actually a jump to some final. code
             exitn:
               begin
@@ -175,7 +218,6 @@ unit optutils;
               end;
             }
             ifn,
-            whilerepeatn,
             exitn,
             withn,
             casen,

compiler/psub.pas

@@ -103,7 +103,8 @@ implementation
        tgobj,cgbase,cgobj,dbgbase,
        ncgutil,regvars,
        opttail,
-       optcse
+       optcse,
+       optdfa
 {$if defined(arm) or defined(powerpc) or defined(powerpc64)}
        ,aasmcpu
 {$endif arm}
@@ -755,6 +756,11 @@ implementation
           (pi_is_recursive in flags) then
           do_opttail(code,procdef);
 
+        if cs_opt_nodedfa in current_settings.optimizerswitches then
+          begin
+            createdfainfo(code);
+          end;
+
         if cs_opt_nodecse in current_settings.optimizerswitches then
           do_optcse(code);