paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 18:39:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* have read_body return the created procdef

Browse Source
This commit is contained in:
Sven/Sarah Barth 2021-05-01 22:29:08 +02:00
parent f6a444c6fc
commit ee187f78f4
1 changed files with 59 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
compiler/psub.pas
View File

@ -113,7 +113,7 @@ interface
{ reads any routine in the implementation, or a non-method routine { reads any routine in the implementation, or a non-method routine
declaration in the interface (depending on whether or not parse_only is declaration in the interface (depending on whether or not parse_only is
true) } true) }
procedure read_proc(flags:tread_proc_flags; usefwpd: tprocdef); function read_proc(flags:tread_proc_flags; usefwpd: tprocdef):tprocdef;
{ parses only the body of a non nested routine; needs a correctly setup pd } { parses only the body of a non nested routine; needs a correctly setup pd }
procedure read_proc_body(pd:tprocdef); procedure read_proc_body(pd:tprocdef);
@ -2698,7 +2698,7 @@ implementation
end; end;
procedure read_proc(flags:tread_proc_flags; usefwpd: tprocdef); function read_proc(flags:tread_proc_flags; usefwpd: tprocdef):tprocdef;
{ {
Parses the procedure directives, then parses the procedure body, then Parses the procedure directives, then parses the procedure body, then
generates the code for it generates the code for it
@ -2719,7 +2719,7 @@ implementation
old_current_genericdef, old_current_genericdef,
old_current_specializedef: tstoreddef; old_current_specializedef: tstoreddef;
pdflags : tpdflags; pdflags : tpdflags;
pd,firstpd : tprocdef; firstpd : tprocdef;
{$ifdef genericdef_for_nested} {$ifdef genericdef_for_nested}
def : tprocdef; def : tprocdef;
srsym : tsym; srsym : tsym;
@ -2741,18 +2741,18 @@ implementation
if not assigned(usefwpd) then if not assigned(usefwpd) then
{ parse procedure declaration } { parse procedure declaration }
pd:=parse_proc_dec(convert_flags_to_ppf,old_current_structdef) result:=parse_proc_dec(convert_flags_to_ppf,old_current_structdef)
else else
pd:=usefwpd; result:=usefwpd;
{ set the default function options } { set the default function options }
if parse_only then if parse_only then
begin begin
pd.forwarddef:=true; result.forwarddef:=true;
{ set also the interface flag, for better error message when the { set also the interface flag, for better error message when the
implementation doesn't match this header } implementation doesn't match this header }
pd.interfacedef:=true; result.interfacedef:=true;
include(pd.procoptions,po_global); include(result.procoptions,po_global);
pdflags:=[pd_interface]; pdflags:=[pd_interface];
end end
else else
@ -2762,83 +2762,83 @@ implementation
include(pdflags,pd_implemen); include(pdflags,pd_implemen);
if (not current_module.is_unit) or if (not current_module.is_unit) or
create_smartlink_library then create_smartlink_library then
include(pd.procoptions,po_global); include(result.procoptions,po_global);
pd.forwarddef:=false; result.forwarddef:=false;
end; end;
if not assigned(usefwpd) then if not assigned(usefwpd) then
begin begin
{ parse the directives that may follow } { parse the directives that may follow }
parse_proc_directives(pd,pdflags); parse_proc_directives(result,pdflags);
{ hint directives, these can be separated by semicolons here, { hint directives, these can be separated by semicolons here,
that needs to be handled here with a loop (PFV) } that needs to be handled here with a loop (PFV) }
while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do while try_consume_hintdirective(result.symoptions,result.deprecatedmsg) do
Consume(_SEMICOLON); Consume(_SEMICOLON);
{ Set calling convention } { Set calling convention }
if parse_only then if parse_only then
handle_calling_convention(pd,hcc_default_actions_intf) handle_calling_convention(result,hcc_default_actions_intf)
else else
handle_calling_convention(pd,hcc_default_actions_impl) handle_calling_convention(result,hcc_default_actions_impl)
end; end;
{ search for forward declarations } { search for forward declarations }
if not proc_add_definition(pd) then if not proc_add_definition(result) then
begin begin
{ One may not implement a method of a type declared in a different unit } { One may not implement a method of a type declared in a different unit }
if assigned(pd.struct) and if assigned(result.struct) and
(pd.struct.symtable.moduleid<>current_module.moduleid) and (result.struct.symtable.moduleid<>current_module.moduleid) and
not pd.is_specialization then not result.is_specialization then
begin begin
MessagePos1(pd.fileinfo,parser_e_method_for_type_in_other_unit,pd.struct.typesymbolprettyname); MessagePos1(result.fileinfo,parser_e_method_for_type_in_other_unit,result.struct.typesymbolprettyname);
end end
{ A method must be forward defined (in the object declaration) } { A method must be forward defined (in the object declaration) }
else if assigned(pd.struct) and else if assigned(result.struct) and
(not assigned(old_current_structdef)) then (not assigned(old_current_structdef)) then
begin begin
MessagePos1(pd.fileinfo,parser_e_header_dont_match_any_member,pd.fullprocname(false)); MessagePos1(result.fileinfo,parser_e_header_dont_match_any_member,result.fullprocname(false));
tprocsym(pd.procsym).write_parameter_lists(pd); tprocsym(result.procsym).write_parameter_lists(result);
end end
else else
begin begin
{ Give a better error if there is a forward def in the interface and only { Give a better error if there is a forward def in the interface and only
a single implementation } a single implementation }
firstpd:=tprocdef(tprocsym(pd.procsym).ProcdefList[0]); firstpd:=tprocdef(tprocsym(result.procsym).ProcdefList[0]);
if (not pd.forwarddef) and if (not result.forwarddef) and
(not pd.interfacedef) and (not result.interfacedef) and
(tprocsym(pd.procsym).ProcdefList.Count>1) and (tprocsym(result.procsym).ProcdefList.Count>1) and
firstpd.forwarddef and firstpd.forwarddef and
firstpd.interfacedef and firstpd.interfacedef and
not(tprocsym(pd.procsym).ProcdefList.Count>2) and not(tprocsym(result.procsym).ProcdefList.Count>2) and
{ don't give an error if it may be an overload } { don't give an error if it may be an overload }
not(m_fpc in current_settings.modeswitches) and not(m_fpc in current_settings.modeswitches) and
(not(po_overload in pd.procoptions) or (not(po_overload in result.procoptions) or
not(po_overload in firstpd.procoptions)) then not(po_overload in firstpd.procoptions)) then
begin begin
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false)); MessagePos1(result.fileinfo,parser_e_header_dont_match_forward,result.fullprocname(false));
tprocsym(pd.procsym).write_parameter_lists(pd); tprocsym(result.procsym).write_parameter_lists(result);
end end
else else
begin begin
if pd.is_generic and not assigned(pd.struct) then if result.is_generic and not assigned(result.struct) then
tprocsym(pd.procsym).owner.includeoption(sto_has_generic); tprocsym(result.procsym).owner.includeoption(sto_has_generic);
end; end;
end; end;
end; end;
{ Set mangled name } { Set mangled name }
proc_set_mangledname(pd); proc_set_mangledname(result);
{ inherit generic flags from parent routine } { inherit generic flags from parent routine }
if assigned(old_current_procinfo) and if assigned(old_current_procinfo) and
(old_current_procinfo.procdef.defoptions*[df_specialization,df_generic]<>[]) then (old_current_procinfo.procdef.defoptions*[df_specialization,df_generic]<>[]) then
begin begin
if df_generic in old_current_procinfo.procdef.defoptions then if df_generic in old_current_procinfo.procdef.defoptions then
include(pd.defoptions,df_generic); include(result.defoptions,df_generic);
if df_specialization in old_current_procinfo.procdef.defoptions then if df_specialization in old_current_procinfo.procdef.defoptions then
begin begin
include(pd.defoptions,df_specialization); include(result.defoptions,df_specialization);
{ the procdefs encountered here are nested procdefs of which { the procdefs encountered here are nested procdefs of which
their complete definition also resides inside the current token their complete definition also resides inside the current token
stream, thus access to their genericdef is not required } stream, thus access to their genericdef is not required }
@ -2846,7 +2846,7 @@ implementation
{ find the corresponding routine in the generic routine } { find the corresponding routine in the generic routine }
if not assigned(old_current_procinfo.procdef.genericdef) then if not assigned(old_current_procinfo.procdef.genericdef) then
internalerror(2016121701); internalerror(2016121701);
srsym:=tsym(tprocdef(old_current_procinfo.procdef.genericdef).getsymtable(gs_local).find(pd.procsym.name)); srsym:=tsym(tprocdef(old_current_procinfo.procdef.genericdef).getsymtable(gs_local).find(result.procsym.name));
if not assigned(srsym) or (srsym.typ<>procsym) then if not assigned(srsym) or (srsym.typ<>procsym) then
internalerror(2016121702); internalerror(2016121702);
{ in practice the generic procdef should be at the same index { in practice the generic procdef should be at the same index
@ -2857,14 +2857,14 @@ implementation
for i:=0 to tprocsym(srsym).procdeflist.count-1 do for i:=0 to tprocsym(srsym).procdeflist.count-1 do
begin begin
def:=tprocdef(tprocsym(srsym).procdeflist[i]); def:=tprocdef(tprocsym(srsym).procdeflist[i]);
if (compare_paras(def.paras,pd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and if (compare_paras(def.paras,result.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
(compare_defs(def.returndef,pd.returndef,nothingn)=te_exact) then (compare_defs(def.returndef,result.returndef,nothingn)=te_exact) then
begin begin
pd.genericdef:=def; result.genericdef:=def;
break; break;
end; end;
end; end;
if not assigned(pd.genericdef) then if not assigned(result.genericdef) then
internalerror(2016121703); internalerror(2016121703);
{$endif} {$endif}
end; end;
@ -2873,14 +2873,14 @@ implementation
{ compile procedure when a body is needed } { compile procedure when a body is needed }
if (pd_body in pdflags) then if (pd_body in pdflags) then
begin begin
read_proc_body(old_current_procinfo,pd); read_proc_body(old_current_procinfo,result);
end end
else else
begin begin
{ Handle imports } { Handle imports }
if (po_external in pd.procoptions) then if (po_external in result.procoptions) then
begin begin
import_external_proc(pd); import_external_proc(result);
{$ifdef cpuhighleveltarget} {$ifdef cpuhighleveltarget}
{ it's hard to factor this out in a virtual method, because the { it's hard to factor this out in a virtual method, because the
generic version (the one inside this ifdef) doesn't fit in generic version (the one inside this ifdef) doesn't fit in
@ -2889,17 +2889,17 @@ implementation
Maybe we need another class for this kind of code that could Maybe we need another class for this kind of code that could
either be symcreat- or hlcgobj-based either be symcreat- or hlcgobj-based
} }
if (not pd.forwarddef) and if (not result.forwarddef) and
(pd.hasforward) and (result.hasforward) and
(proc_get_importname(pd)<>'') then (proc_get_importname(result)<>'') then
begin begin
{ we cannot handle the callee-side of variadic functions (and { we cannot handle the callee-side of variadic functions (and
even if we could, e.g. LLVM cannot call through to something even if we could, e.g. LLVM cannot call through to something
else in that case) } else in that case) }
if is_c_variadic(pd) then if is_c_variadic(result) then
Message1(parser_e_callthrough_varargs,pd.fullprocname(false)); Message1(parser_e_callthrough_varargs,result.fullprocname(false));
call_through_new_name(pd,proc_get_importname(pd)); call_through_new_name(result,proc_get_importname(result));
include(pd.implprocoptions,pio_thunk); include(result.implprocoptions,pio_thunk);
end end
else else
{$endif cpuhighleveltarget} {$endif cpuhighleveltarget}
@ -2907,8 +2907,8 @@ implementation
create_hlcodegen; create_hlcodegen;
hlcg.handle_external_proc( hlcg.handle_external_proc(
current_asmdata.asmlists[al_procedures], current_asmdata.asmlists[al_procedures],
pd, result,
proc_get_importname(pd)); proc_get_importname(result));
destroy_hlcodegen; destroy_hlcodegen;
end end
end; end;
@ -2917,20 +2917,20 @@ implementation
{ always register public functions that are only declared in the { always register public functions that are only declared in the
implementation section as they might be called using an external implementation section as they might be called using an external
declaration from another unit } declaration from another unit }
if (po_global in pd.procoptions) and if (po_global in result.procoptions) and
not pd.interfacedef and not result.interfacedef and
([df_generic,df_specialization]*pd.defoptions=[]) then ([df_generic,df_specialization]*result.defoptions=[]) then
begin begin
pd.register_def; result.register_def;
pd.procsym.register_sym; result.procsym.register_sym;
end; end;
{ make sure that references to forward-declared functions are not } { make sure that references to forward-declared functions are not }
{ treated as references to external symbols, needed for darwin. } { treated as references to external symbols, needed for darwin. }
{ make sure we don't change the binding of real external symbols } { make sure we don't change the binding of real external symbols }
if (([po_external,po_weakexternal]*pd.procoptions)=[]) and (pocall_internproc<>pd.proccalloption) then if (([po_external,po_weakexternal]*result.procoptions)=[]) and (pocall_internproc<>result.proccalloption) then
current_asmdata.DefineProcAsmSymbol(pd,pd.mangledname,pd.needsglobalasmsym); current_asmdata.DefineProcAsmSymbol(result,result.mangledname,result.needsglobalasmsym);
current_structdef:=old_current_structdef; current_structdef:=old_current_structdef;
current_genericdef:=old_current_genericdef; current_genericdef:=old_current_genericdef;