paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 22:49:37 +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;
constructor create(aparent:tprocinfo);override;
destructor destroy;override;
procedure printproc;
procedure generate_code;
procedure resetprocdef;
procedure add_to_symtablestack;
@ -250,28 +251,6 @@ implementation
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;
var
srsym : tsym;
@ -518,6 +497,28 @@ implementation
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;
var
finalcode,
@ -1052,7 +1053,7 @@ implementation
{ Print the node to tree.log }
if paraprintnodetree=1 then
printnode_procdef(procdef);
printproc;
{ ... remove symbol tables }
remove_from_symtablestack;
@ -1445,7 +1446,10 @@ implementation
end.
{
$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
Revision 1.222 2004/12/05 12:28:11 peter