View Issue Details

IDProjectCategoryView StatusLast Update
0035017FPCCompilerpublic2019-06-22 16:13
ReporterJ. Gareth MoretonAssigned ToPierre Muller 
PrioritylowSeverityfeatureReproducibilityN/A
Status resolvedResolutionfixed 
Platformx86_64-win64OSMicrosoft WindowsOS Version10 Enterprise
Product Version3.3.1Product BuildCross-platform 
Target Version3.3.1Fixed in Version3.3.1 
Summary0035017: [Feature] XML node dump
DescriptionThis feature has been discussed a little bit in the fpc-devel message board. If you build the compiler with the define "DEBUG_NODE_DUMP", all source files compiled with it will have their intermediate nodes dumped to an XML file (which have .ppx extensions) - this feature is useful for compiler debugging and development, as being formatted into an XML file, trees can be expanded and collapsed at will with an appropriate viewer, making the nodes easier to navigate and analyse.
Steps To ReproduceApply patch and confirm correct compilation with 'make clean all', 'make clean all FPCOPT="-dDEBUG_NODE_DUMP"', 'make fullcycle' and 'make fullcycle FPCOPT="-dDEBUG_NODE_DUMP"'
Additional InformationCurrently the node dump files only contain the nodes for procedures and functions - things like class declarations and global variables are not yet dumped. Nevertheless, this is a feature in progress and any extensions to it will be greatly appreciated.

