paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 05:06:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed crash with -vp

Browse Source
This commit is contained in:
peter 2004-12-15 17:01:28 +00:00
parent 9dec5c3179
commit 9e49f8eef9
1 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
compiler/psub.pas
View File

@ -49,6 +49,7 @@ interface
nestedprocs : tlinkedlist; nestedprocs : tlinkedlist;
constructor create(aparent:tprocinfo);override; constructor create(aparent:tprocinfo);override;
destructor destroy;override; destructor destroy;override;
procedure printproc;
procedure generate_code; procedure generate_code;
procedure resetprocdef; procedure resetprocdef;
procedure add_to_symtablestack; procedure add_to_symtablestack;
@ -250,28 +251,6 @@ implementation
end; end;
procedure printnode_procdef(pd:tprocdef);
begin
assign(printnodefile,treelogfilename);
{$I-}
append(printnodefile);
if ioresult<>0 then
rewrite(printnodefile);
{$I+}
if ioresult<>0 then
begin
Comment(V_Error,'Error creating '+treelogfilename);
exit;
end;
writeln(printnodefile);
writeln(printnodefile,'*******************************************************************************');
writeln(printnodefile,current_procinfo.procdef.fullprocname(false));
writeln(printnodefile,'*******************************************************************************');
printnode(printnodefile,pd.inlininginfo^.code);
close(printnodefile);
end;
function generate_bodyentry_block:tnode; function generate_bodyentry_block:tnode;
var var
srsym : tsym; srsym : tsym;
@ -518,6 +497,28 @@ implementation
end; end;
procedure tcgprocinfo.printproc;
begin
assign(printnodefile,treelogfilename);
{$I-}
append(printnodefile);
if ioresult<>0 then
rewrite(printnodefile);
{$I+}
if ioresult<>0 then
begin
Comment(V_Error,'Error creating '+treelogfilename);
exit;
end;
writeln(printnodefile);
writeln(printnodefile,'*******************************************************************************');
writeln(printnodefile,procdef.fullprocname(false));
writeln(printnodefile,'*******************************************************************************');
printnode(printnodefile,code);
close(printnodefile);
end;
procedure tcgprocinfo.add_entry_exit_code; procedure tcgprocinfo.add_entry_exit_code;
var var
finalcode, finalcode,
@ -1052,7 +1053,7 @@ implementation
{ Print the node to tree.log } { Print the node to tree.log }
if paraprintnodetree=1 then if paraprintnodetree=1 then
printnode_procdef(procdef); printproc;
{ ... remove symbol tables } { ... remove symbol tables }
remove_from_symtablestack; remove_from_symtablestack;
@ -1445,7 +1446,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.223 2004-12-15 16:00:16 peter Revision 1.224 2004-12-15 17:01:28 peter
* fixed crash with -vp
Revision 1.223 2004/12/15 16:00:16 peter
* external is again allowed in implementation * external is again allowed in implementation
Revision 1.222 2004/12/05 12:28:11 peter Revision 1.222 2004/12/05 12:28:11 peter