* Adapted from patch node-dump-pass-1.patch submitted by J. Gareth Moreton from bug report 38156.

This patch extends the DEBUG_NODE_XML debug feature by also outputting, 
     to the *-node-dump.xml files, the node tree as it appears after the first pass, 
     since it often contains many more internal nodes like temporary allocations that may need
     to be evaluated for debugging and development purposes, or node-level optimisation opportunities.

git-svn-id: trunk@47709 -

compiler/psub.pas

@@ -86,7 +86,7 @@ interface
         function has_assembler_child : boolean;
         procedure set_eh_info; override;
 {$ifdef DEBUG_NODE_XML}
-        procedure XMLPrintProc;
+        procedure XMLPrintProc(FirstHalf: Boolean);
 {$endif DEBUG_NODE_XML}
       end;
 
@@ -1437,14 +1437,18 @@ implementation
 
 
 {$ifdef DEBUG_NODE_XML}
-    procedure tcgprocinfo.XMLPrintProc;
+    procedure tcgprocinfo.XMLPrintProc(FirstHalf: Boolean);
       var
         T: Text;
         W: Word;
         syssym: tsyssym;
+        separate : boolean;
 
       procedure PrintType(Flag: string);
         begin
+          if df_generic in procdef.defoptions then
+            Write(T, ' type="generic ', Flag, '"')
+          else
             Write(T, ' type="', Flag, '"');
         end;
 
@@ -1467,8 +1471,13 @@ implementation
             Exit;
           end;
         {$pop}
-        Write(T, PrintNodeIndention, '<subroutine');
 
+        separate := (df_generic in procdef.defoptions);
+
+        { First half prints the header and the nodes as a "code" tag }
+        if FirstHalf or separate then
+          begin
+            Write(T, PrintNodeIndention, '<subroutine');
             { Check to see if the procedure is a class or object method }
             if Assigned(procdef.struct) then
               begin
@@ -1477,10 +1486,9 @@ implementation
                 else
                   Write(T, ' struct="&lt;NULL&gt;"');
               end;
-
             case procdef.proctypeoption of
-          potype_none: { Do nothing };
+              potype_none:
-
+                { Do nothing - should this be an internal error though? };
               potype_procedure,
               potype_function:
                 if po_classmethod in procdef.procoptions then
@@ -1489,9 +1497,9 @@ implementation
                       PrintType('static class method')
                     else
                       PrintType('class method');
-              end;
+                  end
-            { Do nothing otherwise }
+                else if df_generic in procdef.defoptions then
-
+                  Write(T, ' type="generic"');
               potype_proginit,
               potype_unitinit:
                 PrintType('initialization');
@@ -1522,10 +1530,8 @@ implementation
             end;
 
             Write(T, ' name="', SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
-
             if po_hascallingconvention in procdef.procoptions then
               Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
-
             WriteLn(T, '>');
 
             PrintNodeIndent;
@@ -1555,21 +1561,42 @@ implementation
               PrintOption('noreturn');
             if po_noinline in procdef.procoptions then
               PrintOption('noinline');
+          end;
 
           if Assigned(Code) then
             begin
-            WriteLn(T, PrintNodeIndention, '<code>');
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '<code>')
+              else
+                begin
+                  WriteLn(T); { Line for spacing }
+                  WriteLn(T, PrintNodeIndention, '<firstpass>');
+                end;
+
               PrintNodeIndent;
               XMLPrintNode(T, Code);
               PrintNodeUnindent;
-            WriteLn(T, PrintNodeIndention, '</code>');
-          end
-        else
-          WriteLn(T, PrintNodeIndention, '<code />');
 
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '</code>')
+              else
+                WriteLn(T, PrintNodeIndention, '</firstpass>');
+            end
+          else { Code=Nil }
+            begin
+              { Don't print anything for second half - if there's no code, there's no firstpass }
+              if FirstHalf then
+                WriteLn(T, PrintNodeIndention, '<code />');
+            end;
+
+        { Print footer only for second half }
+        if (not FirstHalf) or separate then
+          begin
             PrintNodeUnindent;
             WriteLn(T, PrintNodeIndention, '</subroutine>');
             WriteLn(T); { Line for spacing }
+          end;
+
         Close(T);
       end;
 {$endif DEBUG_NODE_XML}
@@ -1789,7 +1816,14 @@ implementation
           don't need to generate anything. When it was an empty
           procedure there would be at least a blocknode }
         if not assigned(code) then
+          begin
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(True);
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
             exit;
+          end;
 
         { We need valid code }
         if Errorcount<>0 then
@@ -1883,6 +1917,10 @@ implementation
            (procdef.proccalloption=pocall_safecall) then
           include(flags, pi_needs_implicit_finally);
 {$endif}
+{$ifdef DEBUG_NODE_XML}
+        { Print out nodes as they appear after the first pass }
+        XMLPrintProc(True);
+{$endif DEBUG_NODE_XML}
         { firstpass everything }
         flowcontrol:=[];
         do_firstpass(code);
@@ -1912,7 +1950,14 @@ implementation
           do_optloadmodifystore(code);
 
         { only do secondpass if there are no errors }
-        if (ErrorCount=0) then
+        if (ErrorCount<>0) then
+          begin
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
+          end
+        else
           begin
             create_hlcodegen;
 
@@ -1962,6 +2007,11 @@ implementation
             if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
+{$ifdef DEBUG_NODE_XML}
+            { Print out nodes as they appear after the first pass }
+            XMLPrintProc(False);
+{$endif DEBUG_NODE_XML}
+
             { generate code for the node tree }
             do_secondpass(code);
             aktproccode.concatlist(current_asmdata.CurrAsmList);
@@ -2470,7 +2520,10 @@ implementation
            printproc( 'after parsing');
 
 {$ifdef DEBUG_NODE_XML}
-         XMLPrintProc;
+         { Methods of generic classes don't get any code generated, so output
+           the node tree here }
+         if (df_generic in procdef.defoptions) then
+           XMLPrintProc(True);
 {$endif DEBUG_NODE_XML}
 
          { ... remove symbol tables }