paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 01:48:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ inlined procedures inherit procinfo flags

Browse Source
This commit is contained in:
florian 2003-12-16 21:29:24 +00:00
parent 8fc8644de0
commit 2258e941af
7 changed files with 112 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/ncal.pas
View File

@ -2465,8 +2465,8 @@ type
CGMessage(cg_e_unable_inline_procvar);
if not assigned(inlinecode) then
begin
if assigned(tprocdef(procdefinition).code) then
inlinecode:=tprocdef(procdefinition).code.getcopy
if assigned(tprocdef(procdefinition).inlininginfo^.code) then
inlinecode:=tprocdef(procdefinition).inlininginfo^.code.getcopy
else
CGMessage(cg_e_no_code_for_inline_stored);
if assigned(inlinecode) then
@ -2612,7 +2612,10 @@ type
end;
errorexit:
if assigned(inlinecode) then
procdefinition.proccalloption:=pocall_inline;
begin
procdefinition.proccalloption:=pocall_inline;
current_procinfo.flags:=current_procinfo.flags+((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
end;
end;
{$ifdef state_tracking}
@ -2698,7 +2701,10 @@ begin
end.
{
$Log$
Revision 1.212 2003-12-08 22:37:28 peter
Revision 1.213 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.212 2003/12/08 22:37:28 peter
* paralength is private again
Revision 1.211 2003/12/08 16:34:23 peter

7
compiler/nopt.pas
View File

@ -86,7 +86,7 @@ var
implementation
uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,ncal,
verbose, symdef, cgbase, procinfo;
verbose, symconst,symdef, cgbase, procinfo;
{*****************************************************************************
@ -290,7 +290,10 @@ end.
{
$Log$
Revision 1.17 2003-10-01 20:34:49 peter
Revision 1.18 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.17 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose

21
compiler/procinfo.pas
View File

@ -38,21 +38,9 @@ unit procinfo;
aasmbase,aasmtai
;
const
inherited_inlining_flags : tprocinfoflags = [pi_do_call];
type
tprocinfoflag=(
{# procedure uses asm }
pi_uses_asm,
{# procedure does a call }
pi_do_call,
{# procedure has a try statement = no register optimization }
pi_uses_exceptions,
{# procedure is declared as @var(assembler), don't optimize}
pi_is_assembler,
{# procedure contains data which needs to be finalized }
pi_needs_implicit_finally
);
tprocinfoflags=set of tprocinfoflag;
type
{# This object gives information on the current routine being
@ -211,7 +199,10 @@ implementation
end.
{
$Log$
Revision 1.9 2003-12-03 23:13:20 peter
Revision 1.10 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.9 2003/12/03 23:13:20 peter
* delayed paraloc allocation, a_param_*() gets extra parameter
if it needs to allocate temp or real paralocation
* optimized/simplified int-real loading

14
compiler/psub.pas
View File

@ -249,7 +249,7 @@ implementation
writeln(printnodefile,'*******************************************************************************');
writeln(printnodefile,current_procinfo.procdef.fullprocname(false));
writeln(printnodefile,'*******************************************************************************');
printnode(printnodefile,pd.code);
printnode(printnodefile,pd.inlininginfo^.code);
close(printnodefile);
end;
@ -895,7 +895,7 @@ implementation
code.free;
code:=nil;
if (procdef.proccalloption<>pocall_inline) then
procdef.code:=nil;
procdef.inlininginfo^.code:=nil;
end;
end;
@ -985,13 +985,14 @@ implementation
printnode_procdef(procdef);
end;
new(procdef.inlininginfo);
{ store a copy of the original tree for inline, for
normal procedures only store a reference to the
current tree }
if (procdef.proccalloption=pocall_inline) then
procdef.code:=code.getcopy
procdef.inlininginfo^.code:=code.getcopy
else
procdef.code:=code;
procdef.inlininginfo^.code:=code;
{ ... remove symbol tables }
remove_from_symtablestack;
@ -1330,7 +1331,10 @@ implementation
end.
{
$Log$
Revision 1.177 2003-12-15 21:25:48 peter
Revision 1.178 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.177 2003/12/15 21:25:48 peter
* reg allocations for imaginary register are now inserted just
before reg allocation
* tregister changed to enum to allow compile time check

19
compiler/symconst.pas
View File

@ -319,6 +319,20 @@ type
te_exact
);
tprocinfoflag=(
{# procedure uses asm }
pi_uses_asm,
{# procedure does a call }
pi_do_call,
{# procedure has a try statement = no register optimization }
pi_uses_exceptions,
{# procedure is declared as @var(assembler), don't optimize}
pi_is_assembler,
{# procedure contains data which needs to be finalized }
pi_needs_implicit_finally
);
tprocinfoflags=set of tprocinfoflag;
{$ifdef GDB}
type
tdefstabstatus = (
@ -379,7 +393,10 @@ initialization
end.
{
$Log$
Revision 1.71 2003-11-23 17:05:16 peter
Revision 1.72 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.71 2003/11/23 17:05:16 peter
* register calling is left-right
* parameter ordering
* left-right calling inserts result parameter last

54
compiler/symdef.pas
View File

@ -494,6 +494,13 @@ interface
1 : (i : longint);
end;
tinlininginfo = record
{ node tree }
code : tnode;
flags : tprocinfoflags;
end;
pinlininginfo = ^tinlininginfo;
tprocdef = class(tabstractprocdef)
private
_mangledname : pstring;
@ -528,13 +535,11 @@ interface
refcount : longint;
_class : tobjectdef;
_classderef : tderef;
{ it's a tree, but this not easy to handle }
{ used for inlined procs }
code : tnode;
{ name of the result variable to insert in the localsymtable }
resultname : stringid;
{ true, if the procedure is only declared }
{ (forward procedure) }
{ true, if the procedure is only declared
(forward procedure) }
forwarddef,
{ true if the procedure is declared in the interface }
interfacedef : boolean;
@ -542,6 +547,9 @@ interface
hasforward : boolean;
{ check the problems of manglednames }
has_mangledname : boolean;
{ info for inlining the subroutine, if this pointer is nil,
the procedure can't be inlined }
inlininginfo : pinlininginfo;
constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -3597,7 +3605,11 @@ implementation
interfacedef:=false;
hasforward:=false;
_class := nil;
code:=nil;
{ only for non inlined procedures loaded from a unit
we don't need this info
}
new(inlininginfo);
fillchar(inlininginfo^,sizeof(tinlininginfo),0);
overloadnumber:=0;
{$ifdef GDB}
isstabwritten := false;
@ -3647,9 +3659,13 @@ implementation
{ inline stuff }
if proccalloption=pocall_inline then
code:=ppuloadnodetree(ppufile)
begin
new(inlininginfo);
inlininginfo^.code:=ppuloadnodetree(ppufile);
ppufile.getsmallset(inlininginfo^.flags);
end
else
code := nil;
inlininginfo := nil;
{ default values for no persistent data }
if (cs_link_deffile in aktglobalswitches) and
@ -3688,16 +3704,18 @@ implementation
memproclocalst.start;
{$endif MEMDEBUG}
end;
if (proccalloption=pocall_inline) and assigned(code) then
if (proccalloption=pocall_inline) and assigned(inlininginfo) then
begin
{$ifdef MEMDEBUG}
memprocnodetree.start;
{$endif MEMDEBUG}
tnode(code).free;
tnode(inlininginfo^.code).free;
{$ifdef MEMDEBUG}
memprocnodetree.start;
{$endif MEMDEBUG}
end;
if assigned(inlininginfo) then
dispose(inlininginfo);
if (po_msgstr in procoptions) then
strdispose(messageinf.str);
if assigned(_mangledname) then
@ -3774,7 +3792,11 @@ implementation
oldintfcrc:=ppufile.do_crc;
ppufile.do_crc:=false;
if proccalloption=pocall_inline then
ppuwritenodetree(ppufile,code);
begin
ppuwritenodetree(ppufile,inlininginfo^.code);
ppufile.putsmallset(inlininginfo^.flags);
end;
ppufile.do_crc:=oldintfcrc;
aktparasymtable:=oldparasymtable;
@ -3792,7 +3814,6 @@ implementation
end;
function tprocdef.fullprocname(showhidden:boolean):string;
var
s : string;
@ -4169,7 +4190,7 @@ implementation
{ inline tree }
if (proccalloption=pocall_inline) then
code.buildderefimpl;
inlininginfo^.code.buildderefimpl;
aktparasymtable:=oldparasymtable;
aktlocalsymtable:=oldlocalsymtable;
@ -4229,7 +4250,7 @@ implementation
{ inline tree }
if (proccalloption=pocall_inline) then
code.derefimpl;
inlininginfo^.code.derefimpl;
aktparasymtable:=oldparasymtable;
aktlocalsymtable:=oldlocalsymtable;
@ -6118,7 +6139,10 @@ implementation
end.
{
$Log$
Revision 1.192 2003-12-12 12:09:40 marco
Revision 1.193 2003-12-16 21:29:24 florian
+ inlined procedures inherit procinfo flags
Revision 1.192 2003/12/12 12:09:40 marco
* always generate RTTI patch from peter
Revision 1.191 2003/12/08 22:34:24 peter

27
compiler/utils/ppudump.pp
View File

@ -43,6 +43,20 @@ const
v_all = $ff;
type
tprocinfoflag=(
{# procedure uses asm }
pi_uses_asm,
{# procedure does a call }
pi_do_call,
{# procedure has a try statement = no register optimization }
pi_uses_exceptions,
{# procedure is declared as @var(assembler), don't optimize}
pi_is_assembler,
{# procedure contains data which needs to be finalized }
pi_needs_implicit_finally
);
tprocinfoflags=set of tprocinfoflag;
{ Copied from systems.pas }
ttargetcpu=
(
@ -1219,6 +1233,8 @@ var
totaldefs,l,j,
defcnt : longint;
calloption : tproccalloption;
procinfooptions : tprocinfoflag;
begin
defcnt:=0;
with ppufile do
@ -1330,7 +1346,11 @@ begin
end;
{ code }
if (calloption=pocall_inline) then
readnodetree;
begin
readnodetree;
ppufile.getsmallset(procinfooptions);
writeln(space,' ProcInfoOptions : ',dword(procinfooptions));
end;
delete(space,1,4);
end;
@ -1929,7 +1949,10 @@ begin
end.
{
$Log$
Revision 1.49 2003-12-08 21:04:08 peter
Revision 1.50 2003-12-16 21:29:25 florian
+ inlined procedures inherit procinfo flags
Revision 1.49 2003/12/08 21:04:08 peter
* line break in uses unit
Revision 1.48 2003/11/10 22:02:52 peter