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

* moved handle_calling_convention() to pparautl

Browse Source 
git-svn-id: trunk@40772 -
This commit is contained in:
Jonas Maebe 2019-01-05 16:26:29 +00:00
parent f20e7bc193
commit 28df55fe08
10 changed files with 145 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/jvm/symcpu.pas
View File

@ -222,7 +222,7 @@ implementation
uses
verbose,cutils,cclasses,globals,
symconst,symbase,symtable,symcreat,jvmdef,
pdecsub,pjvm,
pdecsub,pparautl,pjvm,
paramgr;

2
compiler/nflw.pas
View File

@ -245,7 +245,7 @@ implementation
cutils,verbose,globals,
symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1,
ncal,nadd,ncon,nmem,nld,ncnv,nbas,nutils,ninl,nset,ngenutil,
pdecsub,
pdecsub,pparautl,
{$ifdef state_tracking}
nstate,
{$endif}

2
compiler/pdecl.pas
View File

@ -61,7 +61,7 @@ implementation
ninl,ncon,nobj,ngenutil,
{ parser }
scanner,
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,
pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil,pparautl,
{$ifdef jvm}
pjvm,
{$endif}

2
compiler/pdecobj.pas
View File

@ -49,7 +49,7 @@ implementation
symbase,symsym,symtable,symcreat,defcmp,
node,ncon,
fmodule,scanner,
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,pparautl,ppu
{$ifdef jvm}
,pjvm;
{$else}

135
compiler/pdecsub.pas
View File