The outputting of asm blocks is currently only supported on the x86 family. Other platforms will print the node, but its contents will just be a note saying the feature is not yet supported.
Tagscompiler, debug, node, patch, XML
Fixed in Revision42271
FPCOldBugId0
FPCTarget-
Attached Files
  • xml-node-output-mod3.patch (51,328 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42112)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42112)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42112)
    +++ compiler/nbas.pas	(working copy)
    @@ -83,6 +83,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -251,6 +254,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -266,6 +272,9 @@
               procedure mark_write;override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              private
               tempidx : longint;
             end;
    @@ -286,6 +295,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +336,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -892,7 +912,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -1136,6 +1309,38 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1279,7 +1484,47 @@
             writeln(t,'])');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
    +      var
    +        f : TTempInfoFlag;
    +        NotFirst : Boolean;
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
     
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        notfirst:=false;
    +        for f in tempinfo^.flags do
    +          begin
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', f);
    +                PrintNodeIndent;
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', f);
    +          end;
    +
    +        if NotFirst then
    +          begin
    +            PrintNodeUnindent;
    +            WriteLn(T, '</tempflags>');
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPDELETENODE
     *****************************************************************************}
    @@ -1393,4 +1638,26 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42112)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42112)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42112)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,90 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        cst_ansistring, cst_shortstring, cst_conststring:
    +          begin
    +            { Assume worst-case scenario of every character being >= $80 }
    +            SetLength(OutputStr, len * 2);
    +            Index := 1;
    +
    +            { Check to see if any of the individual characters are extended }
    +            for X := 0 to len - 1 do
    +              begin
    +                CurrentChar := value_str[X];
    +                case CurrentChar of
    +                #$00:
    +                  begin
    +                    { The only way we can really encode a null in UTF-8 }
    +                    OutputStr[Index] := #$C0;
    +                    OutputStr[Index + 1] := #$80;
    +                    Inc(Index, 2);
    +                  end;
    +                #$80..#$BF:
    +                  begin
    +                    OutputStr[Index] := #$C2;
    +                    OutputStr[Index + 1] := CurrentChar;
    +                    Inc(Index, 2);
    +                  end;
    +                #$C0..#$FF:
    +                  begin
    +                    OutputStr[Index] := #$C3;
    +                    OutputStr[Index + 1] := Char(Byte(CurrentChar) and $3F);
    +                    Inc(Index, 2);
    +                  end;
    +                else
    +                  OutputStr[Index] := CurrentChar;
    +                  Inc(Index);
    +                end;
    +              end;
    +
    +            { Truncate to the correct length }
    +            SetLength(OutputStr, Index - 1);
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42112)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,104 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<right>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</right>')
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<t1>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</t1>');
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42112)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42112)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -471,7 +474,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42112)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -481,6 +484,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42112)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,14 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: string): string;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +421,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +442,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,6 +464,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -476,7 +494,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -656,6 +676,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +925,95 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          { We don't need to sanitise the XML for attribute data because it's
    +            inside double quotation marks. [Kit] }
    +          Write(T,' resultdef="', resultdef.typesymbolprettyname, '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function tnode.SanitiseXMLString(const S: string): string;
    +      var
    +        X: Integer;
    +      begin
    +        Result := S;
    +
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            case Result[X] of
    +              '<':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              '>':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              '&':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              '"':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              '''':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&apos;', Result, X);
    +                end;
    +              else
    +                { Do nothing};
    +            end;
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1173,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1307,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1428,24 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end
    +         else
    +           WriteLn(T, PrintNodeIndention, '<third-branch />');
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42112)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42112)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42112)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the PPX file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.1" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod4.patch (51,555 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42112)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42112)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42112)
    +++ compiler/nbas.pas	(working copy)
    @@ -83,6 +83,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -251,6 +254,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -266,6 +272,9 @@
               procedure mark_write;override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              private
               tempidx : longint;
             end;
    @@ -286,6 +295,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +336,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -892,7 +912,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -1136,6 +1309,38 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1279,7 +1484,47 @@
             writeln(t,'])');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
    +      var
    +        f : TTempInfoFlag;
    +        NotFirst : Boolean;
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
     
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        notfirst:=false;
    +        for f in tempinfo^.flags do
    +          begin
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', f);
    +                PrintNodeIndent;
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', f);
    +          end;
    +
    +        if NotFirst then
    +          begin
    +            PrintNodeUnindent;
    +            WriteLn(T, '</tempflags>');
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPDELETENODE
     *****************************************************************************}
    @@ -1393,4 +1638,26 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42112)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42112)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42112)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,84 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +        WriteLn(T, printnodeindention, '<length>', len, '</length>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        cst_ansistring, cst_shortstring, cst_conststring:
    +          begin
    +            { Assume worst-case scenario of every character being >= $80 }
    +            SetLength(OutputStr, len * 2);
    +            Index := 1;
    +
    +            { Check to see if any of the individual characters are extended }
    +            for X := 0 to len - 1 do
    +              begin
    +                CurrentChar := value_str[X];
    +                case CurrentChar of
    +                #$80..#$BF:
    +                  begin
    +                    OutputStr[Index] := #$C2;
    +                    OutputStr[Index + 1] := CurrentChar;
    +                    Inc(Index, 2);
    +                  end;
    +                #$C0..#$FF:
    +                  begin
    +                    OutputStr[Index] := #$C3;
    +                    OutputStr[Index + 1] := Char($80 or (Byte(CurrentChar) and $3F));
    +                    Inc(Index, 2);
    +                  end;
    +                else
    +                  OutputStr[Index] := CurrentChar;
    +                  Inc(Index);
    +                end;
    +              end;
    +
    +            { Truncate to the correct length }
    +            SetLength(OutputStr, Index - 1);
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42112)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,104 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<right>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</right>')
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<t1>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</t1>');
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42112)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42112)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -471,7 +474,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42112)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -481,6 +484,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42112)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,14 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: string): string;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +421,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +442,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,6 +464,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -476,7 +494,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -656,6 +676,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +925,106 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function tnode.SanitiseXMLString(const S: string): string;
    +      var
    +        X: Integer; CurrentChar: Char;
    +      begin
    +        Result := S;
    +
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            CurrentChar := Result[X];
    +            case CurrentChar of
    +              #0:
    +                begin
    +                  { We can't really do much better than this }
    +                  Delete(Result, X, 1);
    +                  Insert('[NULL]', Result, X);
    +                end;
    +              #1..#31:
    +                begin
    +                  { It is this that requires XML 1.1 over XML 1.0 }
    +                  Delete(Result, X, 1);
    +                  Insert('&#x' + hexstr(Byte(CurrentChar), 2) + ';', Result, X);
    +                end;
    +              '<':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              '>':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              '&':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              '"':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              '''':
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&apos;', Result, X);
    +                end;
    +              else
    +                { Do nothing};
    +            end;
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1184,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1318,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1439,24 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end
    +         else
    +           WriteLn(T, PrintNodeIndention, '<third-branch />');
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42112)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42112)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42112)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the dump file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.1" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod5.patch (52,307 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42114)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42114)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42114)
    +++ compiler/nbas.pas	(working copy)
    @@ -83,6 +83,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -251,6 +254,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -266,6 +272,9 @@
               procedure mark_write;override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              private
               tempidx : longint;
             end;
    @@ -286,6 +295,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +336,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -892,7 +912,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -1136,6 +1309,40 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif def CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1279,7 +1486,49 @@
             writeln(t,'])');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
    +      var
    +        f : TTempInfoFlag;
    +        NotFirst : Boolean;
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
     
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif def CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        notfirst:=false;
    +        for f in tempinfo^.flags do
    +          begin
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', f);
    +                PrintNodeIndent;
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', f);
    +          end;
    +
    +        if NotFirst then
    +          begin
    +            PrintNodeUnindent;
    +            WriteLn(T, '</tempflags>');
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPDELETENODE
     *****************************************************************************}
    @@ -1393,4 +1642,28 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif def CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42114)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42114)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42114)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,69 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        cst_ansistring, cst_shortstring, cst_conststring:
    +          begin
    +            { Assume worst-case scenario of every character being >= $80 }
    +            SetLength(OutputStr, len * 2);
    +            Index := 1;
    +
    +            { Check to see if any of the individual characters are extended }
    +            for X := 0 to len - 1 do
    +              begin
    +                CurrentChar := value_str[X];
    +                OutputStr[Index] := CurrentChar;
    +                Inc(Index);
    +              end;
    +
    +            { Truncate to the correct length }
    +            SetLength(OutputStr, Index - 1);
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +        { Always quote like pascal strings }
    +        // OutputStr:='"'+OutputStr+'"';
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42114)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,104 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<right>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</right>')
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<t1>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</t1>');
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42114)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42114)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -471,7 +474,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42114)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -481,6 +484,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42114)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,14 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: string): string;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +421,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +442,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,6 +464,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -476,7 +494,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -494,6 +514,9 @@
     
         uses
            verbose,entfile,comphook,
    +{$ifdef DEBUG_NODE_DUMP}
    +       cutils,
    +{$endif DEBUG_NODE_DUMP}
            symconst,
            nutils,nflw,
            defutil;
    @@ -656,6 +679,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +928,135 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          { We don't need to sanitise the XML for attribute data because it's
    +            inside double quotation marks. [Kit].
    +            Reinstated as it gives errors (PM) }
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function tnode.SanitiseXMLString(const S: string): string;
    +      var
    +        X,val: Integer;
    +        needs_quoting,in_quotes,add_end_quote : boolean;
    +      begin
    +        Result := S;
    +        needs_quoting:=false;
    +        if (Length(S)>1) and (S[1]='"') and (S[Length(S)]='"') then
    +          begin
    +            needs_quoting:=true;
    +            result:=Copy(S,2,Length(S)-2);
    +          end;
    +        in_quotes:=false;
    +        add_end_quote:=true;
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            val:=ord(Result[X]);
    +            if needs_quoting and not in_quotes and
    +               not (val in [0..8,11,12,14..31,128..255]) then
    +              begin
    +                Insert('''', Result, X+1);
    +                in_quotes:=true;
    +              end;
    +            case val of
    +              ord('<'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              ord('>'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              ord('&'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              ord('"'):
    +                begin
    +                  needs_quoting:=true;
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              ord(''''):
    +                begin
    +                  needs_quoting:=true;
    +                  { Simply double it like in pascal strings }
    +                  Insert('''', Result, X);
    +                end;
    +              { Accept TAB #9, \r #10 and \n #13 }
    +              0..8,11,12,14..31,128..255:
    +                begin
    +                  needs_quoting:=true;
    +                  if X=length(S) then
    +                    add_end_quote:=false;
    +                  Delete(Result, X, 1);
    +                  if in_quotes then
    +                    Insert('#'+tostr(val)+'''', Result, X)
    +                  else
    +                    Insert('#'+tostr(val), Result, X);
    +                  in_quotes:=false;
    +                end;
    +            else
    +              { Do nothing }
    +            end;
    +          end;
    +        if needs_quoting then
    +          begin
    +            if (in_quotes) then
    +              result:=''''+result;
    +            if add_end_quote then
    +              result:=result+'''';
    +            result:='"'+result+'"';
    +          end;
    +
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1216,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1350,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1471,24 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end
    +         else
    +           WriteLn(T, PrintNodeIndention, '<third-branch />');
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42114)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42114)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42114)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name=', TNode.SanitiseXMLString('"'+procdef.customprocname([])+'"'));
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the PPX file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod6.patch (51,647 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42114)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42114)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42114)
    +++ compiler/nbas.pas	(working copy)
    @@ -83,6 +83,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -251,6 +254,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -266,6 +272,9 @@
               procedure mark_write;override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              private
               tempidx : longint;
             end;
    @@ -286,6 +295,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +336,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -892,7 +912,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -1136,6 +1309,40 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1279,7 +1486,49 @@
             writeln(t,'])');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
    +      var
    +        f : TTempInfoFlag;
    +        NotFirst : Boolean;
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
     
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +
    +        notfirst:=false;
    +        for f in tempinfo^.flags do
    +          begin
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', f);
    +                PrintNodeIndent;
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', f);
    +          end;
    +
    +        if NotFirst then
    +          begin
    +            PrintNodeUnindent;
    +            WriteLn(T, '</tempflags>');
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPDELETENODE
     *****************************************************************************}
    @@ -1393,4 +1642,28 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      var
    +        PtrStr: string;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
    +        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
    +
    +        case ptruint(tempinfo) of
    +          0..$FFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 4);
    +          $10000..$FFFFFFFF:
    +            PtrStr := hexstr(ptruint(tempinfo), 8);
    +{$ifdef CPU64}
    +          else
    +            PtrStr := hexstr(ptruint(tempinfo), 16);
    +{$endif CPU64}
    +        end;
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42114)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42114)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42114)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,52 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +        WriteLn(T, printnodeindention, '<length>', len, '</length>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42114)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,104 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<right>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</right>')
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<t1>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</t1>');
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42114)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42114)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -471,7 +474,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42114)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -481,6 +484,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42114)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,14 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: string): string;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +421,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +442,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,6 +464,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -476,7 +494,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -494,6 +514,9 @@
     
         uses
            verbose,entfile,comphook,
    +{$ifdef DEBUG_NODE_DUMP}
    +       cutils,
    +{$endif DEBUG_NODE_DUMP}
            symconst,
            nutils,nflw,
            defutil;
    @@ -656,6 +679,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +928,140 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function tnode.SanitiseXMLString(const S: string): string;
    +      var
    +        X, val: Integer;
    +        needs_quoting, in_quotes, add_end_quote: Boolean;
    +      begin
    +        needs_quoting := False;
    +        if (Length(S) > 1) and (S[1]='"') and (S[Length(S)]='"') then
    +          begin
    +            needs_quoting := True;
    +            Result := Copy(S, 2, Length(S) - 2);
    +          end
    +        else
    +          Result := S;
    +
    +        in_quotes := False;
    +        add_end_quote := True;
    +
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            val:=ord(Result[X]);
    +            if needs_quoting and not in_quotes and
    +              not (val in [0..31, 128..255]) then
    +              begin
    +                Insert('''', Result, X + 1);
    +                in_quotes := True;
    +              end;
    +
    +            case val of
    +              Ord('<'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              Ord('>'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              Ord('&'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              Ord('"'):
    +                begin
    +                  needs_quoting := True;
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              Ord(''''):
    +                begin
    +                  needs_quoting:=true;
    +                  { Simply double it like in pascal strings }
    +                  Insert('''', Result, X);
    +                end;
    +
    +              { Control characters and extended characters }
    +              0..31, 128..255:
    +                begin
    +                  needs_quoting := True;
    +                  if X = Length(S) then
    +                    add_end_quote:=false;
    +                  Delete(Result, X, 1);
    +                  if in_quotes then
    +                    Insert('#' + tostr(val) + '''', Result, X)
    +                  else
    +                    Insert('#' + tostr(val), Result, X);
    +
    +                  in_quotes := False;
    +                end;
    +              else
    +                { Do nothing };
    +            end;
    +          end;
    +
    +        if needs_quoting then
    +          begin
    +            if (in_quotes) then
    +              Result := '''' + Result;
    +
    +            if add_end_quote then
    +              Result := Result + '''';
    +
    +            Result := '"' + Result + '"';
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1221,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1355,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1476,24 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end
    +         else
    +           WriteLn(T, PrintNodeIndention, '<third-branch />');
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42114)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42114)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42114)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name=', TNode.SanitiseXMLString('"' + procdef.customprocname([]) + '"'));
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the node dump file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod7.patch (52,513 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42128)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42128)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42128)
    +++ compiler/nbas.pas	(working copy)
    @@ -83,6 +83,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -224,6 +227,9 @@
               procedure includetempflag(flag: ttempinfoflag); inline;
               procedure excludetempflag(flag: ttempinfoflag); inline;
               property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
     
            { a node which will create a (non)persistent temp of a given type with a given  }
    @@ -251,6 +257,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -266,6 +275,9 @@
               procedure mark_write;override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              private
               tempidx : longint;
             end;
    @@ -286,6 +298,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +339,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -892,7 +915,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -939,6 +1115,64 @@
             settempinfoflags(gettempinfoflags-[flag])
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure ttempbasenode.XMLPrintNodeData(var T: Text);
    +(*       ttempinfo = object
    +        private
    +         flags                      : ttempinfoflags;
    +        public
    +         { set to the copy of a tempcreate pnode (if it gets copied) so that the }
    +         { refs and deletenode can hook to this copy once they get copied too    }
    +         hookoncopy                 : ptempinfo;
    +         typedef                    : tdef;
    +         typedefderef               : tderef;
    +         temptype                   : ttemptype;
    +         owner                      : ttempcreatenode;
    +         withnode                   : tnode;
    +         location                   : tlocation;
    +         tempinitcode               : tnode;
    +       end;
    +*)
    +    const
    +       tempflagname : array[ttempinfoflag] of string[30] = (
    +         'may_be_in_reg',
    +         'valid',
    +         'nextref_set_hookoncopy_nil',
    +         'addr_taken',
    +         'executeinitialisation',
    +         'reference',
    +         'readonly',
    +         'nofini',
    +         'const',
    +         'no_final_regsync',
    +         'cleanup_only'
    +         );
    +      var
    +        str: ansistring;
    +        flag : ttempinfoflag;
    +        first : boolean;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        if not assigned(tempinfo) then
    +          exit;
    +        str:='';
    +        first:=false;
    +        for flag:=low(ttempinfoflag) to high(ttempinfoflag) do
    +          if (flag in tempinfo^.flags) then
    +            if first then
    +              begin
    +                str:=tempflagname[flag];
    +                first:=false;
    +              end
    +            else
    +              str:=str+','+tempflagname[flag];
    +        if str<>'' then
    +          str:='flags="'+str+'" ';
    +        str:=str+' typedef="'+tnode.SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname)+'"';
    +        WriteLn(T, PrintNodeIndention, '<tempinfo>', str);
    +        WriteLn(T, PrintNodeIndention, ' temptype="',tempinfo^.temptype, '"</tempinfo>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                               TEMPCREATENODE
    @@ -1136,6 +1370,24 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1279,7 +1531,34 @@
             writeln(t,'])');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
    +      var
    +        f : TTempInfoFlag;
    +        NotFirst : Boolean;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +        notfirst:=false;
    +        for f in tempinfo^.flags do
    +          begin
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', f);
    +                PrintNodeIndent;
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', f);
    +          end;
     
    +        if NotFirst then
    +          begin
    +            PrintNodeUnindent;
    +            WriteLn(T, '</tempflags>');
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPDELETENODE
     *****************************************************************************}
    @@ -1393,4 +1672,12 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42128)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42128)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42128)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,52 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +        WriteLn(T, printnodeindention, '<length>', len, '</length>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42128)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,104 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<right>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</first>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</right>')
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<t1>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</last>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</t1>');
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42128)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42128)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -471,7 +474,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42128)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -481,6 +484,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42128)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,14 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: ansistring): ansistring;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +421,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +442,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,6 +464,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
    @@ -476,7 +494,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -494,6 +514,9 @@
     
         uses
            verbose,entfile,comphook,
    +{$ifdef DEBUG_NODE_DUMP}
    +       cutils,
    +{$endif DEBUG_NODE_DUMP}
            symconst,
            nutils,nflw,
            defutil;
    @@ -656,6 +679,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +928,140 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function tnode.SanitiseXMLString(const S: ansistring): ansistring;
    +      var
    +        X, val: Integer;
    +        needs_quoting, in_quotes, add_end_quote: Boolean;
    +      begin
    +        needs_quoting := False;
    +        if (Length(S) > 1) and (S[1]='"') and (S[Length(S)]='"') then
    +          begin
    +            needs_quoting := True;
    +            Result := Copy(S, 2, Length(S) - 2);
    +          end
    +        else
    +          Result := S;
    +
    +        in_quotes := False;
    +        add_end_quote := True;
    +
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            val:=ord(Result[X]);
    +            if needs_quoting and not in_quotes and
    +              not (val in [0..31, 128..255]) then
    +              begin
    +                Insert('''', Result, X + 1);
    +                in_quotes := True;
    +              end;
    +
    +            case val of
    +              Ord('<'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              Ord('>'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              Ord('&'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              Ord('"'):
    +                begin
    +                  needs_quoting := True;
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              Ord(''''):
    +                begin
    +                  needs_quoting:=true;
    +                  { Simply double it like in pascal strings }
    +                  Insert('''', Result, X);
    +                end;
    +
    +              { Control characters and extended characters }
    +              0..31, 128..255:
    +                begin
    +                  needs_quoting := True;
    +                  if X = Length(S) then
    +                    add_end_quote:=false;
    +                  Delete(Result, X, 1);
    +                  if in_quotes then
    +                    Insert('#' + tostr(val) + '''', Result, X)
    +                  else
    +                    Insert('#' + tostr(val), Result, X);
    +
    +                  in_quotes := False;
    +                end;
    +              else
    +                { Do nothing };
    +            end;
    +          end;
    +
    +        if needs_quoting then
    +          begin
    +            if (in_quotes) then
    +              Result := '''' + Result;
    +
    +            if add_end_quote then
    +              Result := Result + '''';
    +
    +            Result := '"' + Result + '"';
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1221,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1355,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1476,24 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end
    +         else
    +           WriteLn(T, PrintNodeIndention, '<third-branch />');
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42128)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42128)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42128)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name=', TNode.SanitiseXMLString('"' + procdef.customprocname([]) + '"'));
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the node dump file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod8.patch (56,868 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42124)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42124)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42124)
    +++ compiler/nbas.pas	(working copy)
    @@ -37,6 +37,9 @@
               constructor create;virtual;
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tnothingnodeclass = class of tnothingnode;
     
    @@ -83,6 +86,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -224,6 +230,10 @@
               procedure includetempflag(flag: ttempinfoflag); inline;
               procedure excludetempflag(flag: ttempinfoflag); inline;
               property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
     
            { a node which will create a (non)persistent temp of a given type with a given  }
    @@ -251,6 +261,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -286,6 +299,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +340,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -395,6 +419,15 @@
             expectloc:=LOC_VOID;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
    +        WriteLn(T, ' />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TFIRSTERROR
    @@ -892,7 +925,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -939,7 +1125,48 @@
             settempinfoflags(gettempinfoflags-[flag])
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        { The raw pointer is the only way to uniquely identify the temp }
    +        Write(T, ' id="', WritePointer(tempinfo), '"');
    +      end;
    +
    +
    +    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
    +      var
    +        Flag: TTempInfoFlag;
    +        NotFirst: Boolean;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +
    +        if not assigned(tempinfo) then
    +          exit;
    +
    +        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');
    +
    +        NotFirst := False;
    +        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
    +          if (Flag in tempinfo^.flags) then
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', Flag);
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', Flag);
    +
    +        if NotFirst then
    +          WriteLn(T, '</tempflags>')
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempflags />');
    +
    +        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPCREATENODE
     *****************************************************************************}
    @@ -1136,6 +1363,24 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1393,4 +1638,12 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42124)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42124)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42124)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,52 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +        WriteLn(T, printnodeindention, '<length>', len, '</length>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42124)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,120 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '<then>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '<first>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '<right>');
    +            end;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '</then>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '</first>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '</right>');
    +            end;
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '<else>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '<last>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '<t1>');
    +            end;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '</else>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '</last>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '</t1>');
    +            end;
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42124)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42124)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -97,6 +100,9 @@
               function track_state_pass(exec_known:boolean):boolean;override;
            {$endif state_tracking}
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tassignmentnodeclass = class of tassignmentnode;
     
    @@ -471,7 +477,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    @@ -956,6 +972,18 @@
     {$endif}
     
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { For assignments, put the left and right branches on the same level for clarity }
    +        XMLPrintNode(T, Left);
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
     {*****************************************************************************
                                TARRAYCONSTRUCTORRANGENODE
     *****************************************************************************}
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42124)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -121,6 +124,9 @@
               function docompare(p: tnode): boolean; override;
               function pass_typecheck:tnode;override;
               procedure mark_write;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tsubscriptnodeclass = class of tsubscriptnode;
     
    @@ -133,6 +139,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               procedure mark_write;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tvecnodeclass = class of tvecnode;
     
    @@ -481,6 +490,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    @@ -897,6 +929,13 @@
               (vs = tsubscriptnode(p).vs);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TSubscriptNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<field>', vs.Name, '</field>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                    TVECNODE
    @@ -1297,6 +1336,24 @@
         end;
     
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TVecNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        XMLPrintNode(T, Left);
    +
    +        { The right node is the index }
    +        WriteLn(T, PrintNodeIndention, '<index>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</index>');
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
         function is_big_untyped_addrnode(p: tnode): boolean;
           begin
             is_big_untyped_addrnode:=(p.nodetype=addrn) and
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42124)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,15 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: ansistring): ansistring;
    +         class function WritePointer(const P: Pointer): ansistring;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +422,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +443,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,11 +465,17 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
              constructor create(t:tnodetype;l,r : tnode);virtual;
              function docompare(p : tnode) : boolean;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
         var
    @@ -476,7 +498,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -494,6 +518,9 @@
     
         uses
            verbose,entfile,comphook,
    +{$ifdef DEBUG_NODE_DUMP}
    +       cutils,
    +{$endif DEBUG_NODE_DUMP}
            symconst,
            nutils,nflw,
            defutil;
    @@ -656,6 +683,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +932,168 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function TNode.WritePointer(const P: Pointer): ansistring;
    +      begin
    +        case PtrUInt(P) of
    +          0:
    +            WritePointer := 'nil';
    +          1..$FFFF:
    +            WritePointer := '$' + hexstr(PtrUInt(P), 4);
    +          $10000..$FFFFFFFF:
    +            WritePointer := '$' + hexstr(PtrUInt(P), 8);
    +{$ifdef CPU64}
    +          else
    +            WritePointer := '$' + hexstr(PtrUInt(P), 16);
    +{$endif CPU64}
    +        end;
    +      end;
    +
    +    class function TNode.SanitiseXMLString(const S: ansistring): ansistring;
    +      var
    +        X, CurrentChar: Integer;
    +        needs_quoting, in_quotes, add_end_quote: Boolean;
    +      begin
    +        needs_quoting := False;
    +        Result := S;
    +
    +        { By setting in_quotes to false here, we can exclude the single
    +          quotation marks surrounding the string if it doesn't contain any
    +          control characters, or consists entirely of control characters. }
    +        in_quotes := False;
    +
    +        add_end_quote := True;
    +
    +        { Check the string for anything that could be mistaken for an XML element }
    +        for X := Length(Result) downto 1 do
    +          begin
    +            CurrentChar := Ord(Result[X]);
    +
    +            { Control characters and extended characters need special handling }
    +            if (CurrentChar in [0..31, 128..255]) then
    +              begin
    +                if X = Length(Result) then
    +                  add_end_quote := False;
    +
    +                Delete(Result, X, 1);
    +                if in_quotes then
    +                  begin
    +                    Insert('#' + tostr(CurrentChar) + '''', Result, X);
    +
    +                    { If the entire string consists of control characters, it
    +                      doesn't need quoting, so only set the flag here }
    +                    needs_quoting := True;
    +
    +                    in_quotes := False;
    +                  end
    +                else
    +                  Insert('#' + tostr(CurrentChar), Result, X);
    +              end
    +            else
    +              begin
    +                if not in_quotes then
    +                  begin
    +                    in_quotes := True;
    +                    if (X < Length(Result)) then
    +                      begin
    +                        needs_quoting := True;
    +                        Insert('''', Result, X + 1)
    +                      end;
    +                  end;
    +
    +                case CurrentChar of
    +                  Ord('#'):
    +                    { Required to differentiate '#27' from the escape code #27, for example }
    +                    needs_quoting:=true;
    +
    +                  Ord('<'):
    +                    begin
    +                      Delete(Result, X, 1);
    +                      Insert('&lt;', Result, X);
    +                    end;
    +                  Ord('>'):
    +                    begin
    +                      Delete(Result, X, 1);
    +                      Insert('&gt;', Result, X);
    +                    end;
    +                  Ord('&'):
    +                    begin
    +                      Delete(Result, X, 1);
    +                      Insert('&amp;', Result, X);
    +                    end;
    +                  Ord('"'):
    +                    begin
    +                      needs_quoting := True;
    +                      Delete(Result, X, 1);
    +                      Insert('&quot;', Result, X);
    +                    end;
    +                  Ord(''''):
    +                    begin
    +                      needs_quoting:=true;
    +                      { Simply double it like in pascal strings }
    +                      Insert('''', Result, X);
    +                    end;
    +                  else
    +                    { Do nothing };
    +                end;
    +              end;
    +          end;
    +
    +        if needs_quoting then
    +          begin
    +            if in_quotes then
    +              Result := '''' + Result;
    +
    +            if add_end_quote then
    +              Result := Result + '''';
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1253,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1387,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1508,22 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end;
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    @@ -1320,6 +1557,18 @@
                 right.isequal(tbinopnode(p).left));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinOpNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { For binary operations, put the left and right branches on the same level for clarity }
    +        XMLPrintNode(T, Left);
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
     begin
     {$push}{$warnings off}
       { tvaroption must fit into a 4 byte set for speed reasons }
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42124)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42124)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42124)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the node dump file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    
  • xml-node-output-mod9.patch (63,505 bytes)
    Index: compiler/finput.pas
    ===================================================================
    --- compiler/finput.pas	(revision 42248)
    +++ compiler/finput.pas	(working copy)
    @@ -145,6 +145,9 @@
               objfilename,              { fullname of the objectfile }
               asmfilename,              { fullname of the assemblerfile }
               ppufilename,              { fullname of the ppufile }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilename,              { fullname of the intermediate node XML file }
    +{$endif DEBUG_NODE_DUMP}
               importlibfilename,        { fullname of the import libraryfile }
               staticlibfilename,        { fullname of the static libraryfile }
               sharedlibfilename,        { fullname of the shared libraryfile }
    @@ -154,6 +157,9 @@
               dbgfilename,              { fullname of the debug info file }
               path,                     { path where the module is find/created }
               outputpath   : TPathStr;  { path where the .s / .o / exe are created }
    +{$ifdef DEBUG_NODE_DUMP}
    +          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
    +{$endif DEBUG_NODE_DUMP}
               constructor create(const s:string);
               destructor destroy;override;
               procedure setfilename(const fn:TPathStr;allowoutput:boolean);
    @@ -625,6 +631,9 @@
              asmfilename:=p+n+target_info.asmext;
              objfilename:=p+n+target_info.objext;
              ppufilename:=p+n+target_info.unitext;
    +{$ifdef DEBUG_NODE_DUMP}
    +         ppxfilename:=p+n+'-node-dump.xml';
    +{$endif DEBUG_NODE_DUMP}
              importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
              staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
              exportfilename:=p+'exp'+n+target_info.objext;
    @@ -668,6 +677,9 @@
             realmodulename:=stringdup(s);
             mainsource:='';
             ppufilename:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        ppxfilename:='';
    +{$endif DEBUG_NODE_DUMP}
             objfilename:='';
             asmfilename:='';
             importlibfilename:='';
    @@ -679,6 +691,12 @@
             outputpath:='';
             paramfn:='';
             path:='';
    +{$ifdef DEBUG_NODE_DUMP}
    +        { Setting ppxfilefail to true will stop it from being written to if it
    +          was never initialised, which happens if a module doesn't need
    +          recompiling. }
    +        ppxfilefail := True;
    +{$endif DEBUG_NODE_DUMP}
             { status }
             state:=ms_registered;
             { unit index }
    Index: compiler/i8086/n8086con.pas
    ===================================================================
    --- compiler/i8086/n8086con.pas	(revision 42248)
    +++ compiler/i8086/n8086con.pas	(working copy)
    @@ -35,6 +35,9 @@
           ti8086pointerconstnode = class(tcgpointerconstnode)
             constructor create(v : TConstPtrUInt;def:tdef);override;
             procedure printnodedata(var t: text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             procedure pass_generate_code;override;
           end;
     
    @@ -70,6 +73,15 @@
               inherited printnodedata(t);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
    +          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
    +        else
    +          inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure ti8086pointerconstnode.pass_generate_code;
           begin
    Index: compiler/nbas.pas
    ===================================================================
    --- compiler/nbas.pas	(revision 42248)
    +++ compiler/nbas.pas	(working copy)
    @@ -37,6 +37,9 @@
               constructor create;virtual;
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tnothingnodeclass = class of tnothingnode;
     
    @@ -83,6 +86,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tasmnodeclass = class of tasmnode;
     
    @@ -224,6 +230,10 @@
               procedure includetempflag(flag: ttempinfoflag); inline;
               procedure excludetempflag(flag: ttempinfoflag); inline;
               property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
     
            { a node which will create a (non)persistent temp of a given type with a given  }
    @@ -251,6 +261,9 @@
               function pass_typecheck: tnode; override;
               function docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
             end;
            ttempcreatenodeclass = class of ttempcreatenode;
     
    @@ -286,6 +299,9 @@
               function docompare(p: tnode): boolean; override;
               destructor destroy; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              protected
               release_to_normal : boolean;
             private
    @@ -324,6 +340,14 @@
           pass_1,
           nutils,nld,
           procinfo
    +{$ifdef DEBUG_NODE_DUMP}
    +{$ifndef jvm}
    +      ,
    +      cpubase,
    +      cutils,
    +      itcpugas
    +{$endif jvm}
    +{$endif DEBUG_NODE_DUMP}
           ;
     
     
    @@ -395,6 +419,15 @@
             expectloc:=LOC_VOID;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
    +        WriteLn(T, ' />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TFIRSTERROR
    @@ -892,7 +925,160 @@
             docompare := false;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAsmNode.XMLPrintNodeData(var T: Text);
     
    +      procedure PadString(var S: string; Len: Integer);
    +        var
    +          X, C: Integer;
    +        begin
    +          C := Length(S);
    +          if C < Len then
    +            begin
    +              SetLength(S, 7);
    +              for X := C + 1 to Len do
    +                S[X] := ' '
    +            end;
    +        end;
    +
    +{$ifndef jvm}
    +      function FormatOp(const Oper: POper): string;
    +        begin
    +          case Oper^.typ of
    +            top_const:
    +              begin
    +                case Oper^.val of
    +                  -15..15:
    +                    Result := '$' + tostr(Oper^.val);
    +                  $10..$FF:
    +                    Result := '$0x' + hexstr(Oper^.val, 2);
    +                  $100..$FFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 4);
    +                  $10000..$FFFFFFFF:
    +                    Result := '$0x' + hexstr(Oper^.val, 8);
    +                  else
    +                    Result := '$0x' + hexstr(Oper^.val, 16);
    +                end;
    +              end;
    +            top_reg:
    +              Result := gas_regname(Oper^.reg);
    +            top_ref:
    +              with Oper^.ref^ do
    +                begin
    +{$if defined(x86)}
    +                  if segment <> NR_NO then
    +                    Result := gas_regname(segment) + ':'
    +                  else
    +                    Result := '';
    +{$endif defined(x86)}
    +
    +                  if Assigned(symbol) then
    +                    begin
    +                      Result := Result + symbol.Name;
    +                      if offset > 0 then
    +                        Result := Result + '+';
    +                    end;
    +
    +                  if offset <> 0 then
    +                    Result := Result + tostr(offset)
    +                  else
    +                    Result := Result;
    +
    +                  if (base <> NR_NO) or (index <> NR_NO) then
    +                    begin
    +                      Result := Result + '(';
    +
    +                      if base <> NR_NO then
    +                        begin
    +                          Result := Result + gas_regname(base);
    +                          if index <> NR_NO then
    +                            Result := Result + ',';
    +                        end;
    +
    +                      if index <> NR_NO then
    +                        Result := Result + gas_regname(index);
    +
    +                      if scalefactor <> 0 then
    +                        Result := Result + ',' + tostr(scalefactor) + ')'
    +                      else
    +                        Result := Result + ')';
    +                    end;
    +                end;
    +            top_bool:
    +              begin
    +                if Oper^.b then
    +                  Result := 'TRUE'
    +                else
    +                  Result := 'FALSE';
    +              end
    +            else
    +              Result := '';
    +          end;
    +        end;
    +
    +{$if defined(x86)}
    +      procedure ProcessInstruction(p: tai); inline;
    +        var
    +          ThisOp, ThisOper: string;
    +          X: Integer;
    +        begin
    +          case p.typ of
    +            ait_label:
    +              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
    +
    +            ait_instruction:
    +              begin
    +                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
    +                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
    +                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
    +
    +                { Pad the opcode with spaces so the succeeding operands are aligned }
    +                PadString(ThisOp, 7);
    +
    +                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
    +                for X := 0 to taicpu(p).ops - 1 do
    +                  begin
    +                    Write(T, ' ');
    +
    +                    ThisOper := FormatOp(taicpu(p).oper[X]);
    +                    if X < taicpu(p).ops - 1 then
    +                      begin
    +                        ThisOper := ThisOper + ',';
    +                        PadString(ThisOper, 7);
    +                      end;
    +
    +                    Write(T, ThisOper);
    +                  end;
    +                WriteLn(T);
    +              end;
    +            else
    +              { Do nothing };
    +          end;
    +        end;
    +
    +      var
    +        hp: tai;
    +      begin
    +        if not Assigned(p_asm) then
    +          Exit;
    +
    +        hp := tai(p_asm.First);
    +        while Assigned(hp) do
    +          begin
    +            ProcessInstruction(hp);
    +            hp := tai(hp.Next);
    +          end;
    +{$else defined(x86)}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
    +{$endif defined(x86)}
    +{$else jvm}
    +      begin
    +        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
    +{$endif jvm}
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPBASENODE
     *****************************************************************************}
    @@ -939,7 +1125,48 @@
             settempinfoflags(gettempinfoflags-[flag])
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        { The raw pointer is the only way to uniquely identify the temp }
    +        Write(T, ' id="', WritePointer(tempinfo), '"');
    +      end;
    +
    +
    +    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
    +      var
    +        Flag: TTempInfoFlag;
    +        NotFirst: Boolean;
    +      begin
    +        inherited XMLPrintNodeData(t);
    +
    +        if not assigned(tempinfo) then
    +          exit;
    +
    +        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');
    +
    +        NotFirst := False;
    +        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
    +          if (Flag in tempinfo^.flags) then
    +            if not NotFirst then
    +              begin
    +                Write(T, PrintNodeIndention, '<tempflags>', Flag);
    +                NotFirst := True;
    +              end
    +            else
    +              Write(T, ',', Flag);
    +
    +        if NotFirst then
    +          WriteLn(T, '</tempflags>')
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempflags />');
    +
    +        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                               TEMPCREATENODE
     *****************************************************************************}
    @@ -1136,6 +1363,24 @@
             printnode(t,tempinfo^.tempinitcode);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
    +        if Assigned(TempInfo^.TempInitCode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<tempinit>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, TempInfo^.TempInitCode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</tempinit>');
    +          end
    +        else
    +          WriteLn(T, PrintNodeIndention, '<tempinit />');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TEMPREFNODE
     *****************************************************************************}
    @@ -1393,4 +1638,12 @@
               tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     end.
    Index: compiler/ncal.pas
    ===================================================================
    --- compiler/ncal.pas	(revision 42248)
    +++ compiler/ncal.pas	(working copy)
    @@ -201,6 +201,9 @@
            {$endif state_tracking}
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function  para_count:longint;
               function  required_para_count:longint;
               { checks if there are any parameters which end up at the stack, i.e.
    @@ -1836,7 +1839,57 @@
                (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCallNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        if assigned(procdefinition) and (procdefinition.typ=procdef) then
    +          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
    +        else
    +          begin
    +            if assigned(symtableprocentry) then
    +              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
    +          end;
     
    +        if assigned(methodpointer) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<methodpointer>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, methodpointer);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</methodpointer>');
    +          end;
    +
    +        if assigned(funcretnode) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<funcretnode>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, funcretnode);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</funcretnode>');
    +          end;
    +
    +        if assigned(callinitblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callinitblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callinitblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callinitblock>');
    +          end;
    +
    +        if assigned(callcleanupblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, callcleanupblock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
    +          end;
    +
    +        inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcallnode.printnodedata(var t:text);
           begin
             if assigned(procdefinition) and
    Index: compiler/ncnv.pas
    ===================================================================
    --- compiler/ncnv.pas	(revision 42248)
    +++ compiler/ncnv.pas	(working copy)
    @@ -64,6 +64,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function simplify(forinline : boolean):tnode; override;
    @@ -1047,7 +1050,32 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TTypeConvNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T,' convtype="', convtype);
    +        First := True;
    +        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
    +          if i in ConvNodeFlags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" convnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +           end;
     
    +        { If no flags were printed, this is the closing " for convtype }
    +        Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function ttypeconvnode.typecheck_cord_to_pointer : tnode;
     
           begin
    Index: compiler/ncon.pas
    ===================================================================
    --- compiler/ncon.pas	(revision 42248)
    +++ compiler/ncon.pas	(working copy)
    @@ -48,6 +48,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            trealconstnodeclass = class of trealconstnode;
     
    @@ -70,6 +73,10 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tordconstnodeclass = class of tordconstnode;
     
    @@ -87,6 +94,9 @@
               function pass_typecheck:tnode;override;
               function docompare(p: tnode) : boolean; override;
               procedure printnodedata(var t : text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tpointerconstnodeclass = class of tpointerconstnode;
     
    @@ -124,6 +134,9 @@
               { returns whether this platform uses the nil pointer to represent
                 empty dynamic strings }
               class function emptydynstrnil: boolean; virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tstringconstnodeclass = class of tstringconstnode;
     
    @@ -494,6 +507,13 @@
             writeln(t,printnodeindention,'value = ',value_real);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                   TORDCONSTNODE
    @@ -586,7 +606,21 @@
             writeln(t,printnodeindention,'value = ',tostr(value));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited XMLPrintNodeInfo(T);
    +        Write(T, ' rangecheck="', rangecheck, '"');
    +      end;
     
    +
    +    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                 TPOINTERCONSTNODE
     *****************************************************************************}
    @@ -668,6 +702,13 @@
             writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                  TSTRINGCONSTNODE
    @@ -1031,6 +1072,52 @@
             result:=true;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
    +      var
    +        OutputStr: ansistring;
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        Write(T, printnodeindention, '<stringtype>');
    +        case cst_type of
    +        cst_conststring:
    +          Write(T, 'conststring');
    +        cst_shortstring:
    +          Write(T, 'shortstring');
    +        cst_longstring:
    +          Write(T, 'longstring');
    +        cst_ansistring:
    +          Write(T, 'ansistring');
    +        cst_widestring:
    +          Write(T, 'widestring');
    +        cst_unicodestring:
    +          Write(T, 'unicodestring');
    +        end;
    +        WriteLn(T, '</stringtype>');
    +        WriteLn(T, printnodeindention, '<length>', len, '</length>');
    +
    +        if len = 0 then
    +          begin
    +            WriteLn(T, printnodeindention, '<value />');
    +            Exit;
    +          end;
    +
    +        case cst_type of
    +        cst_widestring, cst_unicodestring:
    +          begin
    +            { value_str is of type PCompilerWideString }
    +            SetLength(OutputStr, len);
    +            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
    +          end;
    +        else
    +          OutputStr := ansistring(value_str);
    +          SetLength(OutputStr, len);
    +        end;
    +
    +        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
     {*****************************************************************************
                                  TSETCONSTNODE
     *****************************************************************************}
    Index: compiler/nflw.pas
    ===================================================================
    --- compiler/nflw.pas	(revision 42248)
    +++ compiler/nflw.pas	(working copy)
    @@ -68,6 +68,10 @@
               procedure derefimpl;override;
               procedure insertintolist(l : tnodelist);override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +          procedure XMLPrintNodeTree(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
            end;
     
    @@ -1049,7 +1053,120 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TLoopFlag;
    +        First: Boolean;
    +      begin
    +        inherited XMLPrintNodeInfo(T);
     
    +        First := True;
    +        for i := Low(TLoopFlag) to High(TLoopFlag) do
    +          if i in loopflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' loopflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +
    +    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        if Assigned(Left) then
    +          begin
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '<counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '<condition>');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Left);
    +            PrintNodeUnindent;
    +            if nodetype = forn then
    +              WriteLn(T, PrintNodeIndention, '</counter>')
    +            else
    +              WriteLn(T, PrintNodeIndention, '</condition>');
    +          end;
    +
    +        if Assigned(Right) then
    +          begin
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '<then>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '<first>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '<right>');
    +            end;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, Right);
    +            PrintNodeUnindent;
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '</then>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '</first>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '</right>');
    +            end;
    +          end;
    +
    +        if Assigned(t1) then
    +          begin
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '<else>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '<last>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '<t1>');
    +            end;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, t1);
    +            PrintNodeUnindent;
    +            case nodetype of
    +              ifn:
    +                WriteLn(T, PrintNodeIndention, '</else>');
    +              forn:
    +                WriteLn(T, PrintNodeIndention, '</last>');
    +              else
    +                WriteLn(T, PrintNodeIndention, '</t1>');
    +            end;
    +          end;
    +
    +        if Assigned(t2) then
    +          begin
    +
    +            if nodetype <> forn then
    +              begin
    +                WriteLn(T, PrintNodeIndention, '<loop>');
    +                PrintNodeIndent;
    +              end;
    +
    +            XMLPrintNode(T, t2);
    +
    +            if nodetype <> forn then
    +              begin
    +                PrintNodeUnindent;
    +                WriteLn(T, PrintNodeIndention, '</loop>');
    +              end;
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tloopnode.docompare(p: tnode): boolean;
           begin
             docompare :=
    Index: compiler/ninl.pas
    ===================================================================
    --- compiler/ninl.pas	(revision 42248)
    +++ compiler/ninl.pas	(working copy)
    @@ -36,6 +36,9 @@
               procedure ppuwrite(ppufile:tcompilerppufile);override;
               function dogetcopy : tnode;override;
               procedure printnodeinfo(var t : text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var t : text);override;
    +{$endif DEBUG_NODE_DUMP}
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               function pass_typecheck_cpu:tnode;virtual;
    @@ -191,6 +194,13 @@
             write(t,', inlinenumber = ',inlinenumber);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
    +      begin
    +        inherited;
    +        Write(T, ' inlinenumber="', inlinenumber, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function get_str_int_func(def: tdef): string;
         var
    Index: compiler/nld.pas
    ===================================================================
    --- compiler/nld.pas	(revision 42248)
    +++ compiler/nld.pas	(working copy)
    @@ -71,6 +71,9 @@
               procedure mark_write;override;
               function  docompare(p: tnode): boolean; override;
               procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure setprocdef(p : tprocdef);
               property procdef: tprocdef read fprocdef write setprocdef;
            end;
    @@ -97,6 +100,9 @@
               function track_state_pass(exec_known:boolean):boolean;override;
            {$endif state_tracking}
               function docompare(p: tnode): boolean; override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tassignmentnodeclass = class of tassignmentnode;
     
    @@ -471,7 +477,17 @@
             writeln(t,'');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TLoadNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
     
    +        if symtableentry.typ = procsym then
    +          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tloadnode.setprocdef(p : tprocdef);
           begin
             fprocdef:=p;
    @@ -956,6 +972,18 @@
     {$endif}
     
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { For assignments, put the left and right branches on the same level for clarity }
    +        XMLPrintNode(T, Left);
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
     {*****************************************************************************
                                TARRAYCONSTRUCTORRANGENODE
     *****************************************************************************}
    Index: compiler/nmem.pas
    ===================================================================
    --- compiler/nmem.pas	(revision 42248)
    +++ compiler/nmem.pas	(working copy)
    @@ -88,6 +88,9 @@
               procedure buildderefimpl;override;
               procedure derefimpl;override;
               procedure printnodeinfo(var t: text); override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeInfo(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
               function docompare(p: tnode): boolean; override;
               function dogetcopy : tnode;override;
               function pass_1 : tnode;override;
    @@ -121,6 +124,9 @@
               function docompare(p: tnode): boolean; override;
               function pass_typecheck:tnode;override;
               procedure mark_write;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tsubscriptnodeclass = class of tsubscriptnode;
     
    @@ -133,6 +139,9 @@
               function pass_1 : tnode;override;
               function pass_typecheck:tnode;override;
               procedure mark_write;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
            end;
            tvecnodeclass = class of tvecnode;
     
    @@ -481,6 +490,29 @@
             write(t,']');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        First: Boolean;
    +        i: TAddrNodeFlag;
    +      begin
    +        inherited XMLPrintNodeInfo(t);
    +        First := True;
    +        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
    +          if i in addrnodeflags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, ' addrnodeflags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i);
    +            end;
    +        if not First then
    +          Write(T, '"');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function taddrnode.docompare(p: tnode): boolean;
           begin
    @@ -897,6 +929,13 @@
               (vs = tsubscriptnode(p).vs);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TSubscriptNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        WriteLn(T, PrintNodeIndention, '<field>', vs.Name, '</field>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
     {*****************************************************************************
                                    TVECNODE
    @@ -1299,6 +1338,24 @@
         end;
     
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TVecNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        XMLPrintNode(T, Left);
    +
    +        { The right node is the index }
    +        WriteLn(T, PrintNodeIndention, '<index>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</index>');
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
         function is_big_untyped_addrnode(p: tnode): boolean;
           begin
             is_big_untyped_addrnode:=(p.nodetype=addrn) and
    Index: compiler/node.pas
    ===================================================================
    --- compiler/node.pas	(revision 42248)
    +++ compiler/node.pas	(working copy)
    @@ -383,6 +383,15 @@
              procedure printnodeinfo(var t:text);virtual;
              procedure printnodedata(var t:text);virtual;
              procedure printnodetree(var t:text);virtual;
    +{$ifdef DEBUG_NODE_DUMP}
    +         { For writing nodes to XML files - do not call directly, but
    +           instead call XMLPrintNode to write a complete tree }
    +         procedure XMLPrintNodeInfo(var T: Text); dynamic;
    +         procedure XMLPrintNodeData(var T: Text); virtual;
    +         procedure XMLPrintNodeTree(var T: Text); virtual;
    +         class function SanitiseXMLString(const S: ansistring): ansistring;
    +         class function WritePointer(const P: Pointer): ansistring;
    +{$endif DEBUG_NODE_DUMP}
              procedure concattolist(l : tlinkedlist);virtual;
              function ischild(p : tnode) : boolean;virtual;
     
    @@ -413,6 +422,9 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           //pbinarynode = ^tbinarynode;
    @@ -431,6 +443,10 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeTree(var T: Text); override;
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
              procedure printnodelist(var t:text);
           end;
     
    @@ -449,11 +465,17 @@
              function dogetcopy : tnode;override;
              procedure insertintolist(l : tnodelist);override;
              procedure printnodedata(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
           tbinopnode = class(tbinarynode)
              constructor create(t:tnodetype;l,r : tnode);virtual;
              function docompare(p : tnode) : boolean;override;
    +{$ifdef DEBUG_NODE_DUMP}
    +         procedure XMLPrintNodeData(var T: Text); override;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
         var
    @@ -476,7 +498,9 @@
         procedure printnodeunindent;
         procedure printnode(var t:text;n:tnode);
         procedure printnode(n:tnode);
    -
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +{$endif DEBUG_NODE_DUMP}
         function is_constnode(p : tnode) : boolean;
         function is_constintnode(p : tnode) : boolean;
         function is_constcharnode(p : tnode) : boolean;
    @@ -494,6 +518,9 @@
     
         uses
            verbose,entfile,comphook,
    +{$ifdef DEBUG_NODE_DUMP}
    +       cutils,
    +{$endif DEBUG_NODE_DUMP}
            symconst,
            nutils,nflw,
            defutil;
    @@ -656,6 +683,13 @@
             printnode(output,n);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLPrintNode(var T: Text; N: TNode);
    +      begin
    +        if Assigned(N) then
    +          N.XMLPrintNodeTree(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         function is_constnode(p : tnode) : boolean;
           begin
    @@ -898,7 +932,355 @@
              writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    { For writing nodes to XML files - do not call directly, but
    +      instead call XMLPrintNode to write a complete tree }
    +    procedure tnode.XMLPrintNodeInfo(var T: Text);
    +      var
    +        i: TNodeFlag;
    +        first: Boolean;
    +      begin
    +        if Assigned(resultdef) then
    +          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
     
    +        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
    +
    +        First := True;
    +        for i := Low(TNodeFlag) to High(TNodeFlag) do
    +          if i in flags then
    +            begin
    +              if First then
    +                begin
    +                  Write(T, '" flags="', i);
    +                  First := False;
    +                end
    +              else
    +                Write(T, ',', i)
    +            end;
    +
    +        write(t,'" complexity="',node_complexity(self),'"');
    +      end;
    +
    +    procedure tnode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { Nothing by default }
    +      end;
    +
    +    procedure tnode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +
    +    class function TNode.WritePointer(const P: Pointer): ansistring;
    +      begin
    +        case PtrUInt(P) of
    +          0:
    +            WritePointer := 'nil';
    +          1..$FFFF:
    +            WritePointer := '$' + hexstr(PtrUInt(P), 4);
    +          $10000..$FFFFFFFF:
    +            WritePointer := '$' + hexstr(PtrUInt(P), 8);
    +{$ifdef CPU64}
    +          else
    +            WritePointer := '$' + hexstr(PtrUInt(P), 16);
    +{$endif CPU64}
    +        end;
    +      end;
    +
    +    class function TNode.SanitiseXMLString(const S: ansistring): ansistring;
    +      var
    +        X, UTF8Len, UTF8Char, CurrentChar: Integer;
    +        needs_quoting, in_quotes, add_end_quote: Boolean;
    +        DoASCII: Boolean;
    +
    +        { Write the given byte as #xxx }
    +        procedure EncodeControlChar(Value: Byte);
    +          begin
    +            if X = Length(Result) then
    +              add_end_quote := False;
    +
    +            Delete(Result, X, 1);
    +            if in_quotes then
    +              begin
    +                Insert('#' + tostr(Value) + '''', Result, X);
    +
    +                { If the entire string consists of control characters, it
    +                  doesn't need quoting, so only set the flag here }
    +                needs_quoting := True;
    +
    +                in_quotes := False;
    +              end
    +            else
    +              Insert('#' + tostr(Value), Result, X);
    +          end;
    +
    +        { Write the given byte as either a plain character or an XML keyword }
    +        procedure EncodeStandardChar(Value: Byte);
    +          begin
    +            if not in_quotes then
    +              begin
    +                in_quotes := True;
    +                if (X < Length(Result)) then
    +                  begin
    +                    needs_quoting := True;
    +                    Insert('''', Result, X + 1)
    +                  end;
    +              end;
    +
    +            { Check the character for anything that could be mistaken for an XML element }
    +            case CurrentChar of
    +              Ord('#'):
    +                { Required to differentiate '#27' from the escape code #27, for example }
    +                needs_quoting:=true;
    +
    +              Ord('<'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&lt;', Result, X);
    +                end;
    +              Ord('>'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&gt;', Result, X);
    +                end;
    +              Ord('&'):
    +                begin
    +                  Delete(Result, X, 1);
    +                  Insert('&amp;', Result, X);
    +                end;
    +              Ord('"'):
    +                begin
    +                  needs_quoting := True;
    +                  Delete(Result, X, 1);
    +                  Insert('&quot;', Result, X);
    +                end;
    +              Ord(''''):
    +                begin
    +                  needs_quoting:=true;
    +                  { Simply double it like in pascal strings }
    +                  Insert('''', Result, X);
    +                end;
    +              else
    +                { Do nothing };
    +            end;
    +          end;
    +
    +        { Convert character between $80 and $FF to UTF-8 }
    +        procedure EncodeExtendedChar(Value: Byte);
    +          begin
    +            if not in_quotes then
    +              begin
    +                in_quotes := True;
    +                if (X < Length(Result)) then
    +                  begin
    +                    needs_quoting := True;
    +                    Insert('''', Result, X + 1)
    +                  end;
    +              end;
    +
    +            case Value of
    +              $80..$BF: { Add $C2 before the value }
    +                Insert(#$C2, Result, X);
    +              $C0..$FF: { Zero the $40 bit and add $C3 before the value }
    +                begin
    +                  Result[X] := Char(Byte(Result[X]) and $BF);
    +                  Insert(#$C3, Result, X);
    +                end;
    +              else
    +                { Previous conditions should prevent this procedure from being
    +                  called if Value < $80 }
    +                InternalError(2019061901);
    +            end;
    +          end;
    +
    +      begin
    +        needs_quoting := False;
    +        Result := S;
    +
    +        { Gets set to True if an invalid UTF-8 sequence is found }
    +        DoASCII := False;
    +
    +        { By setting in_quotes to false here, we can exclude the single
    +          quotation marks surrounding the string if it doesn't contain any
    +          control characters, or consists entirely of control characters. }
    +        in_quotes := False;
    +
    +        add_end_quote := True;
    +
    +        X := Length(Result);
    +        while X > 0 do
    +          begin
    +            CurrentChar := Ord(Result[X]);
    +
    +            { Control characters and extended characters need special handling }
    +            case CurrentChar of
    +              $00..$1F, $7F:
    +                EncodeControlChar(CurrentChar);
    +
    +              $20..$7E:
    +                EncodeStandardChar(CurrentChar);
    +
    +              { UTF-8 continuation byte }
    +              $80..$BF:
    +                begin
    +                  if not in_quotes then
    +                    begin
    +                      in_quotes := True;
    +                      if (X < Length(Result)) then
    +                        begin
    +                          needs_quoting := True;
    +                          Insert('''', Result, X + 1)
    +                        end;
    +                    end;
    +
    +                  UTF8Char := CurrentChar and $3F; { The data bits of the continuation byte }
    +                  UTF8Len := 1; { This variable actually holds 1 less than the length }
    +
    +                  { By setting DoASCII to true, it marks the string as 'invalid UTF-8'
    +                    automatically if it reaches the beginning of the string unexpectedly }
    +                  DoASCII := True;
    +
    +                  Dec(X);
    +                  while X > 0 do
    +                    begin
    +                      CurrentChar := Ord(Result[X]);
    +
    +                      case CurrentChar of
    +                        { A standard character here is invalid UTF-8 }
    +                        $00..$7F:
    +                          Break;
    +
    +                        { Another continuation byte }
    +                        $80..$BF:
    +                          begin
    +                            UTF8Char := UTF8Char or ((CurrentChar and $3F) shl (6 * UTF8Len));
    +
    +                            Inc(UTF8Len);
    +                            if UTF8Len >= 4 then
    +                              { Sequence too long }
    +                              Break;
    +                          end;
    +
    +                        { Lead byte for 2-byte sequences }
    +                        $C2..$DF:
    +                          begin
    +                            if UTF8Len <> 1 then Break;
    +
    +                            UTF8Char := UTF8Char or ((CurrentChar and $1F) shl 6);
    +
    +                            { Check to see if the code is in range and not part of an 'overlong' sequence }
    +                            case UTF8Char of
    +                              $0080..$07FF:
    +                                DoASCII := False;
    +                              else
    +                                { Do nothing - DoASCII is already true }
    +                            end;
    +                            Break;
    +                          end;
    +
    +                        { Lead byte for 3-byte sequences }
    +                        $E0..$EF:
    +                          begin
    +                            if UTF8Len <> 2 then Break;
    +
    +                            UTF8Char := UTF8Char or ((CurrentChar and $0F) shl 12);
    +
    +                            { Check to see if the code is in range and not part of an 'overlong' sequence }
    +                            case UTF8Char of
    +                              $0800..$D7FF, $E000..$FFFF: { $D800..$DFFF is reserved and hence invalid }
    +                                DoASCII := False;
    +                              else
    +                                { Do nothing - DoASCII is already true }
    +                            end;
    +                            Break;
    +                          end;
    +
    +                        { Lead byte for 4-byte sequences }
    +                        $F0..$F4:
    +                          begin
    +                            if UTF8Len <> 3 then Break;
    +
    +                            UTF8Char := UTF8Char or ((CurrentChar and $07) shl 18);
    +
    +                            { Check to see if the code is in range and not part of an 'overlong' sequence }
    +                            case UTF8Char of
    +                              $010000..$10FFFF:
    +                                DoASCII := False;
    +                              else
    +                                { Do nothing - DoASCII is already true }
    +                            end;
    +                            Break;
    +                          end;
    +
    +                        { Invalid character }
    +                        else
    +                          Break;
    +                      end;
    +                    end;
    +
    +                  if DoASCII then
    +                    Break;
    +
    +                  { If all is fine, we don't need to encode any more characters }
    +                end;
    +
    +              { Invalid UTF-8 bytes and lead bytes without continuation bytes }
    +              $C0..$FF:
    +                begin
    +                  DoASCII := True;
    +                  Break;
    +                end;
    +            end;
    +
    +            Dec(X);
    +          end;
    +
    +        { UTF-8 failed, so encode the string as plain ASCII }
    +        if DoASCII then
    +          begin
    +            { Reset the flags and Result }
    +            needs_quoting := False;
    +            Result := S;
    +            in_quotes := False;
    +            add_end_quote := True;
    +
    +            for X := Length(Result) downto 1 do
    +              begin
    +                CurrentChar := Ord(Result[X]);
    +
    +                { Control characters and extended characters need special handling }
    +                case CurrentChar of
    +                  $00..$1F, $7F:
    +                    EncodeControlChar(CurrentChar);
    +
    +                  $20..$7E:
    +                    EncodeStandardChar(CurrentChar);
    +
    +                  { Extended characters }
    +                  else
    +                    EncodeExtendedChar(CurrentChar);
    +
    +                end;
    +              end;
    +          end;
    +
    +        if needs_quoting then
    +          begin
    +            if in_quotes then
    +              Result := '''' + Result;
    +
    +            if add_end_quote then
    +              Result := Result + '''';
    +          end;
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         function tnode.isequal(p : tnode) : boolean;
           begin
              isequal:=
    @@ -1058,6 +1440,13 @@
              printnode(t,left);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         inherited XMLPrintNodeData(T);
    +         XMLPrintNode(T, Left);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
     
         procedure tunarynode.concattolist(l : tlinkedlist);
           begin
    @@ -1185,7 +1574,27 @@
              printnode(t,right);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        XMLPrintNodeData(T);
    +      end;
     
    +
    +    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        inherited XMLPrintNodeData(T);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +        { Right nodes are on the same indentation level }
    +        XMLPrintNode(T, Right);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tbinarynode.printnodelist(var t:text);
           var
             hp : tbinarynode;
    @@ -1286,7 +1695,22 @@
              printnode(t,third);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
    +      begin
    +         if Assigned(Third) then
    +           begin
    +             WriteLn(T, PrintNodeIndention, '<third-branch>');
    +             PrintNodeIndent;
    +             XMLPrintNode(T, Third);
    +             PrintNodeUnindent;
    +             WriteLn(T, PrintNodeIndention, '</third-branch>');
    +           end;
     
    +         inherited XMLPrintNodeData(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure ttertiarynode.concattolist(l : tlinkedlist);
           begin
              third.parent:=self;
    @@ -1320,6 +1744,18 @@
                 right.isequal(tbinopnode(p).left));
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TBinOpNode.XMLPrintNodeData(var T: Text);
    +      begin
    +        { For binary operations, put the left and right branches on the same level for clarity }
    +        XMLPrintNode(T, Left);
    +        XMLPrintNode(T, Right);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
    +
     begin
     {$push}{$warnings off}
       { tvaroption must fit into a 4 byte set for speed reasons }
    Index: compiler/nset.pas
    ===================================================================
    --- compiler/nset.pas	(revision 42248)
    +++ compiler/nset.pas	(working copy)
    @@ -120,6 +120,9 @@
               procedure derefimpl;override;
               function dogetcopy : tnode;override;
               procedure printnodetree(var t:text);override;
    +{$ifdef DEBUG_NODE_DUMP}
    +          procedure XMLPrintNodeTree(var t:text); override;
    +{$endif DEBUG_NODE_DUMP}
               procedure insertintolist(l : tnodelist);override;
               function pass_typecheck:tnode;override;
               function pass_1 : tnode;override;
    @@ -1014,7 +1017,44 @@
             writeln(t,printnodeindention,')');
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
    +      var
    +        i : longint;
    +      begin
    +        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
    +        XMLPrintNodeInfo(T);
    +        WriteLn(T, '>');
    +        PrintNodeIndent;
    +        WriteLn(T, PrintNodeIndention, '<condition>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Left);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</condition>');
     
    +        i:=0;
    +        for i:=0 to blocks.count-1 do
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
    +            PrintNodeIndent;
    +            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +        if assigned(elseblock) then
    +          begin
    +            WriteLn(T, PrintNodeIndention, '<block id="else">');;
    +            PrintNodeIndent;
    +            XMLPrintNode(T, ElseBlock);
    +            PrintNodeUnindent;
    +            WriteLn(T, PrintNodeIndention, '</block>');
    +          end;
    +
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcasenode.insertintolist(l : tnodelist);
           begin
           end;
    Index: compiler/pmodules.pas
    ===================================================================
    --- compiler/pmodules.pas	(revision 42248)
    +++ compiler/pmodules.pas	(working copy)
    @@ -881,6 +881,10 @@
              current_module.SetFileName(main_file.path+main_file.name,true);
              current_module.SetModuleName(unitname);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('unit', unitname);
    +{$endif DEBUG_NODE_DUMP}
    +
              { check for system unit }
              new(s2);
              s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
    @@ -1018,6 +1022,10 @@
                 Message1(unit_f_errors_in_unit,tostr(Errorcount));
                 status.skip_error:=true;
                 symtablestack.pop(current_module.globalsymtable);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1311,6 +1319,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1400,6 +1412,10 @@
                 module_is_done;
                 if not immediate then
                   restore_global_state(globalstate,true);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +            XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
                 exit;
               end;
     
    @@ -1459,6 +1475,9 @@
                     waitingmodule.end_of_parsing;
                   end;
               end;
    +{$ifdef DEBUG_NODE_DUMP}
    +        XMLFinalizeNodeFile('unit');
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
    @@ -1540,6 +1559,10 @@
     
              setupglobalswitches;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLInitializeNodeFile('package', module_name);
    +{$endif DEBUG_NODE_DUMP}
    +
              consume(_SEMICOLON);
     
              { global switches are read, so further changes aren't allowed }
    @@ -1722,6 +1745,10 @@
                  main_procinfo.generate_code;
                end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         XMLFinalizeNodeFile('package');
    +{$endif DEBUG_NODE_DUMP}
    +
              { leave when we got an error }
              if (Errorcount>0) and not status.skip_error then
                begin
    @@ -1986,6 +2013,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('library', program_name);
    +{$endif DEBUG_NODE_DUMP}
                end
              else
                { is there an program head ? }
    @@ -2032,6 +2063,10 @@
                   setupglobalswitches;
     
                   consume(_SEMICOLON);
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +              XMLInitializeNodeFile('program', program_name);
    +{$endif DEBUG_NODE_DUMP}
                 end
              else
                begin
    @@ -2040,6 +2075,10 @@
     
                  { setup things using the switches }
                  setupglobalswitches;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +             XMLInitializeNodeFile('program', current_module.realmodulename^);
    +{$endif DEBUG_NODE_DUMP}
                end;
     
              { load all packages, so we know whether a unit is contained inside a
    @@ -2262,6 +2301,13 @@
              { consume the last point }
              consume(_POINT);
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         if IsLibrary then
    +           XMLFinalizeNodeFile('library')
    +         else
    +           XMLFinalizeNodeFile('program');
    +{$endif DEBUG_NODE_DUMP}
    +
              { reset wpo flags for all defs }
              reset_all_defs;
     
    Index: compiler/psub.pas
    ===================================================================
    --- compiler/psub.pas	(revision 42248)
    +++ compiler/psub.pas	(working copy)
    @@ -65,11 +65,20 @@
             procedure parse_body;
     
             function has_assembler_child : boolean;
    +
    +{$ifdef DEBUG_NODE_DUMP}
    +        procedure XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
           end;
     
     
         procedure printnode_reset;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +{$endif DEBUG_NODE_DUMP}
    +
         { reads the declaration blocks }
         procedure read_declarations(islibrary : boolean);
     
    @@ -1138,6 +1147,67 @@
               end;
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure tcgprocinfo.XMLPrintProc;
    +      var
    +        T: Text;
    +        W: Word;
    +        syssym: tsyssym;
    +
    +      procedure PrintOption(Flag: string);
    +        begin
    +          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
    +        end;
    +
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult <> 0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        Write(T, PrintNodeIndention, '<procedure');
    +        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
    +
    +        if po_hascallingconvention in procdef.procoptions then
    +          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
    +
    +        WriteLn(T, '>');
    +
    +        PrintNodeIndent;
    +
    +        if po_compilerproc in procdef.procoptions then
    +          PrintOption('compilerproc');
    +        if po_assembler in procdef.procoptions then
    +          PrintOption('assembler');
    +        if po_nostackframe in procdef.procoptions then
    +          PrintOption('nostackframe');
    +        if po_inline in procdef.procoptions then
    +          PrintOption('inline');
    +        if po_noreturn in procdef.procoptions then
    +          PrintOption('noreturn');
    +        if po_noinline in procdef.procoptions then
    +          PrintOption('noinline');
    +
    +        WriteLn(T, PrintNodeIndention, '<code>');
    +        PrintNodeIndent;
    +        XMLPrintNode(T, Code);
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</code>');
    +        PrintNodeUnindent;
    +        WriteLn(T, PrintNodeIndention, '</procedure>');
    +        WriteLn(T); { Line for spacing }
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure tcgprocinfo.generate_code_tree;
           var
             hpi : tcgprocinfo;
    @@ -1435,7 +1505,7 @@
     {$endif i386 or i8086}
     
             { Print the node to tree.log }
    -        if paraprintnodetree=1 then
    +        if paraprintnodetree <> 0 then
               printproc( 'after the firstpass');
     
             { do this before adding the entry code else the tail recursion recognition won't work,
    @@ -1560,7 +1630,7 @@
                 CalcExecutionWeights(code);
     
                 { Print the node to tree.log }
    -            if paraprintnodetree=1 then
    +            if paraprintnodetree <> 0 then
                   printproc( 'right before code generation');
     
                 { generate code for the node tree }
    @@ -2043,9 +2113,14 @@
                CreateInlineInfo;
     
              { Print the node to tree.log }
    -         if paraprintnodetree=1 then
    +         if paraprintnodetree <> 0 then
                printproc( 'after parsing');
     
    +{$ifdef DEBUG_NODE_DUMP}
    +         printnodeindention := printnodespacing;
    +         XMLPrintProc;
    +{$endif DEBUG_NODE_DUMP}
    +
              { ... remove symbol tables }
              remove_from_symtablestack;
     
    @@ -2461,7 +2536,51 @@
               MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
           end;
     
    +{$ifdef DEBUG_NODE_DUMP}
    +    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Rewrite(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            current_module.ppxfilefail := True;
    +            Exit;
    +          end;
    +        {$pop}
    +        { Mark the node dump file as available for writing }
    +        current_module.ppxfilefail := False;
    +        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
    +        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
    +        Close(T);
    +      end;
     
    +
    +    procedure XMLFinalizeNodeFile(RootName: shortstring);
    +      var
    +        T: Text;
    +      begin
    +        if current_module.ppxfilefail then
    +          Exit;
    +
    +        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
    +        Assign(T, current_module.ppxfilename);
    +        {$push} {$I-}
    +        Append(T);
    +        if IOResult<>0 then
    +          begin
    +            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
    +            Exit;
    +          end;
    +        {$pop}
    +        WriteLn(T, '</', RootName, '>');
    +        Close(T);
    +      end;
    +{$endif DEBUG_NODE_DUMP}
    +
         procedure read_declarations(islibrary : boolean);
           var
             hadgeneric : boolean;
    

Activities

J. Gareth Moreton

2019-02-06 00:28

developer   ~0113876

Fixed some grammar in the main description.

J. Gareth Moreton

2019-02-06 01:58

developer   ~0113882

Fixed a bug that caused a closing double quotation mark to sometimes be omitted from an attribute in the typeconvn node.

J. Gareth Moreton

2019-02-06 04:23

developer   ~0113885

Uploaded xml-stringconst-node-output.patch that adds in a missing feature - printing the contents of string constants into the node dump.

J. Gareth Moreton

2019-02-07 00:59

developer   ~0113913

A few more tweaks and bug fixes - also included the string printing patch with the main one.

J. Gareth Moreton

2019-03-02 19:05

developer   ~0114581

Fixed a crash that sometimes occurs if node dumping is enabled but there's a syntax error in the source code - if a node has the nf_error flag set, the XML dumping code will no longer look at its children, since they may be incomplete (the crash was caused by "is_managed_type" being called for a ResultDef that was nil).

Regression tests should now be fine.

J. Gareth Moreton

2019-03-08 17:00

developer   ~0114715

Regression tests have passed.

J. Gareth Moreton

2019-04-09 11:19

developer   ~0115341

Last edited: 2019-04-09 11:19

View 2 revisions

Is there any progress on evaluation of this feature? For new compiler improvements that rely on node optimisation and analysis, such as vectorisation, offline analysis of complex node trees will be required. Additionally, bug 0032913 will greatly benefit from this feature when it comes to analysing and fixing that particular problem.

Pierre Muller

2019-05-21 17:57

developer   ~0116306

Hi Gareth,

  I would like to suggest two modifications:

1) as this is a debugging feature only, and will not be compiled normally inside
the released compilers, I would recommend that you modify as few sources as possible,
for this reason, I would propose that your use a single extension for the xml node dump,
something like '.node-dump.xml' so that it is really obvious what kind of file you generate.
This is what I did recently with my patch that added

2) I would also suggest that the whole patch is entirely inside {$ifdef DEBUG_NODE_DUMP} XXX {$endif DEBUG_NODE_DUMP}
this would allow to be sure from start that the patch does not change the behavior of the 'normal' compiler.

J. Gareth Moreton

2019-05-21 18:52

developer   ~0116307

Hi Pierre,

Thank you for your feedback. I will see what I can do in modifying the patch. Removing the "ppx" file extension to something more hard-coded should be easy enough. I went for the classic 3-letter extension out of tradition and the fact that not all platforms support anything longer (e.g. "msdos16", which traditionally only supports the 8.3 filename format, might have problems - what would you suggest here?).

For putting the whole patch inside {$ifdef DEBUG_NODE_DUMP}, do you mean ensuring that the "XMLPrintNodeData" procedure is not even defined if DEBUG_NODE_DUMP is not present? I am not certain if I can collect everything into a single source file because different nodes need to write out different data.

Pierre Muller

2019-05-21 23:04

developer   ~0116313

I don't think you will ever use a 16-bit Free Pascal compiler (which does not exist yet...)
with those special DEBUG options. You would rather use go32v2 version on msdos,
so don't think that we need to bother about 8.3 limitations for your patch.

  Concerning the $ifdef DEBUG_NODE_DUMP, I really only meant that
all your changes are within {$ifdef DEBUG_NODE_DUMP}... {$endif}
so that we do not even need to test that your patch has no effect on the 'regular' compiler.

J. Gareth Moreton

2019-05-22 01:57

developer   ~0116323

I've updated the patch according to your requests - all of my additions, including the XMLPrint### methods, are now behind "{$ifdef DEBUG_NODE_DUMP}" and should cause no changes to the compiler if DEBUG_NODE_DUMP isn't defined.

If it is defined, the dump files are now of the format "[unitname]-node-dump.xml", so the System unit, for example, will dump its nodes into "system-node-dump.xml" - this format leaves no doubt as to the format of the dump files and will mostly work on 8.3 systems too, where the filename will be truncated to something like "SYSTEM~1.XML", for example.

Hopefully this works and proves to be a very useful debugging and development feature.

Pierre Muller

2019-05-22 09:05

developer   ~0116324

The patch allies and compiles OK.

  The generated XML file seem OK, but
as my knowledge about XML is very limited, I tried to find a
open source XML validator, which I did not find.

Finally, I simply opened the XML file with FireFox (66.0.5 (Windows 64-bit)), and got this error:

XML Parsing Error: not well-formed
Location: file:///C:/Users/Pierre/Downloads/aasmsym-node-dump.xml
Line Number 5, Column 46: <blockn resultdef="$void" pos="52,7", complexity="255">
----------------------------------------------------------------------------------------------------^

I also think that string constants should probably be enclosed into double quotes, like in version-node-dump.xml
               <stringconstn resultdef="ShortString" pos="100,8", complexity="1">
                  <value>3.3.1-r20:42111M</value>
               </stringconstn>

into <value>"3.3.1-r20:42111M"</value>

Tomas Hajny

2019-05-22 09:49

manager   ~0116325

@Pierre: I believe that quoting is needed for attributes in tags, not for values in the data part.

Pierre Muller

2019-05-22 10:03

developer   ~0116326

@Tomas: you are probably right, as I said, I know about nothing about XML specifications.

But you might also argue that character and string constants need to be enclosed in quotes
in this particular XML files because they are about compiler nodes from Free Pascal...
but then, of course, single quotes would make more sense.

rd0x

2019-05-22 11:41

reporter   ~0116329

I guess the issue is the ',' in <blockn resultdef="$void" pos="52,7", complexity="255"> after pos="52,7"

Pierre Muller

2019-05-22 16:07

developer   ~0116333

I made several modifications to the patch,
and used xmllint utility to check if the generated files are correct.

 I now only get a limited number of errors when testing files
from rtl and compiler cycle:

$ xmllint x86_64/units/x86_64-linux/*xml ../rtl/units/x86_64-linux/*xml > xmllint.log
x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3673: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xFF 0x35 0x3C 0x2F
                        <value>▒5</value>
                               ^
x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3809: parser error : PCDATA invalid Char value 15
                        <value>@</value>
                               ^
x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3809: parser error : PCDATA invalid Char value 31
                        <value>@</value>
                                ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:5829: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0x80 0xAE 0x1F 0x26
                        <value>▒▒>:</value>
                               ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:5829: parser error : PCDATA invalid Char value 31
                        <value>▒▒>:</value>
                                 ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:5862: parser error : PCDATA invalid Char value 31
                        <value>@▒>:</value>
                                 ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:6919: parser error : PCDATA invalid Char value 3
                     <value> >:</value>
                             ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:6919: parser error : PCDATA invalid Char value 4
                     <value> >:</value>
                              ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:6978: parser error : PCDATA invalid Char value 2
                     <value>▒>:</value>
                             ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:6978: parser error : PCDATA invalid Char value 4
                     <value>▒>:</value>
                              ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:7407: parser error : PCDATA invalid Char value 4
                        <value>`5>:</value>
                                 ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:7651: parser error : PCDATA invalid Char value 4
                           <value> N>:</value>
                                    ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:84466: parser error : PCDATA invalid Char value 17
                        <value>▒{<:</value>
                                ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:84493: parser error : PCDATA invalid Char value 27
                        <value>▒<:</value>
                                ^
../rtl/units/x86_64-linux/sysutils-node-dump.xml:84964: parser error : PCDATA invalid Char value 27
                        <value>`<:</value>
                                ^
../rtl/units/x86_64-linux/unicodedata-node-dump.xml:5198: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xDC 0x36 0x8F 0x7F
                        <value>`]▒6▒</value>
                                 ^

Pierre Muller

2019-05-22 16:26

developer   ~0116335

For the x86_64/cpuelf.pas unit,
the errors are related to these "string" constants:

  procedure TElfExeOutputx86_64.WriteFirstPLTEntry;
    begin
      pltobjsec.writeBytes(#$FF#$35); // push got+8(%rip)
      pltobjsec.writeReloc_internal(gotpltobjsec,sizeof(pint),4,RELOC_RELATIVE);
      pltobjsec.writeBytes(#$FF#$25); // jmp *got+16(%rip)
      pltobjsec.writeReloc_internal(gotpltobjsec,2*sizeof(pint),4,RELOC_RELATIVE);
      pltobjsec.writeBytes(#$0F#$1F#$40#$00); // nopl 0(%rax)
    end;

These are improper UTF-8 strings...
Would it work to add an explicit local encoding?

J. Gareth Moreton

2019-05-22 16:32

developer   ~0116336

Yeah, the first error is due to the comma - that was a slight oversight of mine. I'll have a look at SysUtils to see what values are being encoded there.

I also forgot the new "noinline" directive.

Pierre Muller

2019-05-22 16:44

developer   ~0116340

Do you have any special means to look at these generated files?
Maybe a DTD or a Schema?

J. Gareth Moreton

2019-05-22 19:10

developer   ~0116345

Not yet, but I've worked out why the XML files are invalid... unicode strings. I'm testing code that converts them to UTF-8 for the sake of the XML files.

J. Gareth Moreton

2019-05-22 21:44

developer   ~0116348

So unicode strings are giving me a bit of grief - working on it though! I should be done by tomorrow morning.

J. Gareth Moreton

2019-05-22 23:56

developer   ~0116355

All strings should now work correctly. I overlooked the fact that for unicode strings, the "value_str" field does NOT contain a raw string, but a record type with a field that points to the string.

J. Gareth Moreton

2019-05-23 01:26

developer   ~0116359

Minor updates to how string data is displayed and also adding a blank 'else' into a case block (it seems that inputs of type 'string[#]' (so individual ansichars) are not subject to the stricter rules, but I put it in anyway).

xml-node-output-mod3.patch (51,328 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42112)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42112)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42112)
+++ compiler/nbas.pas	(working copy)
@@ -83,6 +83,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -251,6 +254,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -266,6 +272,9 @@
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          private
           tempidx : longint;
         end;
@@ -286,6 +295,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +336,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -892,7 +912,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -1136,6 +1309,38 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1279,7 +1484,47 @@
         writeln(t,'])');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
+      var
+        f : TTempInfoFlag;
+        NotFirst : Boolean;
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(t);
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
 
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        notfirst:=false;
+        for f in tempinfo^.flags do
+          begin
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', f);
+                PrintNodeIndent;
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', f);
+          end;
+
+        if NotFirst then
+          begin
+            PrintNodeUnindent;
+            WriteLn(T, '</tempflags>');
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -1393,4 +1638,26 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42112)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42112)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42112)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,90 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        cst_ansistring, cst_shortstring, cst_conststring:
+          begin
+            { Assume worst-case scenario of every character being >= $80 }
+            SetLength(OutputStr, len * 2);
+            Index := 1;
+
+            { Check to see if any of the individual characters are extended }
+            for X := 0 to len - 1 do
+              begin
+                CurrentChar := value_str[X];
+                case CurrentChar of
+                #$00:
+                  begin
+                    { The only way we can really encode a null in UTF-8 }
+                    OutputStr[Index] := #$C0;
+                    OutputStr[Index + 1] := #$80;
+                    Inc(Index, 2);
+                  end;
+                #$80..#$BF:
+                  begin
+                    OutputStr[Index] := #$C2;
+                    OutputStr[Index + 1] := CurrentChar;
+                    Inc(Index, 2);
+                  end;
+                #$C0..#$FF:
+                  begin
+                    OutputStr[Index] := #$C3;
+                    OutputStr[Index + 1] := Char(Byte(CurrentChar) and $3F);
+                    Inc(Index, 2);
+                  end;
+                else
+                  OutputStr[Index] := CurrentChar;
+                  Inc(Index);
+                end;
+              end;
+
+            { Truncate to the correct length }
+            SetLength(OutputStr, Index - 1);
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42112)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,104 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<first>')
+            else
+              WriteLn(T, PrintNodeIndention, '<right>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</first>')
+            else
+              WriteLn(T, PrintNodeIndention, '</right>')
+          end;
+
+        if Assigned(t1) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<last>')
+            else
+              WriteLn(T, PrintNodeIndention, '<t1>');
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</last>')
+            else
+              WriteLn(T, PrintNodeIndention, '</t1>');
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42112)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42112)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -471,7 +474,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42112)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -481,6 +484,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42112)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,14 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: string): string;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +421,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +442,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,6 +464,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
@@ -476,7 +494,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -656,6 +676,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +925,95 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          { We don't need to sanitise the XML for attribute data because it's
+            inside double quotation marks. [Kit] }
+          Write(T,' resultdef="', resultdef.typesymbolprettyname, '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function tnode.SanitiseXMLString(const S: string): string;
+      var
+        X: Integer;
+      begin
+        Result := S;
+
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            case Result[X] of
+              '<':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              '>':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              '&':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              '"':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              '''':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&apos;', Result, X);
+                end;
+              else
+                { Do nothing};
+            end;
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1173,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1307,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1428,24 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end
+         else
+           WriteLn(T, PrintNodeIndention, '<third-branch />');
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42112)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42112)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42112)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the PPX file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.1" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

J. Gareth Moreton

2019-05-23 02:14

developer   ~0116360

If this looks good, I plan to make some improvements here and there later on. For example, the node dump currently creates the following for if-blocks:

<ifn resultdef="$void" pos="1631,3" complexity="255">
   <condition>
      ...
   </condition>
   <right>
      ...
   </right>
   <t1>
      ...
   </t1>
</ifn>

I can easily insert a condition into the debug code so "right" becomes "then" and "t1" becomes "else". As I said in an earlier note, this is something that will likely have improvements built upon it over time.

Pierre Muller

2019-05-23 13:34

developer   ~0116369

I Tried out your new version:
you switched from 1.0 to 1.1 specifications, is there a specific reason for that?
The xmllint utility I use does not seems to know 1.1 ...
Then you removed the Sanitise from the resultsdef attribute,
arguing in the source that sanitisation is not need inside a quote text,
but xmllint still emits errors, which leads to many more errors,
is this a difference between 1.0 and 1.1 specifications?

After reversion of these two changes, I get only 10 errors left:
Most seem to be related to ascii strings containing values that are invalid
for UTF-8.

x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3676: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC3 0x3F 0x35 0x3C
                        <value>▒?5</value>
                               ^
x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3814: parser error : PCDATA invalid Char value 15
                        <value>@▒▒</value>
                               ^
x86_64/units/x86_64-linux/cpuelf-node-dump.xml:3814: parser error : PCDATA invalid Char value 31
                        <value>@▒▒</value>
                                ^
x86_64/units/x86_64-linux/dbgdwarf-node-dump.xml:8093: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x3C 0x2F
                                       <value>Void▒▒</value>
                                                  ^
x86_64/units/x86_64-linux/ncal-node-dump.xml:1484: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x3C 0x2F
                  <value>▒▒</value>
                         ^
x86_64/units/x86_64-linux/ogcoff-node-dump.xml:4204: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x3C 0x2F
                                    <value>▒▒</value>
                                           ^
x86_64/units/x86_64-linux/symdef-node-dump.xml:35077: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x3C 0x2F
                                                                         <value>
                                                                               ^
../rtl/units/x86_64-linux/baseunix-node-dump.xml:48: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x2D 0x63
                           <value>/bin/sh▒▒-c▒▒</value>
                                         ^
../rtl/units/x86_64-linux/classes-node-dump.xml:20208: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC3 0x2F 0xC2 0xBB
                        <value>▒/»¿</value>
                               ^
../rtl/units/x86_64-linux/system-node-dump.xml:140724: parser error : Input is not proper UTF-8, indicate encoding !
Bytes: 0xC0 0x80 0x3C 0x2F
                              <value>/▒▒</value>
                                      ^

J. Gareth Moreton

2019-05-23 18:09

developer   ~0116373

Weird. I'm largely using Notepad++ to check for XML validity, and it behaves fine with things like the greater than and less than signs in double quotation marks. I'll double check the ruling on that one, but will change it back if needs be.

As for 1.1, the only real difference between it and 1.0 is that 1.1 allows for control characters between 01 and 1F, which some strings may have. 1.0 on the other hand only allows 09, 0A, 0D and maybe one other.

The fact that ASCII strings are erroneous is annoying. I thought my code checked for extended characters and converted them. Evidently not.

J. Gareth Moreton

2019-05-23 19:01

developer   ~0116374

Actually I can see my problems now... if the string contains a NULL, there isn't actually a way of encoding it at all. 0xC0 0x80 is non-standard UTF-8, and I forgot to set the highest bit on the 2nd byte when converting characters between 0xC0 to 0xFF (e,g. 0xC3 0x3F is actually meant to be 0xC3 0xAF).

For the C0 control charactes 0x01 to 0x1F, they're meant to be encoded as &#x01; to &#x1F; respectively. For a NULL, I'm going to have to come up with something.

For the "resultdef" thing, you are right, it should be sanitised, especially because theoretically, the value could contain a " character that would need changing to " and would otherwise be mistaken for the end of the string.

Should only take me about 30 minutes to get all fixed.

J. Gareth Moreton

2019-05-23 20:22

developer   ~0116376

Sorry about all that Pierre. See if this performs any better. If I'm not mistaken, if an XML viewer doesn't recognise 1.1, it should just fall back to 1.0.

I've also made an improvement in that if a string constant contains $0D and $0A characters, it will encode them as &#x0D and &#x0A respectively rather than causing a linefeed to appear in the XML file.

I hope this works better.

xml-node-output-mod4.patch (51,555 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42112)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42112)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42112)
+++ compiler/nbas.pas	(working copy)
@@ -83,6 +83,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -251,6 +254,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -266,6 +272,9 @@
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          private
           tempidx : longint;
         end;
@@ -286,6 +295,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +336,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -892,7 +912,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -1136,6 +1309,38 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1279,7 +1484,47 @@
         writeln(t,'])');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
+      var
+        f : TTempInfoFlag;
+        NotFirst : Boolean;
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(t);
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
 
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        notfirst:=false;
+        for f in tempinfo^.flags do
+          begin
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', f);
+                PrintNodeIndent;
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', f);
+          end;
+
+        if NotFirst then
+          begin
+            PrintNodeUnindent;
+            WriteLn(T, '</tempflags>');
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -1393,4 +1638,26 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42112)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42112)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42112)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,84 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        cst_ansistring, cst_shortstring, cst_conststring:
+          begin
+            { Assume worst-case scenario of every character being >= $80 }
+            SetLength(OutputStr, len * 2);
+            Index := 1;
+
+            { Check to see if any of the individual characters are extended }
+            for X := 0 to len - 1 do
+              begin
+                CurrentChar := value_str[X];
+                case CurrentChar of
+                #$80..#$BF:
+                  begin
+                    OutputStr[Index] := #$C2;
+                    OutputStr[Index + 1] := CurrentChar;
+                    Inc(Index, 2);
+                  end;
+                #$C0..#$FF:
+                  begin
+                    OutputStr[Index] := #$C3;
+                    OutputStr[Index + 1] := Char($80 or (Byte(CurrentChar) and $3F));
+                    Inc(Index, 2);
+                  end;
+                else
+                  OutputStr[Index] := CurrentChar;
+                  Inc(Index);
+                end;
+              end;
+
+            { Truncate to the correct length }
+            SetLength(OutputStr, Index - 1);
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42112)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,104 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<first>')
+            else
+              WriteLn(T, PrintNodeIndention, '<right>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</first>')
+            else
+              WriteLn(T, PrintNodeIndention, '</right>')
+          end;
+
+        if Assigned(t1) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<last>')
+            else
+              WriteLn(T, PrintNodeIndention, '<t1>');
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</last>')
+            else
+              WriteLn(T, PrintNodeIndention, '</t1>');
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42112)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42112)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -471,7 +474,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42112)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -481,6 +484,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42112)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,14 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: string): string;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +421,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +442,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,6 +464,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
@@ -476,7 +494,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -656,6 +676,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +925,106 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function tnode.SanitiseXMLString(const S: string): string;
+      var
+        X: Integer; CurrentChar: Char;
+      begin
+        Result := S;
+
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            CurrentChar := Result[X];
+            case CurrentChar of
+              #0:
+                begin
+                  { We can't really do much better than this }
+                  Delete(Result, X, 1);
+                  Insert('[NULL]', Result, X);
+                end;
+              #1..#31:
+                begin
+                  { It is this that requires XML 1.1 over XML 1.0 }
+                  Delete(Result, X, 1);
+                  Insert('&#x' + hexstr(Byte(CurrentChar), 2) + ';', Result, X);
+                end;
+              '<':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              '>':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              '&':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              '"':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              '''':
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&apos;', Result, X);
+                end;
+              else
+                { Do nothing};
+            end;
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1184,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1318,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1439,24 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end
+         else
+           WriteLn(T, PrintNodeIndention, '<third-branch />');
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42112)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42112)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42112)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the dump file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.1" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

Pierre Muller

2019-05-23 21:24

developer   ~0116379

I still get error with your new version.

  Instead, I would like to propose that we try to use the Pascal syntax,
and replace all characters outside the 32..127 to '#XX',
and add single quote and put everything inside a global double quote to avoid
the need of escaping the single quotes ...

The patch below gives no errors on rtl and compiler generated xml files (evn when cross-compiling...)
on packages, I do get a few errors, due to the fact that some strings, because of conversions,
hit the 255 length limitation and become invalid because of the truncation.

xml-node-output-mod5.patch (52,307 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42114)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42114)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42114)
+++ compiler/nbas.pas	(working copy)
@@ -83,6 +83,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -251,6 +254,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -266,6 +272,9 @@
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          private
           tempidx : longint;
         end;
@@ -286,6 +295,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +336,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -892,7 +912,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -1136,6 +1309,40 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif def CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1279,7 +1486,49 @@
         writeln(t,'])');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
+      var
+        f : TTempInfoFlag;
+        NotFirst : Boolean;
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(t);
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
 
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif def CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        notfirst:=false;
+        for f in tempinfo^.flags do
+          begin
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', f);
+                PrintNodeIndent;
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', f);
+          end;
+
+        if NotFirst then
+          begin
+            PrintNodeUnindent;
+            WriteLn(T, '</tempflags>');
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -1393,4 +1642,28 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif def CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42114)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42114)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42114)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,69 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring; X, Index: Integer; CurrentChar: Char;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        cst_ansistring, cst_shortstring, cst_conststring:
+          begin
+            { Assume worst-case scenario of every character being >= $80 }
+            SetLength(OutputStr, len * 2);
+            Index := 1;
+
+            { Check to see if any of the individual characters are extended }
+            for X := 0 to len - 1 do
+              begin
+                CurrentChar := value_str[X];
+                OutputStr[Index] := CurrentChar;
+                Inc(Index);
+              end;
+
+            { Truncate to the correct length }
+            SetLength(OutputStr, Index - 1);
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+        { Always quote like pascal strings }
+        // OutputStr:='"'+OutputStr+'"';
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42114)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,104 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<first>')
+            else
+              WriteLn(T, PrintNodeIndention, '<right>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</first>')
+            else
+              WriteLn(T, PrintNodeIndention, '</right>')
+          end;
+
+        if Assigned(t1) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<last>')
+            else
+              WriteLn(T, PrintNodeIndention, '<t1>');
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</last>')
+            else
+              WriteLn(T, PrintNodeIndention, '</t1>');
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42114)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42114)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -471,7 +474,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42114)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -481,6 +484,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42114)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,14 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: string): string;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +421,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +442,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,6 +464,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
@@ -476,7 +494,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +514,9 @@
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_DUMP}
+       cutils,
+{$endif DEBUG_NODE_DUMP}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +679,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +928,135 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          { We don't need to sanitise the XML for attribute data because it's
+            inside double quotation marks. [Kit].
+            Reinstated as it gives errors (PM) }
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function tnode.SanitiseXMLString(const S: string): string;
+      var
+        X,val: Integer;
+        needs_quoting,in_quotes,add_end_quote : boolean;
+      begin
+        Result := S;
+        needs_quoting:=false;
+        if (Length(S)>1) and (S[1]='"') and (S[Length(S)]='"') then
+          begin
+            needs_quoting:=true;
+            result:=Copy(S,2,Length(S)-2);
+          end;
+        in_quotes:=false;
+        add_end_quote:=true;
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            val:=ord(Result[X]);
+            if needs_quoting and not in_quotes and
+               not (val in [0..8,11,12,14..31,128..255]) then
+              begin
+                Insert('''', Result, X+1);
+                in_quotes:=true;
+              end;
+            case val of
+              ord('<'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              ord('>'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              ord('&'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              ord('"'):
+                begin
+                  needs_quoting:=true;
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              ord(''''):
+                begin
+                  needs_quoting:=true;
+                  { Simply double it like in pascal strings }
+                  Insert('''', Result, X);
+                end;
+              { Accept TAB #9, \r #10 and \n #13 }
+              0..8,11,12,14..31,128..255:
+                begin
+                  needs_quoting:=true;
+                  if X=length(S) then
+                    add_end_quote:=false;
+                  Delete(Result, X, 1);
+                  if in_quotes then
+                    Insert('#'+tostr(val)+'''', Result, X)
+                  else
+                    Insert('#'+tostr(val), Result, X);
+                  in_quotes:=false;
+                end;
+            else
+              { Do nothing }
+            end;
+          end;
+        if needs_quoting then
+          begin
+            if (in_quotes) then
+              result:=''''+result;
+            if add_end_quote then
+              result:=result+'''';
+            result:='"'+result+'"';
+          end;
+
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1216,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1350,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1471,24 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end
+         else
+           WriteLn(T, PrintNodeIndention, '<third-branch />');
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42114)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42114)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42114)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name=', TNode.SanitiseXMLString('"'+procdef.customprocname([])+'"'));
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the PPX file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

J. Gareth Moreton

2019-05-23 23:17

developer   ~0116382

Last edited: 2019-05-23 23:18

View 2 revisions

I agree with the Pascal string style of things. Let's see if that works.

I merged your patch with some changes you missed in mod4 - specifically, I have inserted the string length as an XML element for string constants. This is to help mitigate effects of the 255-character limit and also help make the true length clearer when control characters are used. It also avoids the joke of having a string that contains the literal 3-character sequence '# 27' instead of the single escape code!

I decided to encode # 9, # 10 and # 13 as #XX sequences because they just mess up the XML formatting otherwise, especially the latter two, rather than appearing as a distinct part of the string (more likely, an XML reader might erase # 10 and # 13).

Good catch with the else blocks for 64-bit pointers.

I hope it's all good now.



xml-node-output-mod6.patch (51,647 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42114)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42114)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42114)
+++ compiler/nbas.pas	(working copy)
@@ -83,6 +83,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -251,6 +254,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -266,6 +272,9 @@
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          private
           tempidx : longint;
         end;
@@ -286,6 +295,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +336,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -892,7 +912,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -1136,6 +1309,40 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1279,7 +1486,49 @@
         writeln(t,'])');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
+      var
+        f : TTempInfoFlag;
+        NotFirst : Boolean;
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(t);
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
 
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+
+        notfirst:=false;
+        for f in tempinfo^.flags do
+          begin
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', f);
+                PrintNodeIndent;
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', f);
+          end;
+
+        if NotFirst then
+          begin
+            PrintNodeUnindent;
+            WriteLn(T, '</tempflags>');
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -1393,4 +1642,28 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      var
+        PtrStr: string;
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+        WriteLn(T, PrintNodeIndention, '<temptypedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</temptypedef>');
+        WriteLn(T, PrintNodeIndention, '<temptype>',tempinfo^.temptype, '</temptype>');
+
+        case ptruint(tempinfo) of
+          0..$FFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 4);
+          $10000..$FFFFFFFF:
+            PtrStr := hexstr(ptruint(tempinfo), 8);
+{$ifdef CPU64}
+          else
+            PtrStr := hexstr(ptruint(tempinfo), 16);
+{$endif CPU64}
+        end;
+        WriteLn(T, PrintNodeIndention, '<tempinfo>$', PtrStr, '</tempinfo>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42114)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42114)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42114)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,52 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42114)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,104 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<first>')
+            else
+              WriteLn(T, PrintNodeIndention, '<right>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</first>')
+            else
+              WriteLn(T, PrintNodeIndention, '</right>')
+          end;
+
+        if Assigned(t1) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<last>')
+            else
+              WriteLn(T, PrintNodeIndention, '<t1>');
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</last>')
+            else
+              WriteLn(T, PrintNodeIndention, '</t1>');
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42114)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42114)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -471,7 +474,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42114)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -481,6 +484,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42114)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,14 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: string): string;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +421,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +442,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,6 +464,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
@@ -476,7 +494,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +514,9 @@
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_DUMP}
+       cutils,
+{$endif DEBUG_NODE_DUMP}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +679,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +928,140 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function tnode.SanitiseXMLString(const S: string): string;
+      var
+        X, val: Integer;
+        needs_quoting, in_quotes, add_end_quote: Boolean;
+      begin
+        needs_quoting := False;
+        if (Length(S) > 1) and (S[1]='"') and (S[Length(S)]='"') then
+          begin
+            needs_quoting := True;
+            Result := Copy(S, 2, Length(S) - 2);
+          end
+        else
+          Result := S;
+
+        in_quotes := False;
+        add_end_quote := True;
+
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            val:=ord(Result[X]);
+            if needs_quoting and not in_quotes and
+              not (val in [0..31, 128..255]) then
+              begin
+                Insert('''', Result, X + 1);
+                in_quotes := True;
+              end;
+
+            case val of
+              Ord('<'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              Ord('>'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              Ord('&'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              Ord('"'):
+                begin
+                  needs_quoting := True;
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              Ord(''''):
+                begin
+                  needs_quoting:=true;
+                  { Simply double it like in pascal strings }
+                  Insert('''', Result, X);
+                end;
+
+              { Control characters and extended characters }
+              0..31, 128..255:
+                begin
+                  needs_quoting := True;
+                  if X = Length(S) then
+                    add_end_quote:=false;
+                  Delete(Result, X, 1);
+                  if in_quotes then
+                    Insert('#' + tostr(val) + '''', Result, X)
+                  else
+                    Insert('#' + tostr(val), Result, X);
+
+                  in_quotes := False;
+                end;
+              else
+                { Do nothing };
+            end;
+          end;
+
+        if needs_quoting then
+          begin
+            if (in_quotes) then
+              Result := '''' + Result;
+
+            if add_end_quote then
+              Result := Result + '''';
+
+            Result := '"' + Result + '"';
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1221,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1355,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1476,24 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end
+         else
+           WriteLn(T, PrintNodeIndention, '<third-branch />');
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42114)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42114)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42114)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name=', TNode.SanitiseXMLString('"' + procdef.customprocname([]) + '"'));
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the node dump file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

J. Gareth Moreton

2019-05-25 18:26

developer   ~0116413

There's something else I plan to do once this feature is accepted... every so often I plan to make a node and assembler dump of a static project, probably a fixed version of Lazarus. I say this because I noticed that even though I haven't updated my source files in a while, the EXE size has been steadily growing over time. In fact it grew by 1 kilobyte in this month alone.

Granted there's probably a good reason for this (e.g. faster albeit larger code) but it might help in tracking down potential inefficiencies in the compiler. Most of the time it's probably nothing we can do and might be seen as pedantic, but the tool's there to be used!

Pierre Muller

2019-05-27 08:44

developer  

xml-node-output-mod7.patch (52,513 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42128)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42128)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42128)
+++ compiler/nbas.pas	(working copy)
@@ -83,6 +83,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -224,6 +227,9 @@
           procedure includetempflag(flag: ttempinfoflag); inline;
           procedure excludetempflag(flag: ttempinfoflag); inline;
           property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -251,6 +257,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -266,6 +275,9 @@
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          private
           tempidx : longint;
         end;
@@ -286,6 +298,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +339,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -892,7 +915,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -939,6 +1115,64 @@
         settempinfoflags(gettempinfoflags-[flag])
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure ttempbasenode.XMLPrintNodeData(var T: Text);
+(*       ttempinfo = object
+        private
+         flags                      : ttempinfoflags;
+        public
+         { set to the copy of a tempcreate pnode (if it gets copied) so that the }
+         { refs and deletenode can hook to this copy once they get copied too    }
+         hookoncopy                 : ptempinfo;
+         typedef                    : tdef;
+         typedefderef               : tderef;
+         temptype                   : ttemptype;
+         owner                      : ttempcreatenode;
+         withnode                   : tnode;
+         location                   : tlocation;
+         tempinitcode               : tnode;
+       end;
+*)
+    const
+       tempflagname : array[ttempinfoflag] of string[30] = (
+         'may_be_in_reg',
+         'valid',
+         'nextref_set_hookoncopy_nil',
+         'addr_taken',
+         'executeinitialisation',
+         'reference',
+         'readonly',
+         'nofini',
+         'const',
+         'no_final_regsync',
+         'cleanup_only'
+         );
+      var
+        str: ansistring;
+        flag : ttempinfoflag;
+        first : boolean;
+      begin
+        inherited XMLPrintNodeData(t);
+        if not assigned(tempinfo) then
+          exit;
+        str:='';
+        first:=false;
+        for flag:=low(ttempinfoflag) to high(ttempinfoflag) do
+          if (flag in tempinfo^.flags) then
+            if first then
+              begin
+                str:=tempflagname[flag];
+                first:=false;
+              end
+            else
+              str:=str+','+tempflagname[flag];
+        if str<>'' then
+          str:='flags="'+str+'" ';
+        str:=str+' typedef="'+tnode.SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname)+'"';
+        WriteLn(T, PrintNodeIndention, '<tempinfo>', str);
+        WriteLn(T, PrintNodeIndention, ' temptype="',tempinfo^.temptype, '"</tempinfo>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                           TEMPCREATENODE
@@ -1136,6 +1370,24 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1279,7 +1531,34 @@
         writeln(t,'])');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempRefNode.XMLPrintNodeData(var T: Text);
+      var
+        f : TTempInfoFlag;
+        NotFirst : Boolean;
+      begin
+        inherited XMLPrintNodeData(t);
+        notfirst:=false;
+        for f in tempinfo^.flags do
+          begin
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', f);
+                PrintNodeIndent;
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', f);
+          end;
 
+        if NotFirst then
+          begin
+            PrintNodeUnindent;
+            WriteLn(T, '</tempflags>');
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPDELETENODE
 *****************************************************************************}
@@ -1393,4 +1672,12 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42128)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42128)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42128)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,52 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42128)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,104 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<first>')
+            else
+              WriteLn(T, PrintNodeIndention, '<right>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</first>')
+            else
+              WriteLn(T, PrintNodeIndention, '</right>')
+          end;
+
+        if Assigned(t1) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<last>')
+            else
+              WriteLn(T, PrintNodeIndention, '<t1>');
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</last>')
+            else
+              WriteLn(T, PrintNodeIndention, '</t1>');
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42128)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42128)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -471,7 +474,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42128)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -481,6 +484,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42128)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,14 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: ansistring): ansistring;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +421,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +442,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,6 +464,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
@@ -476,7 +494,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +514,9 @@
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_DUMP}
+       cutils,
+{$endif DEBUG_NODE_DUMP}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +679,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +928,140 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function tnode.SanitiseXMLString(const S: ansistring): ansistring;
+      var
+        X, val: Integer;
+        needs_quoting, in_quotes, add_end_quote: Boolean;
+      begin
+        needs_quoting := False;
+        if (Length(S) > 1) and (S[1]='"') and (S[Length(S)]='"') then
+          begin
+            needs_quoting := True;
+            Result := Copy(S, 2, Length(S) - 2);
+          end
+        else
+          Result := S;
+
+        in_quotes := False;
+        add_end_quote := True;
+
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            val:=ord(Result[X]);
+            if needs_quoting and not in_quotes and
+              not (val in [0..31, 128..255]) then
+              begin
+                Insert('''', Result, X + 1);
+                in_quotes := True;
+              end;
+
+            case val of
+              Ord('<'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              Ord('>'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              Ord('&'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              Ord('"'):
+                begin
+                  needs_quoting := True;
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              Ord(''''):
+                begin
+                  needs_quoting:=true;
+                  { Simply double it like in pascal strings }
+                  Insert('''', Result, X);
+                end;
+
+              { Control characters and extended characters }
+              0..31, 128..255:
+                begin
+                  needs_quoting := True;
+                  if X = Length(S) then
+                    add_end_quote:=false;
+                  Delete(Result, X, 1);
+                  if in_quotes then
+                    Insert('#' + tostr(val) + '''', Result, X)
+                  else
+                    Insert('#' + tostr(val), Result, X);
+
+                  in_quotes := False;
+                end;
+              else
+                { Do nothing };
+            end;
+          end;
+
+        if needs_quoting then
+          begin
+            if (in_quotes) then
+              Result := '''' + Result;
+
+            if add_end_quote then
+              Result := Result + '''';
+
+            Result := '"' + Result + '"';
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1221,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1355,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1476,24 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end
+         else
+           WriteLn(T, PrintNodeIndention, '<third-branch />');
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42128)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42128)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42128)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name=', TNode.SanitiseXMLString('"' + procdef.customprocname([]) + '"'));
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the node dump file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

Pierre Muller

2019-05-27 08:44

developer   ~0116427

In fact, after looking at the reason of the 64-bit pointer problem, I thought that this is
not correct. The printing of the location of the ttempinfo object is not a valuable information,
instead, its content should be written out.
  I started doing this in version 7 of the patch that I attach here.
The patch is not complete in that respect, more fields should be given...
Anyhow, it remove the {$ifdef CPU64} which should generally be avoided as it means
that the code depends on the system on which it is built, whereas it should only depend
on the target CPU, and not at all on the OS, except for the default target OS,
which is the same.

J. Gareth Moreton

2019-05-27 08:57

developer   ~0116428

I'll take a look at the temporary information changes and see if I can complete it today. In the meantime, I'll also change "right" and "t1" to "then" and "else" respectively for "ifn" nodes, since they're a bit more meaningful and saves on the changes lately.

Thanks for your help in developing and testing this.

J. Gareth Moreton

2019-05-28 19:53

developer   ~0116449

Done some refactoring to make the string outputs clearer (hopefully) - also fixed a bug where two single quotation marks were put at the end of the string instead of just one.

I also made some additions:
- "ifn" nodes now name their branches "then" and "else" instead of "right" and "t1" for clarity.
- Nodes that relate to binary operators now export their "right" node as a child rather than as a sibling, since "left" and "right" are the expressions either side of the operator.
- "vecn" nodes, which represent arrays, now output the index of the array being accessed.
- "subscriptn" nodes, which represent objects and records, now output the name of the field being accessed.
- "third-branch" branches (like those in "callparan" nodes) are now only printed if they actually contain data, since most of the time, they don't.
- Nodes that relate to temporary references now print their ID (which is otherwise a volatile pointer) as an XML attribute, because while the value itself is not constant, it is the only way to identify which reference a node is referring to (e.g. to pair up a creation with a deletion).

One thing that might need some rearranging are "callparan" nodes, because these are in reverse order to what you expect (i.e. the rightmost parameter is first), but this isn't so straightforward because each parameter node is the "right" branch of the previous one, with the first (rightmost) parameter being the "right" branch of the call node.

xml-node-output-mod8.patch (56,868 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42124)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42124)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42124)
+++ compiler/nbas.pas	(working copy)
@@ -37,6 +37,9 @@
           constructor create;virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tnothingnodeclass = class of tnothingnode;
 
@@ -83,6 +86,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -224,6 +230,10 @@
           procedure includetempflag(flag: ttempinfoflag); inline;
           procedure excludetempflag(flag: ttempinfoflag); inline;
           property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -251,6 +261,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -286,6 +299,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +340,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -395,6 +419,15 @@
         expectloc:=LOC_VOID;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
+        WriteLn(T, ' />');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TFIRSTERROR
@@ -892,7 +925,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -939,7 +1125,48 @@
         settempinfoflags(gettempinfoflags-[flag])
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        { The raw pointer is the only way to uniquely identify the temp }
+        Write(T, ' id="', WritePointer(tempinfo), '"');
+      end;
+
+
+    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
+      var
+        Flag: TTempInfoFlag;
+        NotFirst: Boolean;
+      begin
+        inherited XMLPrintNodeData(t);
+
+        if not assigned(tempinfo) then
+          exit;
+
+        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');
+
+        NotFirst := False;
+        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
+          if (Flag in tempinfo^.flags) then
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', Flag);
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', Flag);
+
+        if NotFirst then
+          WriteLn(T, '</tempflags>')
+        else
+          WriteLn(T, PrintNodeIndention, '<tempflags />');
+
+        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPCREATENODE
 *****************************************************************************}
@@ -1136,6 +1363,24 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1393,4 +1638,12 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42124)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42124)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42124)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,52 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42124)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,120 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<first>');
+              else
+                WriteLn(T, PrintNodeIndention, '<right>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</first>');
+              else
+                WriteLn(T, PrintNodeIndention, '</right>');
+            end;
+          end;
+
+        if Assigned(t1) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<last>');
+              else
+                WriteLn(T, PrintNodeIndention, '<t1>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</last>');
+              else
+                WriteLn(T, PrintNodeIndention, '</t1>');
+            end;
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42124)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42124)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -97,6 +100,9 @@
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tassignmentnodeclass = class of tassignmentnode;
 
@@ -471,7 +477,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
@@ -956,6 +972,18 @@
 {$endif}
 
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For assignments, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
 {*****************************************************************************
                            TARRAYCONSTRUCTORRANGENODE
 *****************************************************************************}
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42124)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -121,6 +124,9 @@
           function docompare(p: tnode): boolean; override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tsubscriptnodeclass = class of tsubscriptnode;
 
@@ -133,6 +139,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tvecnodeclass = class of tvecnode;
 
@@ -481,6 +490,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
@@ -897,6 +929,13 @@
           (vs = tsubscriptnode(p).vs);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TSubscriptNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<field>', vs.Name, '</field>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                                TVECNODE
@@ -1297,6 +1336,24 @@
     end;
 
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TVecNode.XMLPrintNodeData(var T: Text);
+      begin
+        XMLPrintNode(T, Left);
+
+        { The right node is the index }
+        WriteLn(T, PrintNodeIndention, '<index>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</index>');
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
     function is_big_untyped_addrnode(p: tnode): boolean;
       begin
         is_big_untyped_addrnode:=(p.nodetype=addrn) and
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42124)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,15 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: ansistring): ansistring;
+         class function WritePointer(const P: Pointer): ansistring;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +422,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +443,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,11 +465,17 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
          constructor create(t:tnodetype;l,r : tnode);virtual;
          function docompare(p : tnode) : boolean;override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
     var
@@ -476,7 +498,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +518,9 @@
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_DUMP}
+       cutils,
+{$endif DEBUG_NODE_DUMP}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +683,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +932,168 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function TNode.WritePointer(const P: Pointer): ansistring;
+      begin
+        case PtrUInt(P) of
+          0:
+            WritePointer := 'nil';
+          1..$FFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 4);
+          $10000..$FFFFFFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 8);
+{$ifdef CPU64}
+          else
+            WritePointer := '$' + hexstr(PtrUInt(P), 16);
+{$endif CPU64}
+        end;
+      end;
+
+    class function TNode.SanitiseXMLString(const S: ansistring): ansistring;
+      var
+        X, CurrentChar: Integer;
+        needs_quoting, in_quotes, add_end_quote: Boolean;
+      begin
+        needs_quoting := False;
+        Result := S;
+
+        { By setting in_quotes to false here, we can exclude the single
+          quotation marks surrounding the string if it doesn't contain any
+          control characters, or consists entirely of control characters. }
+        in_quotes := False;
+
+        add_end_quote := True;
+
+        { Check the string for anything that could be mistaken for an XML element }
+        for X := Length(Result) downto 1 do
+          begin
+            CurrentChar := Ord(Result[X]);
+
+            { Control characters and extended characters need special handling }
+            if (CurrentChar in [0..31, 128..255]) then
+              begin
+                if X = Length(Result) then
+                  add_end_quote := False;
+
+                Delete(Result, X, 1);
+                if in_quotes then
+                  begin
+                    Insert('#' + tostr(CurrentChar) + '''', Result, X);
+
+                    { If the entire string consists of control characters, it
+                      doesn't need quoting, so only set the flag here }
+                    needs_quoting := True;
+
+                    in_quotes := False;
+                  end
+                else
+                  Insert('#' + tostr(CurrentChar), Result, X);
+              end
+            else
+              begin
+                if not in_quotes then
+                  begin
+                    in_quotes := True;
+                    if (X < Length(Result)) then
+                      begin
+                        needs_quoting := True;
+                        Insert('''', Result, X + 1)
+                      end;
+                  end;
+
+                case CurrentChar of
+                  Ord('#'):
+                    { Required to differentiate '#27' from the escape code #27, for example }
+                    needs_quoting:=true;
+
+                  Ord('<'):
+                    begin
+                      Delete(Result, X, 1);
+                      Insert('&lt;', Result, X);
+                    end;
+                  Ord('>'):
+                    begin
+                      Delete(Result, X, 1);
+                      Insert('&gt;', Result, X);
+                    end;
+                  Ord('&'):
+                    begin
+                      Delete(Result, X, 1);
+                      Insert('&amp;', Result, X);
+                    end;
+                  Ord('"'):
+                    begin
+                      needs_quoting := True;
+                      Delete(Result, X, 1);
+                      Insert('&quot;', Result, X);
+                    end;
+                  Ord(''''):
+                    begin
+                      needs_quoting:=true;
+                      { Simply double it like in pascal strings }
+                      Insert('''', Result, X);
+                    end;
+                  else
+                    { Do nothing };
+                end;
+              end;
+          end;
+
+        if needs_quoting then
+          begin
+            if in_quotes then
+              Result := '''' + Result;
+
+            if add_end_quote then
+              Result := Result + '''';
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1253,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1387,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1508,22 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end;
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
@@ -1320,6 +1557,18 @@
             right.isequal(tbinopnode(p).left));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinOpNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For binary operations, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
 begin
 {$push}{$warnings off}
   { tvaroption must fit into a 4 byte set for speed reasons }
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42124)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42124)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42124)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the node dump file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

J. Gareth Moreton

2019-05-29 06:56

developer   ~0116450

Hmmm, the part where it outputs the string type, I should probably use a constant array rather than a case block for that. Something to refactor later.

J. Gareth Moreton

2019-06-10 22:27

developer   ~0116667

Any word on this, Pierre?

Pierre Muller

2019-06-19 09:06

developer   ~0116782

Hi,

  I think that we still need to improve the xml output
for constant strings, currently, all extended characters end up being translated into #abc#def

If you compile:
{codepage utf-8}

var
  s : string;
const
  ss : ansistring = 'Test avec éèùà';
begin
  s:='Test dummy'0000003' and éàè';
  writeln(s,' ',ss);
end.

You get:
[muller@gcc121 check]$ grep -nC3 dummy *xml
11- <stringconstn resultdef="ShortString" pos="8,6" complexity="1">
12- <stringtype>shortstring</stringtype>
13- <length>22</length>
14: <value>'Test dummy'0000003' and '0000195#169#195#160#195#168</value>
15- </stringconstn>
16- </assignn>
17- </statementn>

Which is really not what is expected!

J. Gareth Moreton

2019-06-19 10:01

developer   ~0116783

Thanks Pierre. I'll see if I can get that improved. Strings are proving to be the sticking point!

Currently my plan is as follows:

- If a character is between #$00 and #$1F or is equal to #$7F (the "delete" character), it prints it as a control character regardless.
- If a sequence is found that forms invalid UTF-8 (e.g a byte equal to #$C0, #$C1 or between #$F5 and #$FF), then it will attempt to write the string as ASCII by converting characters between #$80 to #$FF into #$C2#$80 to #$C3#$BF so it appears correctly in an XML viewer.

The alternative to the second criterion is to simply print #$80 through #$FF as control codes. How does it sound?

Pierre Muller

2019-06-19 10:13

developer   ~0116784

The alternative you give to print 0000080 to #FF as control is what your latest
patch already does, and this is what causes the conversion of all 'extended' characters to be printed out as
controls.

  Maybe we should change SanitiseXMLString to add a additional boolean parameter (named is_utf8_string)
stating if the input ansstring is already encoded as utf-8,
and do an explicit conversion to utf-8 in the stringconstnode for all but shortstring types.

  The conversion of chars from 0000080 to #ff should then be only done if is_utf8_string is false.

J. Gareth Moreton

2019-06-19 10:39

developer   ~0116786

I didn't word it as well as I would have liked. The second criterion, or its alternative, would only happen if it finds an invalid UTF-8 character, then it tries to print the entire string as ASCII or converting extended characters into control characters. Let me see if I can develop that to see how it turns out.

Regarding "is_utf8_string"... the question is when you would pass that as True or False, because one would have to determine if the string is valid UTF-8 or not anyway.

J. Gareth Moreton

2019-06-19 14:35

developer   ~0116789

How does this perform? It should be able to support both UTF-8 strings and ANSI strings.

I've noticed also that I need to support the listing of global constants in the dumps at some point, since the XML file doesn't include the definition of SS in your code example.

xml-node-output-mod9.patch (63,505 bytes)
Index: compiler/finput.pas
===================================================================
--- compiler/finput.pas	(revision 42248)
+++ compiler/finput.pas	(working copy)
@@ -145,6 +145,9 @@
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilename,              { fullname of the intermediate node XML file }
+{$endif DEBUG_NODE_DUMP}
           importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
@@ -154,6 +157,9 @@
           dbgfilename,              { fullname of the debug info file }
           path,                     { path where the module is find/created }
           outputpath   : TPathStr;  { path where the .s / .o / exe are created }
+{$ifdef DEBUG_NODE_DUMP}
+          ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
+{$endif DEBUG_NODE_DUMP}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -625,6 +631,9 @@
          asmfilename:=p+n+target_info.asmext;
          objfilename:=p+n+target_info.objext;
          ppufilename:=p+n+target_info.unitext;
+{$ifdef DEBUG_NODE_DUMP}
+         ppxfilename:=p+n+'-node-dump.xml';
+{$endif DEBUG_NODE_DUMP}
          importlibfilename:=p+target_info.importlibprefix+n+target_info.importlibext;
          staticlibfilename:=p+target_info.staticlibprefix+n+target_info.staticlibext;
          exportfilename:=p+'exp'+n+target_info.objext;
@@ -668,6 +677,9 @@
         realmodulename:=stringdup(s);
         mainsource:='';
         ppufilename:='';
+{$ifdef DEBUG_NODE_DUMP}
+        ppxfilename:='';
+{$endif DEBUG_NODE_DUMP}
         objfilename:='';
         asmfilename:='';
         importlibfilename:='';
@@ -679,6 +691,12 @@
         outputpath:='';
         paramfn:='';
         path:='';
+{$ifdef DEBUG_NODE_DUMP}
+        { Setting ppxfilefail to true will stop it from being written to if it
+          was never initialised, which happens if a module doesn't need
+          recompiling. }
+        ppxfilefail := True;
+{$endif DEBUG_NODE_DUMP}
         { status }
         state:=ms_registered;
         { unit index }
Index: compiler/i8086/n8086con.pas
===================================================================
--- compiler/i8086/n8086con.pas	(revision 42248)
+++ compiler/i8086/n8086con.pas	(working copy)
@@ -35,6 +35,9 @@
       ti8086pointerconstnode = class(tcgpointerconstnode)
         constructor create(v : TConstPtrUInt;def:tdef);override;
         procedure printnodedata(var t: text);override;
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         procedure pass_generate_code;override;
       end;
 
@@ -70,6 +73,15 @@
           inherited printnodedata(t);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure Ti8086PointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        if (typedef.typ=pointerdef) and (tcpupointerdef(typedef).x86pointertyp in [x86pt_far,x86pt_huge]) then
+          WriteLn(T, PrintNodeIndention, '<value>$', hexstr(word(value shr 16),4),':',hexstr(word(value),4), '</value>')
+        else
+          inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure ti8086pointerconstnode.pass_generate_code;
       begin
Index: compiler/nbas.pas
===================================================================
--- compiler/nbas.pas	(revision 42248)
+++ compiler/nbas.pas	(working copy)
@@ -37,6 +37,9 @@
           constructor create;virtual;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tnothingnodeclass = class of tnothingnode;
 
@@ -83,6 +86,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tasmnodeclass = class of tasmnode;
 
@@ -224,6 +230,10 @@
           procedure includetempflag(flag: ttempinfoflag); inline;
           procedure excludetempflag(flag: ttempinfoflag); inline;
           property tempflags: ttempinfoflags read gettempinfoflags write settempinfoflags;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -251,6 +261,9 @@
           function pass_typecheck: tnode; override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
         end;
        ttempcreatenodeclass = class of ttempcreatenode;
 
@@ -286,6 +299,9 @@
           function docompare(p: tnode): boolean; override;
           destructor destroy; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          protected
           release_to_normal : boolean;
         private
@@ -324,6 +340,14 @@
       pass_1,
       nutils,nld,
       procinfo
+{$ifdef DEBUG_NODE_DUMP}
+{$ifndef jvm}
+      ,
+      cpubase,
+      cutils,
+      itcpugas
+{$endif jvm}
+{$endif DEBUG_NODE_DUMP}
       ;
 
 
@@ -395,6 +419,15 @@
         expectloc:=LOC_VOID;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TNothingNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        { "Nothing nodes" contain no data, so just use "/>" to terminate it early }
+        WriteLn(T, ' />');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TFIRSTERROR
@@ -892,7 +925,160 @@
         docompare := false;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
+      procedure PadString(var S: string; Len: Integer);
+        var
+          X, C: Integer;
+        begin
+          C := Length(S);
+          if C < Len then
+            begin
+              SetLength(S, 7);
+              for X := C + 1 to Len do
+                S[X] := ' '
+            end;
+        end;
+
+{$ifndef jvm}
+      function FormatOp(const Oper: POper): string;
+        begin
+          case Oper^.typ of
+            top_const:
+              begin
+                case Oper^.val of
+                  -15..15:
+                    Result := '$' + tostr(Oper^.val);
+                  $10..$FF:
+                    Result := '$0x' + hexstr(Oper^.val, 2);
+                  $100..$FFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 4);
+                  $10000..$FFFFFFFF:
+                    Result := '$0x' + hexstr(Oper^.val, 8);
+                  else
+                    Result := '$0x' + hexstr(Oper^.val, 16);
+                end;
+              end;
+            top_reg:
+              Result := gas_regname(Oper^.reg);
+            top_ref:
+              with Oper^.ref^ do
+                begin
+{$if defined(x86)}
+                  if segment <> NR_NO then
+                    Result := gas_regname(segment) + ':'
+                  else
+                    Result := '';
+{$endif defined(x86)}
+
+                  if Assigned(symbol) then
+                    begin
+                      Result := Result + symbol.Name;
+                      if offset > 0 then
+                        Result := Result + '+';
+                    end;
+
+                  if offset <> 0 then
+                    Result := Result + tostr(offset)
+                  else
+                    Result := Result;
+
+                  if (base <> NR_NO) or (index <> NR_NO) then
+                    begin
+                      Result := Result + '(';
+
+                      if base <> NR_NO then
+                        begin
+                          Result := Result + gas_regname(base);
+                          if index <> NR_NO then
+                            Result := Result + ',';
+                        end;
+
+                      if index <> NR_NO then
+                        Result := Result + gas_regname(index);
+
+                      if scalefactor <> 0 then
+                        Result := Result + ',' + tostr(scalefactor) + ')'
+                      else
+                        Result := Result + ')';
+                    end;
+                end;
+            top_bool:
+              begin
+                if Oper^.b then
+                  Result := 'TRUE'
+                else
+                  Result := 'FALSE';
+              end
+            else
+              Result := '';
+          end;
+        end;
+
+{$if defined(x86)}
+      procedure ProcessInstruction(p: tai); inline;
+        var
+          ThisOp, ThisOper: string;
+          X: Integer;
+        begin
+          case p.typ of
+            ait_label:
+              WriteLn(T, PrintNodeIndention, tai_label(p).labsym.name);
+
+            ait_instruction:
+              begin
+                ThisOp := gas_op2str[taicpu(p).opcode]+cond2str[taicpu(p).condition];
+                if gas_needsuffix[taicpu(p).opcode] <> AttSufNONE then
+                  ThisOp := ThisOp + gas_opsize2str[taicpu(p).opsize];
+
+                { Pad the opcode with spaces so the succeeding operands are aligned }
+                PadString(ThisOp, 7);
+
+                Write(T, PrintNodeIndention, '  ', ThisOp); { Extra indentation to account for label formatting }
+                for X := 0 to taicpu(p).ops - 1 do
+                  begin
+                    Write(T, ' ');
+
+                    ThisOper := FormatOp(taicpu(p).oper[X]);
+                    if X < taicpu(p).ops - 1 then
+                      begin
+                        ThisOper := ThisOper + ',';
+                        PadString(ThisOper, 7);
+                      end;
+
+                    Write(T, ThisOper);
+                  end;
+                WriteLn(T);
+              end;
+            else
+              { Do nothing };
+          end;
+        end;
+
+      var
+        hp: tai;
+      begin
+        if not Assigned(p_asm) then
+          Exit;
+
+        hp := tai(p_asm.First);
+        while Assigned(hp) do
+          begin
+            ProcessInstruction(hp);
+            hp := tai(hp.Next);
+          end;
+{$else defined(x86)}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Assembler output not currently supported on this platform)');
+{$endif defined(x86)}
+{$else jvm}
+      begin
+        WriteLn(T, PrintNodeIndention, '(Should assembly language even be possible under JVM?)');
+{$endif jvm}
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPBASENODE
 *****************************************************************************}
@@ -939,7 +1125,48 @@
         settempinfoflags(gettempinfoflags-[flag])
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempBaseNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        { The raw pointer is the only way to uniquely identify the temp }
+        Write(T, ' id="', WritePointer(tempinfo), '"');
+      end;
+
+
+    procedure TTempBaseNode.XMLPrintNodeData(var T: Text);
+      var
+        Flag: TTempInfoFlag;
+        NotFirst: Boolean;
+      begin
+        inherited XMLPrintNodeData(t);
+
+        if not assigned(tempinfo) then
+          exit;
+
+        WriteLn(T, PrintNodeIndention, '<typedef>', SanitiseXMLString(tempinfo^.typedef.typesymbolprettyname), '</typedef>');
+
+        NotFirst := False;
+        for Flag := Low(TTempInfoFlag) to High(TTempInfoFlag) do
+          if (Flag in tempinfo^.flags) then
+            if not NotFirst then
+              begin
+                Write(T, PrintNodeIndention, '<tempflags>', Flag);
+                NotFirst := True;
+              end
+            else
+              Write(T, ',', Flag);
+
+        if NotFirst then
+          WriteLn(T, '</tempflags>')
+        else
+          WriteLn(T, PrintNodeIndention, '<tempflags />');
+
+        WriteLn(T, PrintNodeIndention, '<temptype>', tempinfo^.temptype, '</temptype>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                           TEMPCREATENODE
 *****************************************************************************}
@@ -1136,6 +1363,24 @@
         printnode(t,tempinfo^.tempinitcode);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempCreateNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<size>', size, '</size>');
+        if Assigned(TempInfo^.TempInitCode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<tempinit>');
+            PrintNodeIndent;
+            XMLPrintNode(T, TempInfo^.TempInitCode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</tempinit>');
+          end
+        else
+          WriteLn(T, PrintNodeIndention, '<tempinit />');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TEMPREFNODE
 *****************************************************************************}
@@ -1393,4 +1638,12 @@
           tempinfo^.typedef.GetTypeName,'", temptype = ',tempinfo^.temptype,', tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTempDeleteNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<release_to_normal>', release_to_normal, '</release_to_normal>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 end.
Index: compiler/ncal.pas
===================================================================
--- compiler/ncal.pas	(revision 42248)
+++ compiler/ncal.pas	(working copy)
@@ -201,6 +201,9 @@
        {$endif state_tracking}
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function  para_count:longint;
           function  required_para_count:longint;
           { checks if there are any parameters which end up at the stack, i.e.
@@ -1836,7 +1839,57 @@
            (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags)));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCallNode.XMLPrintNodeData(var T: Text);
+      begin
+        if assigned(procdefinition) and (procdefinition.typ=procdef) then
+          WriteLn(T, PrintNodeIndention, '<procname>', SanitiseXMLString(TProcDef(procdefinition).FullProcName(True)), '</procname>')
+        else
+          begin
+            if assigned(symtableprocentry) then
+              WriteLn(T, PrintNodeIndention, '<procname>', symtableprocentry.name, '</procname>')
+          end;
 
+        if assigned(methodpointer) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<methodpointer>');
+            PrintNodeIndent;
+            XMLPrintNode(T, methodpointer);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</methodpointer>');
+          end;
+
+        if assigned(funcretnode) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<funcretnode>');
+            PrintNodeIndent;
+            XMLPrintNode(T, funcretnode);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</funcretnode>');
+          end;
+
+        if assigned(callinitblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callinitblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callinitblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callinitblock>');
+          end;
+
+        if assigned(callcleanupblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<callcleanupblock>');
+            PrintNodeIndent;
+            XMLPrintNode(T, callcleanupblock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</callcleanupblock>');
+          end;
+
+        inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcallnode.printnodedata(var t:text);
       begin
         if assigned(procdefinition) and
Index: compiler/ncnv.pas
===================================================================
--- compiler/ncnv.pas	(revision 42248)
+++ compiler/ncnv.pas	(working copy)
@@ -64,6 +64,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean):tnode; override;
@@ -1047,7 +1050,32 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTypeConvNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TTypeConvNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T,' convtype="', convtype);
+        First := True;
+        for i := Low(TTypeConvNodeFlag) to High(TTypeConvNodeFlag) do
+          if i in ConvNodeFlags then
+            begin
+              if First then
+                begin
+                  Write(T, '" convnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+           end;
 
+        { If no flags were printed, this is the closing " for convtype }
+        Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function ttypeconvnode.typecheck_cord_to_pointer : tnode;
 
       begin
Index: compiler/ncon.pas
===================================================================
--- compiler/ncon.pas	(revision 42248)
+++ compiler/ncon.pas	(working copy)
@@ -48,6 +48,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        trealconstnodeclass = class of trealconstnode;
 
@@ -70,6 +73,10 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tordconstnodeclass = class of tordconstnode;
 
@@ -87,6 +94,9 @@
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           procedure printnodedata(var t : text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tpointerconstnodeclass = class of tpointerconstnode;
 
@@ -124,6 +134,9 @@
           { returns whether this platform uses the nil pointer to represent
             empty dynamic strings }
           class function emptydynstrnil: boolean; virtual;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tstringconstnodeclass = class of tstringconstnode;
 
@@ -494,6 +507,13 @@
         writeln(t,printnodeindention,'value = ',value_real);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TRealConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', value_real, '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                               TORDCONSTNODE
@@ -586,7 +606,21 @@
         writeln(t,printnodeindention,'value = ',tostr(value));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TOrdConstNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited XMLPrintNodeInfo(T);
+        Write(T, ' rangecheck="', rangecheck, '"');
+      end;
 
+
+    procedure TOrdConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<value>', tostr(value), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                             TPOINTERCONSTNODE
 *****************************************************************************}
@@ -668,6 +702,13 @@
         writeln(t,printnodeindention,'value = $',hexstr(PUInt(value),sizeof(PUInt)*2));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TPointerConstNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<value>$', hexstr(PUInt(value),sizeof(PUInt)*2), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                              TSTRINGCONSTNODE
@@ -1031,6 +1072,52 @@
         result:=true;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TStringConstNode.XMLPrintNodeData(var T: Text);
+      var
+        OutputStr: ansistring;
+      begin
+        inherited XMLPrintNodeData(T);
+        Write(T, printnodeindention, '<stringtype>');
+        case cst_type of
+        cst_conststring:
+          Write(T, 'conststring');
+        cst_shortstring:
+          Write(T, 'shortstring');
+        cst_longstring:
+          Write(T, 'longstring');
+        cst_ansistring:
+          Write(T, 'ansistring');
+        cst_widestring:
+          Write(T, 'widestring');
+        cst_unicodestring:
+          Write(T, 'unicodestring');
+        end;
+        WriteLn(T, '</stringtype>');
+        WriteLn(T, printnodeindention, '<length>', len, '</length>');
+
+        if len = 0 then
+          begin
+            WriteLn(T, printnodeindention, '<value />');
+            Exit;
+          end;
+
+        case cst_type of
+        cst_widestring, cst_unicodestring:
+          begin
+            { value_str is of type PCompilerWideString }
+            SetLength(OutputStr, len);
+            UnicodeToUtf8(PChar(OutputStr), PUnicodeChar(PCompilerWideString(value_str)^.data), len + 1); { +1 for the null terminator }
+          end;
+        else
+          OutputStr := ansistring(value_str);
+          SetLength(OutputStr, len);
+        end;
+
+        WriteLn(T, printnodeindention, '<value>', SanitiseXMLString(OutputStr), '</value>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
 {*****************************************************************************
                              TSETCONSTNODE
 *****************************************************************************}
Index: compiler/nflw.pas
===================================================================
--- compiler/nflw.pas	(revision 42248)
+++ compiler/nflw.pas	(working copy)
@@ -68,6 +68,10 @@
           procedure derefimpl;override;
           procedure insertintolist(l : tnodelist);override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+          procedure XMLPrintNodeTree(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
        end;
 
@@ -1049,7 +1053,120 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoopNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TLoopFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
 
+        First := True;
+        for i := Low(TLoopFlag) to High(TLoopFlag) do
+          if i in loopflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' loopflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+
+    procedure TLoopNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        if Assigned(Left) then
+          begin
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '<counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '<condition>');
+            PrintNodeIndent;
+            XMLPrintNode(T, Left);
+            PrintNodeUnindent;
+            if nodetype = forn then
+              WriteLn(T, PrintNodeIndention, '</counter>')
+            else
+              WriteLn(T, PrintNodeIndention, '</condition>');
+          end;
+
+        if Assigned(Right) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<first>');
+              else
+                WriteLn(T, PrintNodeIndention, '<right>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, Right);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</then>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</first>');
+              else
+                WriteLn(T, PrintNodeIndention, '</right>');
+            end;
+          end;
+
+        if Assigned(t1) then
+          begin
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '<else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '<last>');
+              else
+                WriteLn(T, PrintNodeIndention, '<t1>');
+            end;
+            PrintNodeIndent;
+            XMLPrintNode(T, t1);
+            PrintNodeUnindent;
+            case nodetype of
+              ifn:
+                WriteLn(T, PrintNodeIndention, '</else>');
+              forn:
+                WriteLn(T, PrintNodeIndention, '</last>');
+              else
+                WriteLn(T, PrintNodeIndention, '</t1>');
+            end;
+          end;
+
+        if Assigned(t2) then
+          begin
+
+            if nodetype <> forn then
+              begin
+                WriteLn(T, PrintNodeIndention, '<loop>');
+                PrintNodeIndent;
+              end;
+
+            XMLPrintNode(T, t2);
+
+            if nodetype <> forn then
+              begin
+                PrintNodeUnindent;
+                WriteLn(T, PrintNodeIndention, '</loop>');
+              end;
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tloopnode.docompare(p: tnode): boolean;
       begin
         docompare :=
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 42248)
+++ compiler/ninl.pas	(working copy)
@@ -36,6 +36,9 @@
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           procedure printnodeinfo(var t : text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_DUMP}
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck_cpu:tnode;virtual;
@@ -191,6 +194,13 @@
         write(t,', inlinenumber = ',inlinenumber);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      begin
+        inherited;
+        Write(T, ' inlinenumber="', inlinenumber, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function get_str_int_func(def: tdef): string;
     var
Index: compiler/nld.pas
===================================================================
--- compiler/nld.pas	(revision 42248)
+++ compiler/nld.pas	(working copy)
@@ -71,6 +71,9 @@
           procedure mark_write;override;
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure setprocdef(p : tprocdef);
           property procdef: tprocdef read fprocdef write setprocdef;
        end;
@@ -97,6 +100,9 @@
           function track_state_pass(exec_known:boolean):boolean;override;
        {$endif state_tracking}
           function docompare(p: tnode): boolean; override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tassignmentnodeclass = class of tassignmentnode;
 
@@ -471,7 +477,17 @@
         writeln(t,'');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TLoadNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, printnodeindention, '<symbol>', symtableentry.name, '</symbol>');
 
+        if symtableentry.typ = procsym then
+          WriteLn(T, printnodeindention, '<procdef>', fprocdef.mangledname, '</procdef>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
         fprocdef:=p;
@@ -956,6 +972,18 @@
 {$endif}
 
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For assignments, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
 {*****************************************************************************
                            TARRAYCONSTRUCTORRANGENODE
 *****************************************************************************}
Index: compiler/nmem.pas
===================================================================
--- compiler/nmem.pas	(revision 42248)
+++ compiler/nmem.pas	(working copy)
@@ -88,6 +88,9 @@
           procedure buildderefimpl;override;
           procedure derefimpl;override;
           procedure printnodeinfo(var t: text); override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -121,6 +124,9 @@
           function docompare(p: tnode): boolean; override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tsubscriptnodeclass = class of tsubscriptnode;
 
@@ -133,6 +139,9 @@
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
        end;
        tvecnodeclass = class of tvecnode;
 
@@ -481,6 +490,29 @@
         write(t,']');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TAddrNode.XMLPrintNodeInfo(var T: Text);
+      var
+        First: Boolean;
+        i: TAddrNodeFlag;
+      begin
+        inherited XMLPrintNodeInfo(t);
+        First := True;
+        for i := Low(TAddrNodeFlag) to High(TAddrNodeFlag) do
+          if i in addrnodeflags then
+            begin
+              if First then
+                begin
+                  Write(T, ' addrnodeflags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i);
+            end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function taddrnode.docompare(p: tnode): boolean;
       begin
@@ -897,6 +929,13 @@
           (vs = tsubscriptnode(p).vs);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TSubscriptNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        WriteLn(T, PrintNodeIndention, '<field>', vs.Name, '</field>');
+      end;
+{$endif DEBUG_NODE_DUMP}
 
 {*****************************************************************************
                                TVECNODE
@@ -1299,6 +1338,24 @@
     end;
 
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TVecNode.XMLPrintNodeData(var T: Text);
+      begin
+        XMLPrintNode(T, Left);
+
+        { The right node is the index }
+        WriteLn(T, PrintNodeIndention, '<index>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</index>');
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
     function is_big_untyped_addrnode(p: tnode): boolean;
       begin
         is_big_untyped_addrnode:=(p.nodetype=addrn) and
Index: compiler/node.pas
===================================================================
--- compiler/node.pas	(revision 42248)
+++ compiler/node.pas	(working copy)
@@ -383,6 +383,15 @@
          procedure printnodeinfo(var t:text);virtual;
          procedure printnodedata(var t:text);virtual;
          procedure printnodetree(var t:text);virtual;
+{$ifdef DEBUG_NODE_DUMP}
+         { For writing nodes to XML files - do not call directly, but
+           instead call XMLPrintNode to write a complete tree }
+         procedure XMLPrintNodeInfo(var T: Text); dynamic;
+         procedure XMLPrintNodeData(var T: Text); virtual;
+         procedure XMLPrintNodeTree(var T: Text); virtual;
+         class function SanitiseXMLString(const S: ansistring): ansistring;
+         class function WritePointer(const P: Pointer): ansistring;
+{$endif DEBUG_NODE_DUMP}
          procedure concattolist(l : tlinkedlist);virtual;
          function ischild(p : tnode) : boolean;virtual;
 
@@ -413,6 +422,9 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       //pbinarynode = ^tbinarynode;
@@ -431,6 +443,10 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeTree(var T: Text); override;
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
          procedure printnodelist(var t:text);
       end;
 
@@ -449,11 +465,17 @@
          function dogetcopy : tnode;override;
          procedure insertintolist(l : tnodelist);override;
          procedure printnodedata(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
       tbinopnode = class(tbinarynode)
          constructor create(t:tnodetype;l,r : tnode);virtual;
          function docompare(p : tnode) : boolean;override;
+{$ifdef DEBUG_NODE_DUMP}
+         procedure XMLPrintNodeData(var T: Text); override;
+{$endif DEBUG_NODE_DUMP}
       end;
 
     var
@@ -476,7 +498,9 @@
     procedure printnodeunindent;
     procedure printnode(var t:text;n:tnode);
     procedure printnode(n:tnode);
-
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+{$endif DEBUG_NODE_DUMP}
     function is_constnode(p : tnode) : boolean;
     function is_constintnode(p : tnode) : boolean;
     function is_constcharnode(p : tnode) : boolean;
@@ -494,6 +518,9 @@
 
     uses
        verbose,entfile,comphook,
+{$ifdef DEBUG_NODE_DUMP}
+       cutils,
+{$endif DEBUG_NODE_DUMP}
        symconst,
        nutils,nflw,
        defutil;
@@ -656,6 +683,13 @@
         printnode(output,n);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLPrintNode(var T: Text; N: TNode);
+      begin
+        if Assigned(N) then
+          N.XMLPrintNodeTree(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     function is_constnode(p : tnode) : boolean;
       begin
@@ -898,7 +932,355 @@
          writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    { For writing nodes to XML files - do not call directly, but
+      instead call XMLPrintNode to write a complete tree }
+    procedure tnode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TNodeFlag;
+        first: Boolean;
+      begin
+        if Assigned(resultdef) then
+          Write(T,' resultdef="', SanitiseXMLString(resultdef.typesymbolprettyname), '"');
 
+        Write(T,' pos="',fileinfo.line,',',fileinfo.column);
+
+        First := True;
+        for i := Low(TNodeFlag) to High(TNodeFlag) do
+          if i in flags then
+            begin
+              if First then
+                begin
+                  Write(T, '" flags="', i);
+                  First := False;
+                end
+              else
+                Write(T, ',', i)
+            end;
+
+        write(t,'" complexity="',node_complexity(self),'"');
+      end;
+
+    procedure tnode.XMLPrintNodeData(var T: Text);
+      begin
+        { Nothing by default }
+      end;
+
+    procedure tnode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+
+    class function TNode.WritePointer(const P: Pointer): ansistring;
+      begin
+        case PtrUInt(P) of
+          0:
+            WritePointer := 'nil';
+          1..$FFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 4);
+          $10000..$FFFFFFFF:
+            WritePointer := '$' + hexstr(PtrUInt(P), 8);
+{$ifdef CPU64}
+          else
+            WritePointer := '$' + hexstr(PtrUInt(P), 16);
+{$endif CPU64}
+        end;
+      end;
+
+    class function TNode.SanitiseXMLString(const S: ansistring): ansistring;
+      var
+        X, UTF8Len, UTF8Char, CurrentChar: Integer;
+        needs_quoting, in_quotes, add_end_quote: Boolean;
+        DoASCII: Boolean;
+
+        { Write the given byte as #xxx }
+        procedure EncodeControlChar(Value: Byte);
+          begin
+            if X = Length(Result) then
+              add_end_quote := False;
+
+            Delete(Result, X, 1);
+            if in_quotes then
+              begin
+                Insert('#' + tostr(Value) + '''', Result, X);
+
+                { If the entire string consists of control characters, it
+                  doesn't need quoting, so only set the flag here }
+                needs_quoting := True;
+
+                in_quotes := False;
+              end
+            else
+              Insert('#' + tostr(Value), Result, X);
+          end;
+
+        { Write the given byte as either a plain character or an XML keyword }
+        procedure EncodeStandardChar(Value: Byte);
+          begin
+            if not in_quotes then
+              begin
+                in_quotes := True;
+                if (X < Length(Result)) then
+                  begin
+                    needs_quoting := True;
+                    Insert('''', Result, X + 1)
+                  end;
+              end;
+
+            { Check the character for anything that could be mistaken for an XML element }
+            case CurrentChar of
+              Ord('#'):
+                { Required to differentiate '#27' from the escape code #27, for example }
+                needs_quoting:=true;
+
+              Ord('<'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&lt;', Result, X);
+                end;
+              Ord('>'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&gt;', Result, X);
+                end;
+              Ord('&'):
+                begin
+                  Delete(Result, X, 1);
+                  Insert('&amp;', Result, X);
+                end;
+              Ord('"'):
+                begin
+                  needs_quoting := True;
+                  Delete(Result, X, 1);
+                  Insert('&quot;', Result, X);
+                end;
+              Ord(''''):
+                begin
+                  needs_quoting:=true;
+                  { Simply double it like in pascal strings }
+                  Insert('''', Result, X);
+                end;
+              else
+                { Do nothing };
+            end;
+          end;
+
+        { Convert character between $80 and $FF to UTF-8 }
+        procedure EncodeExtendedChar(Value: Byte);
+          begin
+            if not in_quotes then
+              begin
+                in_quotes := True;
+                if (X < Length(Result)) then
+                  begin
+                    needs_quoting := True;
+                    Insert('''', Result, X + 1)
+                  end;
+              end;
+
+            case Value of
+              $80..$BF: { Add $C2 before the value }
+                Insert(#$C2, Result, X);
+              $C0..$FF: { Zero the $40 bit and add $C3 before the value }
+                begin
+                  Result[X] := Char(Byte(Result[X]) and $BF);
+                  Insert(#$C3, Result, X);
+                end;
+              else
+                { Previous conditions should prevent this procedure from being
+                  called if Value < $80 }
+                InternalError(2019061901);
+            end;
+          end;
+
+      begin
+        needs_quoting := False;
+        Result := S;
+
+        { Gets set to True if an invalid UTF-8 sequence is found }
+        DoASCII := False;
+
+        { By setting in_quotes to false here, we can exclude the single
+          quotation marks surrounding the string if it doesn't contain any
+          control characters, or consists entirely of control characters. }
+        in_quotes := False;
+
+        add_end_quote := True;
+
+        X := Length(Result);
+        while X > 0 do
+          begin
+            CurrentChar := Ord(Result[X]);
+
+            { Control characters and extended characters need special handling }
+            case CurrentChar of
+              $00..$1F, $7F:
+                EncodeControlChar(CurrentChar);
+
+              $20..$7E:
+                EncodeStandardChar(CurrentChar);
+
+              { UTF-8 continuation byte }
+              $80..$BF:
+                begin
+                  if not in_quotes then
+                    begin
+                      in_quotes := True;
+                      if (X < Length(Result)) then
+                        begin
+                          needs_quoting := True;
+                          Insert('''', Result, X + 1)
+                        end;
+                    end;
+
+                  UTF8Char := CurrentChar and $3F; { The data bits of the continuation byte }
+                  UTF8Len := 1; { This variable actually holds 1 less than the length }
+
+                  { By setting DoASCII to true, it marks the string as 'invalid UTF-8'
+                    automatically if it reaches the beginning of the string unexpectedly }
+                  DoASCII := True;
+
+                  Dec(X);
+                  while X > 0 do
+                    begin
+                      CurrentChar := Ord(Result[X]);
+
+                      case CurrentChar of
+                        { A standard character here is invalid UTF-8 }
+                        $00..$7F:
+                          Break;
+
+                        { Another continuation byte }
+                        $80..$BF:
+                          begin
+                            UTF8Char := UTF8Char or ((CurrentChar and $3F) shl (6 * UTF8Len));
+
+                            Inc(UTF8Len);
+                            if UTF8Len >= 4 then
+                              { Sequence too long }
+                              Break;
+                          end;
+
+                        { Lead byte for 2-byte sequences }
+                        $C2..$DF:
+                          begin
+                            if UTF8Len <> 1 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $1F) shl 6);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $0080..$07FF:
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Lead byte for 3-byte sequences }
+                        $E0..$EF:
+                          begin
+                            if UTF8Len <> 2 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $0F) shl 12);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $0800..$D7FF, $E000..$FFFF: { $D800..$DFFF is reserved and hence invalid }
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Lead byte for 4-byte sequences }
+                        $F0..$F4:
+                          begin
+                            if UTF8Len <> 3 then Break;
+
+                            UTF8Char := UTF8Char or ((CurrentChar and $07) shl 18);
+
+                            { Check to see if the code is in range and not part of an 'overlong' sequence }
+                            case UTF8Char of
+                              $010000..$10FFFF:
+                                DoASCII := False;
+                              else
+                                { Do nothing - DoASCII is already true }
+                            end;
+                            Break;
+                          end;
+
+                        { Invalid character }
+                        else
+                          Break;
+                      end;
+                    end;
+
+                  if DoASCII then
+                    Break;
+
+                  { If all is fine, we don't need to encode any more characters }
+                end;
+
+              { Invalid UTF-8 bytes and lead bytes without continuation bytes }
+              $C0..$FF:
+                begin
+                  DoASCII := True;
+                  Break;
+                end;
+            end;
+
+            Dec(X);
+          end;
+
+        { UTF-8 failed, so encode the string as plain ASCII }
+        if DoASCII then
+          begin
+            { Reset the flags and Result }
+            needs_quoting := False;
+            Result := S;
+            in_quotes := False;
+            add_end_quote := True;
+
+            for X := Length(Result) downto 1 do
+              begin
+                CurrentChar := Ord(Result[X]);
+
+                { Control characters and extended characters need special handling }
+                case CurrentChar of
+                  $00..$1F, $7F:
+                    EncodeControlChar(CurrentChar);
+
+                  $20..$7E:
+                    EncodeStandardChar(CurrentChar);
+
+                  { Extended characters }
+                  else
+                    EncodeExtendedChar(CurrentChar);
+
+                end;
+              end;
+          end;
+
+        if needs_quoting then
+          begin
+            if in_quotes then
+              Result := '''' + Result;
+
+            if add_end_quote then
+              Result := Result + '''';
+          end;
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     function tnode.isequal(p : tnode) : boolean;
       begin
          isequal:=
@@ -1058,6 +1440,13 @@
          printnode(t,left);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TUnaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         inherited XMLPrintNodeData(T);
+         XMLPrintNode(T, Left);
+      end;
+{$endif DEBUG_NODE_DUMP}
 
     procedure tunarynode.concattolist(l : tlinkedlist);
       begin
@@ -1185,7 +1574,27 @@
          printnode(t,right);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinaryNode.XMLPrintNodeTree(var T: Text);
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        XMLPrintNodeData(T);
+      end;
 
+
+    procedure TBinaryNode.XMLPrintNodeData(var T: Text);
+      begin
+        inherited XMLPrintNodeData(T);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+        { Right nodes are on the same indentation level }
+        XMLPrintNode(T, Right);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tbinarynode.printnodelist(var t:text);
       var
         hp : tbinarynode;
@@ -1286,7 +1695,22 @@
          printnode(t,third);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TTertiaryNode.XMLPrintNodeData(var T: Text);
+      begin
+         if Assigned(Third) then
+           begin
+             WriteLn(T, PrintNodeIndention, '<third-branch>');
+             PrintNodeIndent;
+             XMLPrintNode(T, Third);
+             PrintNodeUnindent;
+             WriteLn(T, PrintNodeIndention, '</third-branch>');
+           end;
 
+         inherited XMLPrintNodeData(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure ttertiarynode.concattolist(l : tlinkedlist);
       begin
          third.parent:=self;
@@ -1320,6 +1744,18 @@
             right.isequal(tbinopnode(p).left));
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TBinOpNode.XMLPrintNodeData(var T: Text);
+      begin
+        { For binary operations, put the left and right branches on the same level for clarity }
+        XMLPrintNode(T, Left);
+        XMLPrintNode(T, Right);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
+
 begin
 {$push}{$warnings off}
   { tvaroption must fit into a 4 byte set for speed reasons }
Index: compiler/nset.pas
===================================================================
--- compiler/nset.pas	(revision 42248)
+++ compiler/nset.pas	(working copy)
@@ -120,6 +120,9 @@
           procedure derefimpl;override;
           function dogetcopy : tnode;override;
           procedure printnodetree(var t:text);override;
+{$ifdef DEBUG_NODE_DUMP}
+          procedure XMLPrintNodeTree(var t:text); override;
+{$endif DEBUG_NODE_DUMP}
           procedure insertintolist(l : tnodelist);override;
           function pass_typecheck:tnode;override;
           function pass_1 : tnode;override;
@@ -1014,7 +1017,44 @@
         writeln(t,printnodeindention,')');
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure TCaseNode.XMLPrintNodeTree(var T: Text);
+      var
+        i : longint;
+      begin
+        Write(T, PrintNodeIndention, '<', nodetype2str[nodetype]);
+        XMLPrintNodeInfo(T);
+        WriteLn(T, '>');
+        PrintNodeIndent;
+        WriteLn(T, PrintNodeIndention, '<condition>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Left);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</condition>');
 
+        i:=0;
+        for i:=0 to blocks.count-1 do
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="', i, '">');
+            PrintNodeIndent;
+            XMLPrintNode(T, PCaseBlock(blocks[i])^.statement);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+        if assigned(elseblock) then
+          begin
+            WriteLn(T, PrintNodeIndention, '<block id="else">');;
+            PrintNodeIndent;
+            XMLPrintNode(T, ElseBlock);
+            PrintNodeUnindent;
+            WriteLn(T, PrintNodeIndention, '</block>');
+          end;
+
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</', nodetype2str[nodetype], '>');
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcasenode.insertintolist(l : tnodelist);
       begin
       end;
Index: compiler/pmodules.pas
===================================================================
--- compiler/pmodules.pas	(revision 42248)
+++ compiler/pmodules.pas	(working copy)
@@ -881,6 +881,10 @@
          current_module.SetFileName(main_file.path+main_file.name,true);
          current_module.SetModuleName(unitname);
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('unit', unitname);
+{$endif DEBUG_NODE_DUMP}
+
          { check for system unit }
          new(s2);
          s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),''));
@@ -1018,6 +1022,10 @@
             Message1(unit_f_errors_in_unit,tostr(Errorcount));
             status.skip_error:=true;
             symtablestack.pop(current_module.globalsymtable);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1311,6 +1319,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1400,6 +1412,10 @@
             module_is_done;
             if not immediate then
               restore_global_state(globalstate,true);
+
+{$ifdef DEBUG_NODE_DUMP}
+            XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
             exit;
           end;
 
@@ -1459,6 +1475,9 @@
                 waitingmodule.end_of_parsing;
               end;
           end;
+{$ifdef DEBUG_NODE_DUMP}
+        XMLFinalizeNodeFile('unit');
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
@@ -1540,6 +1559,10 @@
 
          setupglobalswitches;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLInitializeNodeFile('package', module_name);
+{$endif DEBUG_NODE_DUMP}
+
          consume(_SEMICOLON);
 
          { global switches are read, so further changes aren't allowed }
@@ -1722,6 +1745,10 @@
              main_procinfo.generate_code;
            end;
 
+{$ifdef DEBUG_NODE_DUMP}
+         XMLFinalizeNodeFile('package');
+{$endif DEBUG_NODE_DUMP}
+
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
            begin
@@ -1986,6 +2013,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('library', program_name);
+{$endif DEBUG_NODE_DUMP}
            end
          else
            { is there an program head ? }
@@ -2032,6 +2063,10 @@
               setupglobalswitches;
 
               consume(_SEMICOLON);
+
+{$ifdef DEBUG_NODE_DUMP}
+              XMLInitializeNodeFile('program', program_name);
+{$endif DEBUG_NODE_DUMP}
             end
          else
            begin
@@ -2040,6 +2075,10 @@
 
              { setup things using the switches }
              setupglobalswitches;
+
+{$ifdef DEBUG_NODE_DUMP}
+             XMLInitializeNodeFile('program', current_module.realmodulename^);
+{$endif DEBUG_NODE_DUMP}
            end;
 
          { load all packages, so we know whether a unit is contained inside a
@@ -2262,6 +2301,13 @@
          { consume the last point }
          consume(_POINT);
 
+{$ifdef DEBUG_NODE_DUMP}
+         if IsLibrary then
+           XMLFinalizeNodeFile('library')
+         else
+           XMLFinalizeNodeFile('program');
+{$endif DEBUG_NODE_DUMP}
+
          { reset wpo flags for all defs }
          reset_all_defs;
 
Index: compiler/psub.pas
===================================================================
--- compiler/psub.pas	(revision 42248)
+++ compiler/psub.pas	(working copy)
@@ -65,11 +65,20 @@
         procedure parse_body;
 
         function has_assembler_child : boolean;
+
+{$ifdef DEBUG_NODE_DUMP}
+        procedure XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
       end;
 
 
     procedure printnode_reset;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+{$endif DEBUG_NODE_DUMP}
+
     { reads the declaration blocks }
     procedure read_declarations(islibrary : boolean);
 
@@ -1138,6 +1147,67 @@
           end;
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure tcgprocinfo.XMLPrintProc;
+      var
+        T: Text;
+        W: Word;
+        syssym: tsyssym;
+
+      procedure PrintOption(Flag: string);
+        begin
+          WriteLn(T, PrintNodeIndention, '<option>', Flag, '</option>');
+        end;
+
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult <> 0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        Write(T, PrintNodeIndention, '<procedure');
+        Write(T, ' name="', TNode.SanitiseXMLString(procdef.customprocname([])), '"');
+
+        if po_hascallingconvention in procdef.procoptions then
+          Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
+
+        WriteLn(T, '>');
+
+        PrintNodeIndent;
+
+        if po_compilerproc in procdef.procoptions then
+          PrintOption('compilerproc');
+        if po_assembler in procdef.procoptions then
+          PrintOption('assembler');
+        if po_nostackframe in procdef.procoptions then
+          PrintOption('nostackframe');
+        if po_inline in procdef.procoptions then
+          PrintOption('inline');
+        if po_noreturn in procdef.procoptions then
+          PrintOption('noreturn');
+        if po_noinline in procdef.procoptions then
+          PrintOption('noinline');
+
+        WriteLn(T, PrintNodeIndention, '<code>');
+        PrintNodeIndent;
+        XMLPrintNode(T, Code);
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</code>');
+        PrintNodeUnindent;
+        WriteLn(T, PrintNodeIndention, '</procedure>');
+        WriteLn(T); { Line for spacing }
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure tcgprocinfo.generate_code_tree;
       var
         hpi : tcgprocinfo;
@@ -1435,7 +1505,7 @@
 {$endif i386 or i8086}
 
         { Print the node to tree.log }
-        if paraprintnodetree=1 then
+        if paraprintnodetree <> 0 then
           printproc( 'after the firstpass');
 
         { do this before adding the entry code else the tail recursion recognition won't work,
@@ -1560,7 +1630,7 @@
             CalcExecutionWeights(code);
 
             { Print the node to tree.log }
-            if paraprintnodetree=1 then
+            if paraprintnodetree <> 0 then
               printproc( 'right before code generation');
 
             { generate code for the node tree }
@@ -2043,9 +2113,14 @@
            CreateInlineInfo;
 
          { Print the node to tree.log }
-         if paraprintnodetree=1 then
+         if paraprintnodetree <> 0 then
            printproc( 'after parsing');
 
+{$ifdef DEBUG_NODE_DUMP}
+         printnodeindention := printnodespacing;
+         XMLPrintProc;
+{$endif DEBUG_NODE_DUMP}
+
          { ... remove symbol tables }
          remove_from_symtablestack;
 
@@ -2461,7 +2536,51 @@
           MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
       end;
 
+{$ifdef DEBUG_NODE_DUMP}
+    procedure XMLInitializeNodeFile(RootName, ModuleName: shortstring);
+      var
+        T: Text;
+      begin
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Rewrite(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            current_module.ppxfilefail := True;
+            Exit;
+          end;
+        {$pop}
+        { Mark the node dump file as available for writing }
+        current_module.ppxfilefail := False;
+        WriteLn(T, '<?xml version="1.0" encoding="utf-8"?>');
+        WriteLn(T, '<', RootName, ' name="', ModuleName, '">');
+        Close(T);
+      end;
 
+
+    procedure XMLFinalizeNodeFile(RootName: shortstring);
+      var
+        T: Text;
+      begin
+        if current_module.ppxfilefail then
+          Exit;
+
+        current_module.ppxfilefail := True; { File is now considered closed no matter what happens }
+        Assign(T, current_module.ppxfilename);
+        {$push} {$I-}
+        Append(T);
+        if IOResult<>0 then
+          begin
+            Message1(exec_e_cant_create_archivefile,current_module.ppxfilename);
+            Exit;
+          end;
+        {$pop}
+        WriteLn(T, '</', RootName, '>');
+        Close(T);
+      end;
+{$endif DEBUG_NODE_DUMP}
+
     procedure read_declarations(islibrary : boolean);
       var
         hadgeneric : boolean;

Pierre Muller

2019-06-22 16:13

developer   ~0116849

  The feature has committed to trunk in revision 42271.

  Please note that the conditional was renamed DEBUG_NODE_XML
but better fit with other existing DEBUG conditionals.

Log of commit:

  Commit of new debug feature implemented by J. Gareth Morenton
  Allows compilation of compiler using -dDEBUG_NODE_XML
  which will generate a NAME-node-dump.xml file for each
  unit, program or library compiled,
  containing a XML description of the nodes handled during
  compilation of the unit, program or library.

Thanks, Gareth!

Issue History

Date Modified Username Field Change
2019-02-05 19:44 J. Gareth Moreton New Issue
2019-02-05 19:44 J. Gareth Moreton File Added: xml-node-output.patch
2019-02-05 19:45 J. Gareth Moreton Priority normal => low
2019-02-05 19:45 J. Gareth Moreton Severity minor => feature
2019-02-05 19:57 J. Gareth Moreton Tag Attached: compiler
2019-02-05 19:57 J. Gareth Moreton Tag Attached: debug
2019-02-05 19:57 J. Gareth Moreton Tag Attached: node
2019-02-05 19:57 J. Gareth Moreton Tag Attached: patch
2019-02-05 19:57 J. Gareth Moreton Tag Attached: XML
2019-02-06 00:28 J. Gareth Moreton Note Added: 0113876
2019-02-06 00:28 J. Gareth Moreton Description Updated View Revisions
2019-02-06 01:57 J. Gareth Moreton File Deleted: xml-node-output.patch
2019-02-06 01:57 J. Gareth Moreton File Added: xml-node-output.patch
2019-02-06 01:58 J. Gareth Moreton Note Added: 0113882
2019-02-06 04:22 J. Gareth Moreton File Added: xml-stringconst-node-output.patch
2019-02-06 04:23 J. Gareth Moreton Note Added: 0113885
2019-02-07 00:58 J. Gareth Moreton File Deleted: xml-stringconst-node-output.patch
2019-02-07 00:58 J. Gareth Moreton File Deleted: xml-node-output.patch
2019-02-07 00:58 J. Gareth Moreton File Added: xml-node-output.patch
2019-02-07 00:59 J. Gareth Moreton Note Added: 0113913
2019-03-02 19:03 J. Gareth Moreton File Deleted: xml-node-output.patch
2019-03-02 19:03 J. Gareth Moreton File Added: xml-node-output.patch
2019-03-02 19:05 J. Gareth Moreton Note Added: 0114581
2019-03-08 17:00 J. Gareth Moreton Note Added: 0114715
2019-04-09 11:19 J. Gareth Moreton Note Added: 0115341
2019-04-09 11:19 J. Gareth Moreton Note Edited: 0115341 View Revisions
2019-05-21 17:57 Pierre Muller Note Added: 0116306
2019-05-21 18:52 J. Gareth Moreton Note Added: 0116307
2019-05-21 23:04 Pierre Muller Note Added: 0116313
2019-05-22 01:54 J. Gareth Moreton File Deleted: xml-node-output.patch
2019-05-22 01:57 J. Gareth Moreton File Added: xml-node-output.patch
2019-05-22 01:57 J. Gareth Moreton Note Added: 0116323
2019-05-22 09:05 Pierre Muller Note Added: 0116324
2019-05-22 09:49 Tomas Hajny Note Added: 0116325
2019-05-22 10:03 Pierre Muller Note Added: 0116326
2019-05-22 11:41 rd0x Note Added: 0116329
2019-05-22 16:07 Pierre Muller File Added: xml-node-output-mod2.patch
2019-05-22 16:07 Pierre Muller Note Added: 0116333
2019-05-22 16:26 Pierre Muller Note Added: 0116335
2019-05-22 16:32 J. Gareth Moreton Note Added: 0116336
2019-05-22 16:44 Pierre Muller Note Added: 0116340
2019-05-22 19:10 J. Gareth Moreton Note Added: 0116345
2019-05-22 21:44 J. Gareth Moreton Note Added: 0116348
2019-05-22 23:56 J. Gareth Moreton File Added: xml-node-output-mod3.patch
2019-05-22 23:56 J. Gareth Moreton Note Added: 0116355
2019-05-22 23:56 J. Gareth Moreton File Deleted: xml-node-output.patch
2019-05-22 23:57 J. Gareth Moreton File Deleted: xml-node-output-mod2.patch
2019-05-23 01:14 J. Gareth Moreton File Deleted: xml-node-output-mod3.patch
2019-05-23 01:15 J. Gareth Moreton File Added: xml-node-output-mod3.patch
2019-05-23 01:24 J. Gareth Moreton File Deleted: xml-node-output-mod3.patch
2019-05-23 01:26 J. Gareth Moreton File Added: xml-node-output-mod3.patch
2019-05-23 01:26 J. Gareth Moreton Note Added: 0116359
2019-05-23 02:14 J. Gareth Moreton Note Added: 0116360
2019-05-23 13:34 Pierre Muller Note Added: 0116369
2019-05-23 18:09 J. Gareth Moreton Note Added: 0116373
2019-05-23 19:01 J. Gareth Moreton Note Added: 0116374
2019-05-23 20:22 J. Gareth Moreton File Added: xml-node-output-mod4.patch
2019-05-23 20:22 J. Gareth Moreton Note Added: 0116376
2019-05-23 21:24 Pierre Muller File Added: xml-node-output-mod5.patch
2019-05-23 21:24 Pierre Muller Note Added: 0116379
2019-05-23 23:17 J. Gareth Moreton File Added: xml-node-output-mod6.patch
2019-05-23 23:17 J. Gareth Moreton Note Added: 0116382
2019-05-23 23:18 J. Gareth Moreton Note Edited: 0116382 View Revisions
2019-05-25 18:26 J. Gareth Moreton Note Added: 0116413
2019-05-27 08:44 Pierre Muller File Added: xml-node-output-mod7.patch
2019-05-27 08:44 Pierre Muller Note Added: 0116427
2019-05-27 08:57 J. Gareth Moreton Note Added: 0116428
2019-05-28 19:53 J. Gareth Moreton File Added: xml-node-output-mod8.patch
2019-05-28 19:53 J. Gareth Moreton Note Added: 0116449
2019-05-29 06:56 J. Gareth Moreton Note Added: 0116450
2019-06-10 22:27 J. Gareth Moreton Note Added: 0116667
2019-06-19 09:06 Pierre Muller Note Added: 0116782
2019-06-19 10:01 J. Gareth Moreton Note Added: 0116783
2019-06-19 10:13 Pierre Muller Note Added: 0116784
2019-06-19 10:39 J. Gareth Moreton Note Added: 0116786
2019-06-19 14:35 J. Gareth Moreton File Added: xml-node-output-mod9.patch
2019-06-19 14:35 J. Gareth Moreton Note Added: 0116789
2019-06-22 16:13 Pierre Muller Assigned To => Pierre Muller
2019-06-22 16:13 Pierre Muller Status new => resolved
2019-06-22 16:13 Pierre Muller Resolution open => fixed
2019-06-22 16:13 Pierre Muller Fixed in Version => 3.3.1
2019-06-22 16:13 Pierre Muller Fixed in Revision => 42271
2019-06-22 16:13 Pierre Muller FPCTarget => -
2019-06-22 16:13 Pierre Muller Note Added: 0116849