paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 12:09:30 +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 uses
verbose,cutils,cclasses,globals, verbose,cutils,cclasses,globals,
symconst,symbase,symtable,symcreat,jvmdef, symconst,symbase,symtable,symcreat,jvmdef,
pdecsub,pjvm, pdecsub,pparautl,pjvm,
paramgr; paramgr;

2
compiler/nflw.pas
View File

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

2
compiler/pdecl.pas
View File

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

2
compiler/pdecobj.pas
View File

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

135
compiler/pdecsub.pas
View File

@ -55,23 +55,12 @@ interface
); );
tpdflags=set of tpdflag; 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 check_proc_directive(isprocvar:boolean):boolean;
function proc_add_definition(var currpd:tprocdef):boolean; function proc_add_definition(var currpd:tprocdef):boolean;
function proc_get_importname(pd:tprocdef):string; function proc_get_importname(pd:tprocdef):string;
procedure proc_set_mangledname(pd:tprocdef); procedure proc_set_mangledname(pd:tprocdef);
procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
procedure parse_parameter_dec(pd:tabstractprocdef); procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags); procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
procedure parse_var_proc_directives(sym:tsym); procedure parse_var_proc_directives(sym:tsym);
@ -223,19 +212,6 @@ implementation
end; 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); procedure parse_parameter_dec(pd:tabstractprocdef);
{ {
handle_procvar needs the same changes handle_procvar needs the same changes
@ -3279,117 +3255,6 @@ const
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;
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags); procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
{ {
Parse the procedure directives. It does not matter if procedure directives Parse the procedure directives. It does not matter if procedure directives

2
compiler/pdecvar.pas
View File

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

2
compiler/pgenutil.pas
View File

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

2
compiler/pmodules.pas
View File

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

138
compiler/pparautl.pas
View File

@ -35,12 +35,24 @@ interface
procedure insert_hidden_para(p:TObject;arg:pointer); procedure insert_hidden_para(p:TObject;arg:pointer);
procedure check_c_para(pd:Tabstractprocdef); 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 implementation
uses uses
globals,globtype,verbose,systems, globals,globtype,verbose,systems,
symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl, symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
paramgr; pbase,paramgr;
procedure insert_funcret_para(pd:tabstractprocdef); procedure insert_funcret_para(pd:tabstractprocdef);
@ -418,4 +430,128 @@ implementation
end; 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. end.

2
compiler/ptype.pas
View File

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