@ -55,23 +55,12 @@ interface
);
tpdflags=set of tpdflag;
// flags of handle_calling_convention routine
thccflag=(
hcc_check, // perform checks and outup errors if found
hcc_insert_hidden_paras // insert hidden parameters
);
thccflags=set of thccflag;
const
hcc_all=[hcc_check,hcc_insert_hidden_paras];
function check_proc_directive(isprocvar:boolean):boolean;
function proc_add_definition(var currpd:tprocdef):boolean;
function proc_get_importname(pd:tprocdef):string;
procedure proc_set_mangledname(pd:tprocdef);
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
procedure parse_var_proc_directives(sym:tsym);
@ -223,19 +212,6 @@ implementation
end;
procedure set_addr_param_regable(p:TObject;arg:pointer);
begin
if (tsym(p).typ<>paravarsym) then
exit;
with tparavarsym(p) do
begin
if (not needs_finalization) and
paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
varregable:=vr_addr;
end;
end;
procedure parse_parameter_dec(pd:tabstractprocdef);
{
handle_procvar needs the same changes
@ -3279,117 +3255,6 @@ const
end;
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
begin
if hcc_check in flags then
begin
{ set the default calling convention if none provided }
if (pd.typ=procdef) and
(is_objc_class_or_protocol(tprocdef(pd).struct) or
is_cppclass(tprocdef(pd).struct)) then
begin
{ none of the explicit calling conventions should be allowed }
if (po_hascallingconvention in pd.procoptions) then
internalerror(2009032501);
if is_cppclass(tprocdef(pd).struct) then
pd.proccalloption:=pocall_cppdecl
else
pd.proccalloption:=pocall_cdecl;
end
else if not(po_hascallingconvention in pd.procoptions) then
pd.proccalloption:=current_settings.defproccall
else
begin
if pd.proccalloption=pocall_none then
internalerror(200309081);
end;
{ handle proccall specific settings }
case pd.proccalloption of
pocall_cdecl,
pocall_cppdecl,
pocall_sysv_abi_cdecl,
pocall_ms_abi_cdecl:
begin
{ check C cdecl para types }
check_c_para(pd);
end;
pocall_far16 :
begin
{ Temporary stub, must be rewritten to support OS/2 far16 }
Message1(parser_w_proc_directive_ignored,'FAR16');
end;
end;
{ Inlining is enabled and supported? }
if (po_inline in pd.procoptions) and
not(cs_do_inline in current_settings.localswitches) then
begin
{ Give an error if inline is not supported by the compiler mode,
otherwise only give a hint that this procedure will not be inlined }
if not(m_default_inline in current_settings.modeswitches) then
Message(parser_e_proc_inline_not_supported)
else
Message(parser_h_inlining_disabled);
exclude(pd.procoptions,po_inline);
end;
{ For varargs directive also cdecl and external must be defined }
if (po_varargs in pd.procoptions) then
begin
{ check first for external in the interface, if available there
then the cdecl must also be there since there is no implementation
available to contain it }
if parse_only then
begin
{ if external is available, then cdecl must also be available,
procvars don't need external }
if not((po_external in pd.procoptions) or
(pd.typ=procvardef) or
{ for objcclasses this is checked later, because the entire
class may be external. }
is_objc_class_or_protocol(tprocdef(pd).struct)) and
not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
Message(parser_e_varargs_need_cdecl_and_external);
end
else
begin
{ both must be defined now }
if not((po_external in pd.procoptions) or
(pd.typ=procvardef)) or
not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
Message(parser_e_varargs_need_cdecl_and_external);
end;
end;
end;
if hcc_insert_hidden_paras in flags then
begin
{ insert hidden high parameters }
pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
{ insert hidden self parameter }
insert_self_and_vmt_para(pd);
{ insert funcret parameter if required }
insert_funcret_para(pd);
{ Make var parameters regable, this must be done after the calling
convention is set. }
{ this must be done before parentfp is insert, because getting all cases
where parentfp must be in a memory location isn't catched properly so
we put parentfp never in a register }
pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
{ insert parentfp parameter if required }
insert_parentfp_para(pd);
end;
{ Calculate parameter tlist }
pd.calcparas;
end;
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
{
Parse the procedure directives. It does not matter if procedure directives

2
compiler/pdecvar.pas
View File

@ -68,7 +68,7 @@ implementation
ngenutil,
{ parser }
scanner,
pbase,pexpr,ptype,ptconst,pdecsub;
pbase,pexpr,ptype,ptconst,pdecsub,pparautl;
function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;

2
compiler/pgenutil.pas
View File

@ -73,7 +73,7 @@ uses
node,nobj,
{ parser }
scanner,
pbase,pexpr,pdecsub,ptype,psub;
pbase,pexpr,pdecsub,ptype,psub,pparautl;
procedure maybe_add_waiting_unit(tt:tdef);

2
compiler/pmodules.pas
View File

@ -46,7 +46,7 @@ implementation
objcgutl,
pkgutil,
wpobase,
scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti,
scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,pparautl,ncgvmt,ncgrtti,
cpuinfo;

138
compiler/pparautl.pas
View File

@ -35,12 +35,24 @@ interface
procedure insert_hidden_para(p:TObject;arg:pointer);
procedure check_c_para(pd:Tabstractprocdef);
type
// flags of handle_calling_convention routine
thccflag=(
hcc_check, // perform checks and outup errors if found
hcc_insert_hidden_paras // insert hidden parameters
);
thccflags=set of thccflag;
const
hcc_all=[hcc_check,hcc_insert_hidden_paras];
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
implementation
uses
globals,globtype,verbose,systems,
symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
paramgr;
pbase,paramgr;
procedure insert_funcret_para(pd:tabstractprocdef);
@ -418,4 +430,128 @@ implementation
end;
procedure set_addr_param_regable(p:TObject;arg:pointer);
begin
if (tsym(p).typ<>paravarsym) then
exit;
with tparavarsym(p) do
begin
if (not needs_finalization) and
paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then
varregable:=vr_addr;
end;
end;
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
begin
if hcc_check in flags then
begin
{ set the default calling convention if none provided }
if (pd.typ=procdef) and
(is_objc_class_or_protocol(tprocdef(pd).struct) or
is_cppclass(tprocdef(pd).struct)) then
begin
{ none of the explicit calling conventions should be allowed }
if (po_hascallingconvention in pd.procoptions) then
internalerror(2009032501);
if is_cppclass(tprocdef(pd).struct) then
pd.proccalloption:=pocall_cppdecl
else
pd.proccalloption:=pocall_cdecl;
end
else if not(po_hascallingconvention in pd.procoptions) then
pd.proccalloption:=current_settings.defproccall
else
begin
if pd.proccalloption=pocall_none then
internalerror(200309081);
end;
{ handle proccall specific settings }
case pd.proccalloption of
pocall_cdecl,
pocall_cppdecl,
pocall_sysv_abi_cdecl,
pocall_ms_abi_cdecl:
begin
{ check C cdecl para types }
check_c_para(pd);
end;
pocall_far16 :
begin
{ Temporary stub, must be rewritten to support OS/2 far16 }
Message1(parser_w_proc_directive_ignored,'FAR16');
end;
end;
{ Inlining is enabled and supported? }
if (po_inline in pd.procoptions) and
not(cs_do_inline in current_settings.localswitches) then
begin
{ Give an error if inline is not supported by the compiler mode,
otherwise only give a hint that this procedure will not be inlined }
if not(m_default_inline in current_settings.modeswitches) then
Message(parser_e_proc_inline_not_supported)
else
Message(parser_h_inlining_disabled);
exclude(pd.procoptions,po_inline);
end;
{ For varargs directive also cdecl and external must be defined }
if (po_varargs in pd.procoptions) then
begin
{ check first for external in the interface, if available there
then the cdecl must also be there since there is no implementation
available to contain it }
if parse_only then
begin
{ if external is available, then cdecl must also be available,
procvars don't need external }
if not((po_external in pd.procoptions) or
(pd.typ=procvardef) or
{ for objcclasses this is checked later, because the entire
class may be external. }
is_objc_class_or_protocol(tprocdef(pd).struct)) and
not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
Message(parser_e_varargs_need_cdecl_and_external);
end
else
begin
{ both must be defined now }
if not((po_external in pd.procoptions) or
(pd.typ=procvardef)) or
not(pd.proccalloption in (cdecl_pocalls + [pocall_stdcall])) then
Message(parser_e_varargs_need_cdecl_and_external);
end;
end;
end;
if hcc_insert_hidden_paras in flags then
begin
{ insert hidden high parameters }
pd.parast.SymList.ForEachCall(@insert_hidden_para,pd);
{ insert hidden self parameter }
insert_self_and_vmt_para(pd);
{ insert funcret parameter if required }
insert_funcret_para(pd);
{ Make var parameters regable, this must be done after the calling
convention is set. }
{ this must be done before parentfp is insert, because getting all cases
where parentfp must be in a memory location isn't catched properly so
we put parentfp never in a register }
pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd);
{ insert parentfp parameter if required }
insert_parentfp_para(pd);
end;
{ Calculate parameter tlist }
pd.calcparas;
end;
end.

2
compiler/ptype.pas
View File

@ -82,7 +82,7 @@ implementation
nset,ncnv,ncon,nld,
{ parser }
scanner,
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil,pparautl
{$ifdef jvm}
,pjvm
{$endif}