mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 11:24:14 +02:00
* Adapted from patch node-dump-pass-1.patch submitted by J. Gareth Moreton from bug report 38156.
This patch extends the DEBUG_NODE_XML debug feature by also outputting,
to the *-node-dump.xml files, the node tree as it appears after the first pass,
since it often contains many more internal nodes like temporary allocations that may need
to be evaluated for debugging and development purposes, or node-level optimisation opportunities.
git-svn-id: trunk@47709 -
This commit is contained in:
pierre
parent
54627fe1e7
commit
a7232669ff
@ -86,7 +86,7 @@ interface
|
||||
function has_assembler_child : boolean;
|
||||
procedure set_eh_info; override;
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
procedure XMLPrintProc;
|
||||
procedure XMLPrintProc(FirstHalf: Boolean);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
end;
|
||||
|
||||
@ -1437,15 +1437,19 @@ implementation
|
||||
|
||||
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
procedure tcgprocinfo.XMLPrintProc;
|
||||
procedure tcgprocinfo.XMLPrintProc(FirstHalf: Boolean);
|
||||
var
|
||||
T: Text;
|
||||
W: Word;
|
||||
syssym: tsyssym;
|
||||
separate : boolean;
|
||||
|
||||
procedure PrintType(Flag: string);
|
||||
begin
|
||||
Write(T, ' type="', Flag, '"');
|
||||
if df_generic in procdef.defoptions then
|
||||
Write(T, ' type="generic ', Flag, '"')
|
||||
else
|
||||
Write(T, ' type="', Flag, '"');
|
||||
end;
|
||||
|
||||
procedure PrintOption(Flag: string);
|
||||
@ -1467,109 +1471,132 @@ implementation
|
||||
Exit;
|
||||
end;
|
||||
{$pop}
|
||||
Write(T, PrintNodeIndention, '<subroutine');
|
||||
|
||||
{ Check to see if the procedure is a class or object method }
|
||||
if Assigned(procdef.struct) then
|
||||
separate := (df_generic in procdef.defoptions);
|
||||
|
||||
{ First half prints the header and the nodes as a "code" tag }
|
||||
if FirstHalf or separate then
|
||||
begin
|
||||
if Assigned(procdef.struct.objrealname) then
|
||||
Write(T, ' struct="', SanitiseXMLString(procdef.struct.objrealname^), '"')
|
||||
else
|
||||
Write(T, ' struct="<NULL>"');
|
||||
Write(T, PrintNodeIndention, '<subroutine');
|
||||
{ Check to see if the procedure is a class or object method }
|
||||
if Assigned(procdef.struct) then
|
||||
begin
|
||||
if Assigned(procdef.struct.objrealname) then
|
||||
Write(T, ' struct="', SanitiseXMLString(procdef.struct.objrealname^), '"')
|
||||
else
|
||||
Write(T, ' struct="<NULL>"');
|
||||
end;
|
||||
case procdef.proctypeoption of
|
||||
potype_none:
|
||||
{ Do nothing - should this be an internal error though? };
|
||||
potype_procedure,
|
||||
potype_function:
|
||||
if po_classmethod in procdef.procoptions then
|
||||
begin
|
||||
if po_staticmethod in procdef.procoptions then
|
||||
PrintType('static class method')
|
||||
else
|
||||
PrintType('class method');
|
||||
end
|
||||
else if df_generic in procdef.defoptions then
|
||||
Write(T, ' type="generic"');
|
||||
potype_proginit,
|
||||
potype_unitinit:
|
||||
PrintType('initialization');
|
||||
potype_unitfinalize:
|
||||
PrintType('finalization');
|
||||
potype_constructor:
|
||||
PrintType('constructor');
|
||||
potype_destructor:
|
||||
PrintType('destructor');
|
||||
potype_operator:
|
||||
PrintType('operator');
|
||||
potype_class_constructor:
|
||||
PrintType('class constructor');
|
||||
potype_class_destructor:
|
||||
PrintType('class destructor');
|
||||
potype_propgetter:
|
||||
PrintType('dispinterface getter');
|
||||
potype_propsetter:
|
||||
PrintType('dispinterface setter');
|
||||
potype_exceptfilter:
|
||||
PrintType('except filter');
|
||||
potype_mainstub:
|
||||
PrintType('main stub');
|
||||
potype_libmainstub:
|
||||
PrintType('library main stub');
|
||||
potype_pkgstub:
|
||||
PrintType('package stub');
|
||||
end;
|
||||
|
||||
Write(T, ' name="', SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
|
||||
if po_hascallingconvention in procdef.procoptions then
|
||||
Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
|
||||
WriteLn(T, '>');
|
||||
|
||||
PrintNodeIndent;
|
||||
|
||||
if Assigned(procdef.returndef) and not is_void(procdef.returndef) then
|
||||
WriteLn(T, PrintNodeIndention, '<returndef>', SanitiseXMLString(procdef.returndef.typesymbolprettyname), '</returndef>');
|
||||
|
||||
if po_reintroduce in procdef.procoptions then
|
||||
PrintOption('reintroduce');
|
||||
if po_virtualmethod in procdef.procoptions then
|
||||
PrintOption('virtual');
|
||||
if po_finalmethod in procdef.procoptions then
|
||||
PrintOption('final');
|
||||
if po_overridingmethod in procdef.procoptions then
|
||||
PrintOption('override');
|
||||
if po_overload in procdef.procoptions then
|
||||
PrintOption('overload');
|
||||
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');
|
||||
end;
|
||||
|
||||
case procdef.proctypeoption of
|
||||
potype_none: { Do nothing };
|
||||
if Assigned(Code) then
|
||||
begin
|
||||
if FirstHalf then
|
||||
WriteLn(T, PrintNodeIndention, '<code>')
|
||||
else
|
||||
begin
|
||||
WriteLn(T); { Line for spacing }
|
||||
WriteLn(T, PrintNodeIndention, '<firstpass>');
|
||||
end;
|
||||
|
||||
potype_procedure,
|
||||
potype_function:
|
||||
if po_classmethod in procdef.procoptions then
|
||||
begin
|
||||
if po_staticmethod in procdef.procoptions then
|
||||
PrintType('static class method')
|
||||
else
|
||||
PrintType('class method');
|
||||
end;
|
||||
{ Do nothing otherwise }
|
||||
PrintNodeIndent;
|
||||
XMLPrintNode(T, Code);
|
||||
PrintNodeUnindent;
|
||||
|
||||
potype_proginit,
|
||||
potype_unitinit:
|
||||
PrintType('initialization');
|
||||
potype_unitfinalize:
|
||||
PrintType('finalization');
|
||||
potype_constructor:
|
||||
PrintType('constructor');
|
||||
potype_destructor:
|
||||
PrintType('destructor');
|
||||
potype_operator:
|
||||
PrintType('operator');
|
||||
potype_class_constructor:
|
||||
PrintType('class constructor');
|
||||
potype_class_destructor:
|
||||
PrintType('class destructor');
|
||||
potype_propgetter:
|
||||
PrintType('dispinterface getter');
|
||||
potype_propsetter:
|
||||
PrintType('dispinterface setter');
|
||||
potype_exceptfilter:
|
||||
PrintType('except filter');
|
||||
potype_mainstub:
|
||||
PrintType('main stub');
|
||||
potype_libmainstub:
|
||||
PrintType('library main stub');
|
||||
potype_pkgstub:
|
||||
PrintType('package stub');
|
||||
end;
|
||||
if FirstHalf then
|
||||
WriteLn(T, PrintNodeIndention, '</code>')
|
||||
else
|
||||
WriteLn(T, PrintNodeIndention, '</firstpass>');
|
||||
end
|
||||
else { Code=Nil }
|
||||
begin
|
||||
{ Don't print anything for second half - if there's no code, there's no firstpass }
|
||||
if FirstHalf then
|
||||
WriteLn(T, PrintNodeIndention, '<code />');
|
||||
end;
|
||||
|
||||
Write(T, ' name="', SanitiseXMLString(procdef.customprocname([pno_showhidden, pno_noclassmarker])), '"');
|
||||
|
||||
if po_hascallingconvention in procdef.procoptions then
|
||||
Write(T, ' convention="', proccalloptionStr[procdef.proccalloption], '"');
|
||||
|
||||
WriteLn(T, '>');
|
||||
|
||||
PrintNodeIndent;
|
||||
|
||||
if Assigned(procdef.returndef) and not is_void(procdef.returndef) then
|
||||
WriteLn(T, PrintNodeIndention, '<returndef>', SanitiseXMLString(procdef.returndef.typesymbolprettyname), '</returndef>');
|
||||
|
||||
if po_reintroduce in procdef.procoptions then
|
||||
PrintOption('reintroduce');
|
||||
if po_virtualmethod in procdef.procoptions then
|
||||
PrintOption('virtual');
|
||||
if po_finalmethod in procdef.procoptions then
|
||||
PrintOption('final');
|
||||
if po_overridingmethod in procdef.procoptions then
|
||||
PrintOption('override');
|
||||
if po_overload in procdef.procoptions then
|
||||
PrintOption('overload');
|
||||
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');
|
||||
|
||||
if Assigned(Code) then
|
||||
{ Print footer only for second half }
|
||||
if (not FirstHalf) or separate then
|
||||
begin
|
||||
WriteLn(T, PrintNodeIndention, '<code>');
|
||||
PrintNodeIndent;
|
||||
XMLPrintNode(T, Code);
|
||||
PrintNodeUnindent;
|
||||
WriteLn(T, PrintNodeIndention, '</code>');
|
||||
end
|
||||
else
|
||||
WriteLn(T, PrintNodeIndention, '<code />');
|
||||
WriteLn(T, PrintNodeIndention, '</subroutine>');
|
||||
WriteLn(T); { Line for spacing }
|
||||
end;
|
||||
|
||||
PrintNodeUnindent;
|
||||
WriteLn(T, PrintNodeIndention, '</subroutine>');
|
||||
WriteLn(T); { Line for spacing }
|
||||
Close(T);
|
||||
end;
|
||||
{$endif DEBUG_NODE_XML}
|
||||
@ -1789,7 +1816,14 @@ implementation
|
||||
don't need to generate anything. When it was an empty
|
||||
procedure there would be at least a blocknode }
|
||||
if not assigned(code) then
|
||||
exit;
|
||||
begin
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
{ Print out nodes as they appear after the first pass }
|
||||
XMLPrintProc(True);
|
||||
XMLPrintProc(False);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ We need valid code }
|
||||
if Errorcount<>0 then
|
||||
@ -1883,6 +1917,10 @@ implementation
|
||||
(procdef.proccalloption=pocall_safecall) then
|
||||
include(flags, pi_needs_implicit_finally);
|
||||
{$endif}
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
{ Print out nodes as they appear after the first pass }
|
||||
XMLPrintProc(True);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
{ firstpass everything }
|
||||
flowcontrol:=[];
|
||||
do_firstpass(code);
|
||||
@ -1912,7 +1950,14 @@ implementation
|
||||
do_optloadmodifystore(code);
|
||||
|
||||
{ only do secondpass if there are no errors }
|
||||
if (ErrorCount=0) then
|
||||
if (ErrorCount<>0) then
|
||||
begin
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
{ Print out nodes as they appear after the first pass }
|
||||
XMLPrintProc(False);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
end
|
||||
else
|
||||
begin
|
||||
create_hlcodegen;
|
||||
|
||||
@ -1962,6 +2007,11 @@ implementation
|
||||
if paraprintnodetree <> 0 then
|
||||
printproc( 'right before code generation');
|
||||
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
{ Print out nodes as they appear after the first pass }
|
||||
XMLPrintProc(False);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
|
||||
{ generate code for the node tree }
|
||||
do_secondpass(code);
|
||||
aktproccode.concatlist(current_asmdata.CurrAsmList);
|
||||
@ -2470,7 +2520,10 @@ implementation
|
||||
printproc( 'after parsing');
|
||||
|
||||
{$ifdef DEBUG_NODE_XML}
|
||||
XMLPrintProc;
|
||||
{ Methods of generic classes don't get any code generated, so output
|
||||
the node tree here }
|
||||
if (df_generic in procdef.defoptions) then
|
||||
XMLPrintProc(True);
|
||||
{$endif DEBUG_NODE_XML}
|
||||
|
||||
{ ... remove symbol tables }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user