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

* Do not use the LOC_VOID location to indicate unused parameters.

Browse Source 
* Added the tprocdef.parentfpsym property. Set parentfpsym.varstate to vs_read instead of using the pio_needs_parentfp flag.
* Replaced tcgcallparanode.push_zero_sized_value_para by tparamanager.has_strict_proc_signature.

git-svn-id: trunk@45454 -
This commit is contained in:
yury 2020-05-21 09:36:40 +00:00
parent a409f63a55
commit 627fcb4354
17 changed files with 118 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/jvm/cpupara.pas
View File

@ -51,6 +51,7 @@ interface
function param_use_paraloc(const cgpara: tcgpara): boolean; override;
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
function has_strict_proc_signature: boolean;override;
private
procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
var parasize:longint);
@ -209,6 +210,12 @@ implementation
end;
function tcpuparamanager.has_strict_proc_signature: boolean;
begin
result:=true;
end;
function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
var
parasize : longint;

9
compiler/jvm/njvmcal.pas
View File

@ -33,8 +33,6 @@ interface
type
tjvmcallparanode = class(tcgcallparanode)
protected
function push_zero_sized_value_para: boolean; override;
procedure push_formal_para; override;
procedure push_copyout_para; override;
@ -74,13 +72,6 @@ implementation
TJVMCALLPARANODE
*****************************************************************************}
function tjvmcallparanode.push_zero_sized_value_para: boolean;
begin
{ part of the signature -> need to be pushed }
result:=true;
end;
procedure tjvmcallparanode.push_formal_para;
begin
{ primitive values are boxed, so in all cases this is a pointer to

7
compiler/llvm/llvmpara.pas
View File

@ -51,6 +51,7 @@ unit llvmpara;
function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara; override;
function has_strict_proc_signature: boolean; override;
private
procedure create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
procedure set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
@ -261,6 +262,12 @@ unit llvmpara;
end;
function tllvmparamanager.has_strict_proc_signature: boolean;
begin
result:=true;
end;
procedure tllvmparamanager.create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
begin
{ on the calleeside, llvm declares the parameters similar to Pascal or C

13
compiler/llvm/nllvmcal.pas
View File

@ -32,8 +32,6 @@ interface
type
tllvmcallparanode = class(tcgcallparanode)
protected
function push_zero_sized_value_para: boolean; override;
end;
tllvmcallnode = class(tcgcallnode)
@ -50,17 +48,6 @@ implementation
verbose,
symconst,symdef;
{*****************************************************************************
TLLVMCALLPARANODE
*****************************************************************************}
function tllvmcallparanode.push_zero_sized_value_para: boolean;
begin
{ part of the signature -> need to be pushed }
result:=true;
end;
{*****************************************************************************
TLLVMCALLNODE
*****************************************************************************}

3
compiler/ncal.pas
View File

@ -3522,9 +3522,6 @@ implementation
hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
else
internalerror(200309287);
{ Always use parentfp for forward-declared nested procedures }
if (procdefinition.typ=procdef) and not tprocdef(procdefinition).is_implemented then
include(tprocdef(procdefinition).implprocoptions,pio_needs_parentfp);
end
else if not(po_is_block in procdefinition.procoptions) then
hiddentree:=gen_procvar_context_tree_parentfp

87
compiler/ncgcal.pas
View File

@ -35,8 +35,6 @@ interface
type
tcgcallparanode = class(tcallparanode)
protected
function push_zero_sized_value_para: boolean; virtual;
procedure push_addr_para;
procedure push_value_para;virtual;
procedure push_formal_para;virtual;
@ -140,6 +138,42 @@ implementation
wpobase;
function can_opt_unused_para(parasym: tparavarsym): boolean;
var
pd: tprocdef;
begin
{ The parameter can be optimized as unused when:
this is a direct call to a routine, not a procvar
and the routine is not an exception filter
and the parameter is not used by the routine
and implementation of the routine is already processed.
}
result:=assigned(parasym.Owner) and
(parasym.Owner.defowner.typ=procdef);
if not result then
exit;
pd:=tprocdef(parasym.Owner.defowner);
result:=(pd.proctypeoption<>potype_exceptfilter) and
not parasym.is_used and
pd.is_implemented;
end;
function can_skip_para_push(parasym: tparavarsym): boolean;
begin
{ We can skip passing the parameter when:
the parameter can be optimized as unused
and the target does not strictly require all parameters (has_strict_proc_signature = false)
and fixed stack is used
or the parameter is in a register
or the parameter is $parentfp. }
result:=can_opt_unused_para(parasym) and
not paramanager.has_strict_proc_signature and
(paramanager.use_fixed_stack or
(vo_is_parentfp in parasym.varoptions) or
(parasym.paraloc[callerside].Location^.Loc in [LOC_REGISTER,LOC_CREGISTER]));
end;
{*****************************************************************************
TCGCALLPARANODE
*****************************************************************************}
@ -158,13 +192,6 @@ implementation
end;
function tcgcallparanode.push_zero_sized_value_para: boolean;
begin
{ nothing to push by default }
result:=false;
end;
procedure tcgcallparanode.push_addr_para;
var
valuedef: tdef;
@ -263,7 +290,7 @@ implementation
-- except on platforms where the parameters are part of the signature
and checked by the runtime/backend compiler (e.g. JVM, LLVM) }
if (left.resultdef.size=0) and
not push_zero_sized_value_para then
not paramanager.has_strict_proc_signature then
exit;
if maybe_push_unused_para then
@ -292,29 +319,12 @@ implementation
function tcgcallparanode.maybe_push_unused_para: boolean;
begin
{ Check if the parameter is unused.
Only the $parentfp parameter is supported for now. }
result:=(vo_is_parentfp in parasym.varoptions) and (parasym.varstate<=vs_initialised);
{ Check if the parameter is unused and can be optimized }
result:=can_opt_unused_para(parasym);
if not result then
exit;
{ The parameter is unused.
We can skip loading of the parameter when:
- the target does not strictly require all parameters (push_zero_sized_value_para = false)
and
- fixed stack is used
or the parameter is in a register
or the parameter is $parentfp. }
if not push_zero_sized_value_para and
(paramanager.use_fixed_stack or
(vo_is_parentfp in parasym.varoptions) or
(parasym.paraloc[callerside].Location^.Loc in [LOC_REGISTER,LOC_CREGISTER])) then
begin
{ Skip loading }
parasym.paraloc[callerside].Location^.Loc:=LOC_VOID;
tempcgpara.Location^.Loc:=LOC_VOID;
end
else
{ Load an undefined dummy value }
{ If we can't skip loading of the parameter, load an undefined dummy value. }
if not can_skip_para_push(parasym) then
hlcg.a_load_undefined_cgpara(current_asmdata.CurrAsmList,left.resultdef,tempcgpara);
end;
@ -775,7 +785,8 @@ implementation
ppn:=tcgcallparanode(left);
while assigned(ppn) do
begin
if (ppn.left.nodetype<>nothingn) then
if (ppn.left.nodetype<>nothingn) and
not can_skip_para_push(ppn.parasym) then
begin
{ better check for the real location of the parameter here, when stack passed parameters
are saved temporary in registers, checking for the tmpparaloc.loc is wrong
@ -948,17 +959,9 @@ implementation
function tcgcallnode.is_parentfp_pushed: boolean;
var
i : longint;
begin
for i:=0 to procdefinition.paras.Count-1 do
with tparavarsym(procdefinition.paras[i]) do
if vo_is_parentfp in varoptions then
begin
result:=paraloc[callerside].Location^.Loc in [LOC_REFERENCE,LOC_CREFERENCE];
exit;
end;
result:=false;
result:=(procdefinition.typ<>procdef) or
not can_skip_para_push(tparavarsym(tprocdef(procdefinition).parentfpsym));
end;

7
compiler/ncgmem.pas
View File

@ -170,7 +170,7 @@ implementation
location_reset(location,LOC_REGISTER,def_cgsize(parentfpvoidpointertype));
currpi:=current_procinfo;
{ load framepointer of current proc }
hsym:=parentfpsym;
hsym:=tparavarsym(currpi.procdef.parentfpsym);
if (currpi.procdef.owner.symtablelevel=parentpd.parast.symtablelevel) and (hsym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
location.register:=hsym.localloc.register
else
@ -183,10 +183,7 @@ implementation
currpi:=currpi.parent;
if not assigned(currpi) then
internalerror(200311201);
hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
if not assigned(hsym) then
internalerror(200309282);
hsym:=tparavarsym(currpi.procdef.parentfpsym);
if hsym.localloc.loc<>LOC_REFERENCE then
internalerror(200309283);

4
compiler/ncgnstmm.pas
View File

@ -83,7 +83,7 @@ implementation
while assigned(currpi) and
(currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
begin
hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
hsym:=tparavarsym(currpi.procdef.parentfpsym);
maybe_add_sym_to_parentfpstruct(currpi.procdef,hsym,nextpi.procdef.parentfpstructptrtype,false);
currpi:=nextpi;
nextpi:=nextpi.parent;
@ -125,7 +125,7 @@ implementation
need }
while (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
begin
hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
hsym:=tparavarsym(currpi.procdef.parentfpsym);
fsym:=tfieldvarsym(find_sym_in_parentfpstruct(currpi.procdef,hsym));
if not assigned(fsym) then
internalerror(2011060405);

7
compiler/ncgutil.pas
View File

@ -866,10 +866,9 @@ implementation
location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
vs.initialloc.register:=NR_FRAME_POINTER_REG;
end
{ Unused parameters ($parentfp for now) need to be kept in the original location
{ Unused parameters need to be kept in the original location
to prevent allocation of registers/resources for them. }
else if (vs.varstate <= vs_initialised) and
(vo_is_parentfp in vs.varoptions) then
else if not tparavarsym(vs).is_used then
begin
tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc);
end
@ -1065,7 +1064,7 @@ implementation
add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
loadparentfpn:
if current_procinfo.procdef.parast.symtablelevel>tloadparentfpnode(n).parentpd.parast.symtablelevel then
add_regvars(rv^,tloadparentfpnode(n).parentfpsym.localloc);
add_regvars(rv^,tparavarsym(current_procinfo.procdef.parentfpsym).localloc);
vecn:
begin
{ range checks sometimes need the high parameter }

17
compiler/nmem.pas
View File

@ -53,10 +53,6 @@ interface
lpf_forload
);
tloadparentfpnode = class(tunarynode)
private
_parentfpsym: tparavarsym;
function getparentfpsym: tparavarsym;
public
parentpd : tprocdef;
parentpdderef : tderef;
kind: tloadparentfpkind;
@ -69,7 +65,6 @@ interface
function pass_typecheck:tnode;override;
function docompare(p: tnode): boolean; override;
function dogetcopy : tnode;override;
property parentfpsym: tparavarsym read getparentfpsym;
end;
tloadparentfpnodeclass = class of tloadparentfpnode;
@ -389,18 +384,6 @@ implementation
expectloc:=LOC_REGISTER;
end;
function tloadparentfpnode.getparentfpsym: tparavarsym;
begin
if not assigned(_parentfpsym) then
begin
_parentfpsym:=tparavarsym(current_procinfo.procdef.parast.Find('parentfp'));
if not assigned(_parentfpsym) then
internalerror(200309281);
end;
result:=_parentfpsym;
end;
{*****************************************************************************
TADDRNODE
*****************************************************************************}

10
compiler/paramgr.pas
View File

@ -161,6 +161,10 @@ unit paramgr;
function use_fixed_stack: boolean;
{ whether stack pointer can be changed in the middle of procedure }
function use_stackalloc: boolean;
{ Returns true for platforms where the parameters are part of the signature
and checked by the runtime/backend compiler (e.g. JVM, LLVM).
The default implementation returns false. }
function has_strict_proc_signature: boolean; virtual;
strict protected
{ common part of get_funcretloc; returns true if retloc is completely
initialized afterwards }
@ -651,6 +655,12 @@ implementation
end;
function tparamanager.has_strict_proc_signature: boolean;
begin
result:=false;
end;
function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
var
paraloc : pcgparalocation;

2
compiler/pparautl.pas
View File

@ -164,8 +164,6 @@ implementation
vs:=cparavarsym.create('$parentfp',paranr,vs_value,
tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
end;
{ Mark $parentfp as used by default }
vs.varstate:=vs_read;
pd.parast.insert(vs);
current_tokenpos:=storepos;

21
compiler/procinfo.pas
View File

@ -202,8 +202,8 @@ unit procinfo;
procedure start_eh(list : TAsmList); virtual;
{ called to insert needed eh info into the exit code }
procedure end_eh(list : TAsmList); virtual;
{ Sets the pio_needs_parentfp flag for the current nested procedure.
Sets both pio_needs_parentfp and pio_nested_access for all parent
{ Mark the parentfp as used for the current nested procedure.
Mark the parentfp as used and set pio_nested_access for all parent
procedures until parent_level }
procedure set_needs_parentfp(parent_level: byte);
end;
@ -437,20 +437,29 @@ implementation
procedure tprocinfo.set_needs_parentfp(parent_level: byte);
var
pi : tprocinfo;
p : tparavarsym;
begin
if (procdef.parast.symtablelevel<=normal_function_level)
or (procdef.parast.symtablelevel<=parent_level) then
Internalerror(2020050302);
if parent_level<normal_function_level then
parent_level:=normal_function_level;
{ Set pio_needs_parentfp for the current proc }
{ Mark parentfp as used for the current proc }
pi:=Self;
include(pi.procdef.implprocoptions, pio_needs_parentfp);
{ Set both pio_needs_parentfp and pio_nested_access for all parent procs until parent_level }
tparavarsym(pi.procdef.parentfpsym).varstate:=vs_read;
{ Set both parentfp is used and pio_nested_access for all parent procs until parent_level }
while pi.procdef.parast.symtablelevel>parent_level do
begin
pi:=pi.parent;
pi.procdef.implprocoptions:=pi.procdef.implprocoptions+[pio_needs_parentfp,pio_nested_access];
if pi.procdef.parast.symtablelevel>normal_function_level then
begin
p:=tparavarsym(pi.procdef.parentfpsym);
p.varstate:=vs_read;
{ parentfp is accessed from a nested routine.
Must be in the memory. }
p.varregable:=vr_none;
end;
include(pi.procdef.implprocoptions,pio_nested_access);
end;
end;

4
compiler/symconst.pas
View File

@ -455,9 +455,7 @@ type
{ compiled with fastmath enabled }
pio_fastmath,
{ inline is forbidden (calls get_frame) }
pio_inline_forbidden,
{ a nested routine uses the frame pointer of the parent routine }
pio_needs_parentfp
pio_inline_forbidden
);
timplprocoptions = set of timplprocoption;

66
compiler/symdef.pas
View File

@ -702,8 +702,6 @@ interface
private
procedure count_para(p:TObject;arg:pointer);
procedure insert_para(p:TObject;arg:pointer);
protected
procedure handle_unused_paras(side: tcallercallee); virtual;
end;
tprocvardef = class(tabstractprocdef)
@ -782,6 +780,7 @@ interface
{$else symansistr}
_mangledname : pshortstring;
{$endif}
_parentfpsym : tsym;
{ information that is only required until the implementation of the
procdef has been handled }
implprocdefinfo : pimplprocdefinfo;
@ -814,7 +813,7 @@ interface
procedure SetIsEmpty(AValue: boolean);
function GetHasInliningInfo: boolean;
procedure SetHasInliningInfo(AValue: boolean);
procedure handle_unused_paras(side: tcallercallee); override;
function getparentfpsym: tsym;
public
messageinf : tmessageinf;
dispid : longint;
@ -937,6 +936,8 @@ interface
property isempty: boolean read GetIsEmpty write SetIsEmpty;
{ true if all information required to inline this routine is available }
property has_inlininginfo: boolean read GetHasInliningInfo write SetHasInliningInfo;
{ returns the $parentfp parameter for nested routines }
property parentfpsym: tsym read getparentfpsym;
end;
tprocdefclass = class of tprocdef;
@ -5276,11 +5277,6 @@ implementation
end;
procedure tabstractprocdef.handle_unused_paras(side: tcallercallee);
begin
end;
procedure tabstractprocdef.calcparas;
var
paracount : longint;
@ -5714,7 +5710,6 @@ implementation
has_paraloc_info:=callbothsides
else
has_paraloc_info:=callerside;
handle_unused_paras(callerside);
end;
if (side in [calleeside,callbothsides]) and
not(has_paraloc_info in [calleeside,callbothsides]) then
@ -5727,7 +5722,6 @@ implementation
has_paraloc_info:=callbothsides
else
has_paraloc_info:=calleeside;
handle_unused_paras(calleeside);
end;
end;
@ -5774,6 +5768,8 @@ implementation
if tsym(parast.SymList[i]).typ=paravarsym then
begin
p:=tparavarsym(parast.SymList[i]);
if not p.is_used then
continue;
{ check if no parameter is located on the stack }
if (is_open_array(p.vardef) or
is_array_of_const(p.vardef)) and (p.varspez=vs_value) then
@ -5840,6 +5836,17 @@ implementation
TPROCDEF
***************************************************************************}
function tprocdef.getparentfpsym: tsym;
begin
if not assigned(_parentfpsym) then
begin
_parentfpsym:=tsym(parast.Find('parentfp'));
if not assigned(_parentfpsym) then
internalerror(200309281);
end;
result:=_parentfpsym;
end;
function tprocdef.store_localst: boolean;
begin
@ -6021,45 +6028,6 @@ implementation
end;
procedure tprocdef.handle_unused_paras(side: tcallercallee);
var
i : longint;
begin
{ Optimize unused parameters by preventing loading them on the callee side
and, if possible, preventing passing them on the caller side.
The caller side optimization is handled by tcgcallparanode.maybe_push_unused_para().
}
if (proctypeoption = potype_exceptfilter) or
(po_assembler in procoptions) then
exit;
{ Only $parentfp is optmized for now. }
if not is_nested_pd(self) then
exit;
{ Handle unused parameters }
for i:=0 to paras.Count-1 do
with tparavarsym(paras[i]) do
if vo_is_parentfp in varoptions then
begin
if pio_needs_parentfp in implprocoptions then
begin
{ If this routine is accessed from other nested routine,
$parentfp must be in a memory location. }
if pio_nested_access in implprocoptions then
varregable:=vr_none;
end
else
begin
{ Mark $parentfp as unused, since it has vs_read by default }
varstate:=vs_initialised;
if side=calleeside then
{ Set LOC_VOID as the parameter's location on the callee side }
paraloc[side].location^.Loc:=LOC_VOID;
break;
end;
end;
end;
procedure tprocdef.Setinterfacedef(AValue: boolean);
begin
if not assigned(implprocdefinfo) then

8
compiler/symsym.pas
View File

@ -283,6 +283,7 @@ interface
override ppuwrite_platform instead }
procedure ppuwrite(ppufile:tcompilerppufile);override;final;
function needs_finalization: boolean;
function is_used: boolean;
end;
tparavarsymclass = class of tparavarsym;
@ -2298,6 +2299,13 @@ implementation
);
end;
function tparavarsym.is_used: boolean;
begin
{ Only the $parentfp parameter is supported for now }
result:=not (vo_is_parentfp in varoptions) or (varstate>vs_initialised);
end;
{****************************************************************************
TABSOLUTEVARSYM
****************************************************************************}

3
compiler/utils/ppuutils/ppudump.pp
View File

@ -3232,8 +3232,7 @@ const
(mask:pio_nested_access; str:'NestedAccess'),
(mask:pio_thunk; str:'Thunk'),
(mask:pio_fastmath; str:'FastMath'),
(mask:pio_inline_forbidden; str:'InlineForbidden'),
(mask:pio_needs_parentfp; str:'NeedsParentFP')
(mask:pio_inline_forbidden; str:'InlineForbidden')
);
var
i: timplprocoption;