|
|
@@ -26,7 +26,7 @@ unit pparautl;
|
|
|
interface
|
|
|
|
|
|
uses
|
|
|
- symdef;
|
|
|
+ symconst,symdef;
|
|
|
|
|
|
procedure insert_funcret_para(pd:tabstractprocdef);
|
|
|
procedure insert_parentfp_para(pd:tabstractprocdef);
|
|
|
@@ -34,25 +34,43 @@ interface
|
|
|
procedure insert_funcret_local(pd:tprocdef);
|
|
|
procedure insert_hidden_para(p:TObject;arg:pointer);
|
|
|
procedure check_c_para(pd:Tabstractprocdef);
|
|
|
+ procedure insert_record_hidden_paras(astruct: trecorddef);
|
|
|
|
|
|
- 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];
|
|
|
+ type
|
|
|
+ // flags of the *handle_calling_convention routines
|
|
|
+ thccflag=(
|
|
|
+ hcc_declaration, // declaration (as opposed to definition, i.e. interface rather than implementation)
|
|
|
+ hcc_check, // perform checks and outup errors if found
|
|
|
+ hcc_insert_hidden_paras // insert hidden parameters
|
|
|
+ );
|
|
|
+ thccflags=set of thccflag;
|
|
|
|
|
|
- procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
|
|
|
+ const
|
|
|
+ hcc_default_actions_intf=[hcc_declaration,hcc_check,hcc_insert_hidden_paras];
|
|
|
+ hcc_default_actions_impl=[hcc_check,hcc_insert_hidden_paras];
|
|
|
+ hcc_default_actions_parse=[hcc_check,hcc_insert_hidden_paras];
|
|
|
+ PD_VIRTUAL_MUTEXCLPO = [po_interrupt,po_exports,po_overridingmethod,po_inline,po_staticmethod];
|
|
|
+
|
|
|
+ procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
|
|
|
+ function proc_add_definition(var currpd:tprocdef):boolean;
|
|
|
+
|
|
|
+ { create "parent frame pointer" record skeleton for procdef, in which local
|
|
|
+ variables and parameters from pd accessed from nested routines can be
|
|
|
+ stored }
|
|
|
+ procedure build_parentfpstruct(pd: tprocdef);
|
|
|
|
|
|
implementation
|
|
|
|
|
|
uses
|
|
|
- globals,globtype,verbose,systems,
|
|
|
- symconst,symtype,symbase,symsym,symtable,symcreat,defutil,blockutl,
|
|
|
- pbase,paramgr;
|
|
|
+ globals,globtype,cclasses,cutils,verbose,systems,fmodule,
|
|
|
+ tokens,
|
|
|
+ symtype,symbase,symsym,symtable,symutil,defutil,defcmp,blockutl,
|
|
|
+{$ifdef jvm}
|
|
|
+ jvmdef,
|
|
|
+{$endif jvm}
|
|
|
+ node,nbas,
|
|
|
+ aasmbase,
|
|
|
+ paramgr;
|
|
|
|
|
|
|
|
|
procedure insert_funcret_para(pd:tabstractprocdef);
|
|
|
@@ -140,8 +158,8 @@ implementation
|
|
|
begin
|
|
|
if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
|
|
|
build_parentfpstruct(tprocdef(pd.owner.defowner));
|
|
|
- vs:=cparavarsym.create('$parentfp',paranr,vs_value
|
|
|
- ,tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
|
|
|
+ vs:=cparavarsym.create('$parentfp',paranr,vs_value,
|
|
|
+ tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
|
|
|
end;
|
|
|
pd.parast.insert(vs);
|
|
|
|
|
|
@@ -430,6 +448,29 @@ implementation
|
|
|
end;
|
|
|
|
|
|
|
|
|
+ procedure insert_record_hidden_paras(astruct: trecorddef);
|
|
|
+ var
|
|
|
+ pd: tdef;
|
|
|
+ i: longint;
|
|
|
+ oldpos: tfileposinfo;
|
|
|
+ begin
|
|
|
+ // handle calling conventions of record methods
|
|
|
+ oldpos:=current_filepos;
|
|
|
+ { don't keep track of procdefs in a separate list, because the
|
|
|
+ compiler may add additional procdefs (e.g. property wrappers for
|
|
|
+ the jvm backend) }
|
|
|
+ for i := 0 to astruct.symtable.deflist.count - 1 do
|
|
|
+ begin
|
|
|
+ pd:=tdef(astruct.symtable.deflist[i]);
|
|
|
+ if pd.typ<>procdef then
|
|
|
+ continue;
|
|
|
+ current_filepos:=tprocdef(pd).fileinfo;
|
|
|
+ handle_calling_convention(tprocdef(pd),[hcc_declaration,hcc_insert_hidden_paras]);
|
|
|
+ end;
|
|
|
+ current_filepos:=oldpos;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
procedure set_addr_param_regable(p:TObject;arg:pointer);
|
|
|
begin
|
|
|
if (tsym(p).typ<>paravarsym) then
|
|
|
@@ -443,7 +484,7 @@ implementation
|
|
|
end;
|
|
|
|
|
|
|
|
|
- procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags=hcc_all);
|
|
|
+ procedure handle_calling_convention(pd:tabstractprocdef;flags:thccflags);
|
|
|
begin
|
|
|
if hcc_check in flags then
|
|
|
begin
|
|
|
@@ -504,7 +545,7 @@ implementation
|
|
|
{ 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
|
|
|
+ if hcc_declaration in flags then
|
|
|
begin
|
|
|
{ if external is available, then cdecl must also be available,
|
|
|
procvars don't need external }
|
|
|
@@ -554,4 +595,512 @@ implementation
|
|
|
end;
|
|
|
|
|
|
|
|
|
+ function proc_add_definition(var currpd:tprocdef):boolean;
|
|
|
+
|
|
|
+ function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
|
|
|
+ var
|
|
|
+ i : longint;
|
|
|
+ fwtype,
|
|
|
+ currtype : ttypesym;
|
|
|
+ begin
|
|
|
+ result:=true;
|
|
|
+ if fwpd.genericparas.count<>currpd.genericparas.count then
|
|
|
+ internalerror(2018090101);
|
|
|
+ for i:=0 to fwpd.genericparas.count-1 do
|
|
|
+ begin
|
|
|
+ fwtype:=ttypesym(fwpd.genericparas[i]);
|
|
|
+ currtype:=ttypesym(currpd.genericparas[i]);
|
|
|
+ if fwtype.name<>currtype.name then
|
|
|
+ begin
|
|
|
+ messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
|
|
|
+ messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
|
|
|
+ result:=false;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
|
|
|
+ var
|
|
|
+ i : longint;
|
|
|
+ fwtype,
|
|
|
+ currtype : ttypesym;
|
|
|
+ foundretdef : boolean;
|
|
|
+ begin
|
|
|
+ result:=false;
|
|
|
+ if fwpd.genericparas.count<>currpd.genericparas.count then
|
|
|
+ exit;
|
|
|
+ { comparing generic declarations is a bit more cumbersome as the
|
|
|
+ defs of the generic parameter types are not equal, especially if the
|
|
|
+ declaration contains constraints; essentially we have two cases:
|
|
|
+ - proc declared in interface of unit (or in class/record/object)
|
|
|
+ and defined in implementation; here the fwpd might contain
|
|
|
+ constraints while currpd must only contain undefineddefs
|
|
|
+ - forward declaration in implementation }
|
|
|
+ foundretdef:=false;
|
|
|
+ for i:=0 to fwpd.genericparas.count-1 do
|
|
|
+ begin
|
|
|
+ fwtype:=ttypesym(fwpd.genericparas[i]);
|
|
|
+ currtype:=ttypesym(currpd.genericparas[i]);
|
|
|
+ { if the type in the currpd isn't a pure undefineddef, then we can
|
|
|
+ stop right there }
|
|
|
+ if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
|
|
|
+ exit;
|
|
|
+ if not foundretdef then
|
|
|
+ begin
|
|
|
+ { if the returndef is the same as this parameter's def then this
|
|
|
+ needs to be the case for both procdefs }
|
|
|
+ foundretdef:=fwpd.returndef=fwtype.typedef;
|
|
|
+ if foundretdef xor (currpd.returndef=currtype.typedef) then
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv,cpo_generic])<>te_exact then
|
|
|
+ exit;
|
|
|
+ if not foundretdef then
|
|
|
+ begin
|
|
|
+ if (df_specialization in tstoreddef(fwpd.returndef).defoptions) and (df_specialization in tstoreddef(currpd.returndef).defoptions) then
|
|
|
+ { for specializations we're happy with equal defs instead of exactly the same defs }
|
|
|
+ result:=equal_defs(fwpd.returndef,currpd.returndef)
|
|
|
+ else
|
|
|
+ { the returndef isn't a type parameter, so compare as usual }
|
|
|
+ result:=compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ result:=true;
|
|
|
+ end;
|
|
|
+
|
|
|
+ {
|
|
|
+ Add definition aprocdef to the overloaded definitions of aprocsym. If a
|
|
|
+ forwarddef is found and reused it returns true
|
|
|
+ }
|
|
|
+ var
|
|
|
+ fwpd : tprocdef;
|
|
|
+ currparasym,
|
|
|
+ fwparasym : tsym;
|
|
|
+ currparacnt,
|
|
|
+ fwparacnt,
|
|
|
+ curridx,
|
|
|
+ fwidx,
|
|
|
+ i : longint;
|
|
|
+ po_comp : tprocoptions;
|
|
|
+ paracompopt: tcompare_paras_options;
|
|
|
+ forwardfound : boolean;
|
|
|
+ symentry: TSymEntry;
|
|
|
+ item : tlinkedlistitem;
|
|
|
+ begin
|
|
|
+ forwardfound:=false;
|
|
|
+
|
|
|
+ { check overloaded functions if the same function already exists }
|
|
|
+ for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do
|
|
|
+ begin
|
|
|
+ fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]);
|
|
|
+
|
|
|
+ { can happen for internally generated routines }
|
|
|
+ if (fwpd=currpd) then
|
|
|
+ begin
|
|
|
+ result:=true;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Skip overloaded definitions that are declared in other units }
|
|
|
+ if fwpd.procsym<>currpd.procsym then
|
|
|
+ continue;
|
|
|
+
|
|
|
+ { check the parameters, for delphi/tp it is possible to
|
|
|
+ leave the parameters away in the implementation (forwarddef=false).
|
|
|
+ But for an overload declared function this is not allowed }
|
|
|
+ if { check if empty implementation arguments match is allowed }
|
|
|
+ (
|
|
|
+ not(m_repeat_forward in current_settings.modeswitches) and
|
|
|
+ not(currpd.forwarddef) and
|
|
|
+ is_bareprocdef(currpd) and
|
|
|
+ not(po_overload in fwpd.procoptions)
|
|
|
+ ) or
|
|
|
+ (
|
|
|
+ fwpd.is_generic and
|
|
|
+ currpd.is_generic and
|
|
|
+ equal_generic_procdefs(fwpd,currpd)
|
|
|
+ ) or
|
|
|
+ { check arguments, we need to check only the user visible parameters. The hidden parameters
|
|
|
+ can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV)
|
|
|
+
|
|
|
+ don't check default values here, because routines that are the same except for their default
|
|
|
+ values should be reported as mismatches (since you can't overload based on different default
|
|
|
+ parameter values) }
|
|
|
+ (
|
|
|
+ (compare_paras(fwpd.paras,currpd.paras,cp_none,[cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and
|
|
|
+ (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact)
|
|
|
+ ) then
|
|
|
+ begin
|
|
|
+ { Check if we've found the forwarddef, if found then
|
|
|
+ we need to update the forward def with the current
|
|
|
+ implementation settings }
|
|
|
+ if fwpd.forwarddef then
|
|
|
+ begin
|
|
|
+ forwardfound:=true;
|
|
|
+
|
|
|
+ if not(m_repeat_forward in current_settings.modeswitches) and
|
|
|
+ (fwpd.proccalloption<>currpd.proccalloption) then
|
|
|
+ paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]
|
|
|
+ else
|
|
|
+ paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv];
|
|
|
+
|
|
|
+ { Check calling convention }
|
|
|
+ if (fwpd.proccalloption<>currpd.proccalloption) then
|
|
|
+ begin
|
|
|
+ { In delphi it is possible to specify the calling
|
|
|
+ convention in the interface or implementation if
|
|
|
+ there was no convention specified in the other
|
|
|
+ part }
|
|
|
+ if (m_delphi in current_settings.modeswitches) then
|
|
|
+ begin
|
|
|
+ if not(po_hascallingconvention in currpd.procoptions) then
|
|
|
+ currpd.proccalloption:=fwpd.proccalloption
|
|
|
+ else
|
|
|
+ if not(po_hascallingconvention in fwpd.procoptions) then
|
|
|
+ fwpd.proccalloption:=currpd.proccalloption
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
|
|
|
+ tprocsym(currpd.procsym).write_parameter_lists(currpd);
|
|
|
+ { restore interface settings }
|
|
|
+ currpd.proccalloption:=fwpd.proccalloption;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward);
|
|
|
+ tprocsym(currpd.procsym).write_parameter_lists(currpd);
|
|
|
+ { restore interface settings }
|
|
|
+ currpd.proccalloption:=fwpd.proccalloption;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Check static }
|
|
|
+ if (po_staticmethod in fwpd.procoptions) then
|
|
|
+ begin
|
|
|
+ if not (po_staticmethod in currpd.procoptions) then
|
|
|
+ begin
|
|
|
+ include(currpd.procoptions, po_staticmethod);
|
|
|
+ if (po_classmethod in currpd.procoptions) then
|
|
|
+ begin
|
|
|
+ { remove self from the hidden paras }
|
|
|
+ symentry:=currpd.parast.Find('self');
|
|
|
+ if symentry<>nil then
|
|
|
+ begin
|
|
|
+ currpd.parast.Delete(symentry);
|
|
|
+ currpd.calcparas;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Check if the procedure type and return type are correct,
|
|
|
+ also the parameters must match also with the type and that
|
|
|
+ if the implementation has default parameters, the interface
|
|
|
+ also has them and that if they both have them, that they
|
|
|
+ have the same value }
|
|
|
+ if ((m_repeat_forward in current_settings.modeswitches) or
|
|
|
+ not is_bareprocdef(currpd)) and
|
|
|
+ (
|
|
|
+ (
|
|
|
+ fwpd.is_generic and
|
|
|
+ currpd.is_generic and
|
|
|
+ not equal_generic_procdefs(fwpd,currpd)
|
|
|
+ ) or
|
|
|
+ (
|
|
|
+ (
|
|
|
+ not fwpd.is_generic or
|
|
|
+ not currpd.is_generic
|
|
|
+ ) and
|
|
|
+ (
|
|
|
+ (compare_paras(fwpd.paras,currpd.paras,cp_all,paracompopt)<>te_exact) or
|
|
|
+ (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)
|
|
|
+ )
|
|
|
+ )
|
|
|
+ ) then
|
|
|
+ begin
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
|
|
|
+ fwpd.fullprocname(false));
|
|
|
+ tprocsym(currpd.procsym).write_parameter_lists(currpd);
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Check if both are declared forward }
|
|
|
+ if fwpd.forwarddef and currpd.forwarddef then
|
|
|
+ begin
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward,
|
|
|
+ currpd.fullprocname(false));
|
|
|
+ end;
|
|
|
+
|
|
|
+ { internconst or internproc only need to be defined once }
|
|
|
+ if (fwpd.proccalloption=pocall_internproc) then
|
|
|
+ currpd.proccalloption:=fwpd.proccalloption
|
|
|
+ else
|
|
|
+ if (currpd.proccalloption=pocall_internproc) then
|
|
|
+ fwpd.proccalloption:=currpd.proccalloption;
|
|
|
+
|
|
|
+ { Check procedure options, Delphi requires that class is
|
|
|
+ repeated in the implementation for class methods }
|
|
|
+ if (m_fpc in current_settings.modeswitches) then
|
|
|
+ po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt]
|
|
|
+ else
|
|
|
+ po_comp:=[po_classmethod,po_methodpointer];
|
|
|
+
|
|
|
+ if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or
|
|
|
+ (fwpd.proctypeoption <> currpd.proctypeoption) or
|
|
|
+ { if the implementation version has an "overload" modifier,
|
|
|
+ the interface version must also have it (otherwise we can
|
|
|
+ get annoying crashes due to interface crc changes) }
|
|
|
+ (not(po_overload in fwpd.procoptions) and
|
|
|
+ (po_overload in currpd.procoptions)) then
|
|
|
+ begin
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
|
|
|
+ fwpd.fullprocname(false));
|
|
|
+ tprocsym(fwpd.procsym).write_parameter_lists(fwpd);
|
|
|
+ { This error is non-fatal, we can recover }
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Forward declaration is external? }
|
|
|
+ if (po_external in fwpd.procoptions) then
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_proc_already_external);
|
|
|
+
|
|
|
+ { check for conflicts with "virtual" if this is a virtual
|
|
|
+ method, as "virtual" cannot be repeated in the
|
|
|
+ implementation and hence does not get checked against }
|
|
|
+ if (po_virtualmethod in fwpd.procoptions) then
|
|
|
+ begin
|
|
|
+ po_comp:=currpd.procoptions*PD_VIRTUAL_MUTEXCLPO;
|
|
|
+ if po_comp<>[] then
|
|
|
+ MessagePos2(currpd.fileinfo,parser_e_proc_dir_conflict,tokeninfo^[_VIRTUAL].str,get_first_proc_str(po_comp));
|
|
|
+ end;
|
|
|
+ { Check parameters }
|
|
|
+ if (m_repeat_forward in current_settings.modeswitches) or
|
|
|
+ (currpd.minparacount>0) then
|
|
|
+ begin
|
|
|
+ { If mangled names are equal then they have the same amount of arguments }
|
|
|
+ { We can check the names of the arguments }
|
|
|
+ { both symtables are in the same order from left to right }
|
|
|
+ curridx:=0;
|
|
|
+ fwidx:=0;
|
|
|
+ currparacnt:=currpd.parast.SymList.Count;
|
|
|
+ fwparacnt:=fwpd.parast.SymList.Count;
|
|
|
+ repeat
|
|
|
+ { skip default parameter constsyms }
|
|
|
+ while (curridx<currparacnt) and
|
|
|
+ (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do
|
|
|
+ inc(curridx);
|
|
|
+ while (fwidx<fwparacnt) and
|
|
|
+ (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do
|
|
|
+ inc(fwidx);
|
|
|
+ { stop when one of the two lists is at the end }
|
|
|
+ if (fwidx>=fwparacnt) or (curridx>=currparacnt) then
|
|
|
+ break;
|
|
|
+ { compare names of parameters, ignore implictly
|
|
|
+ renamed parameters }
|
|
|
+ currparasym:=tsym(currpd.parast.SymList[curridx]);
|
|
|
+ fwparasym:=tsym(fwpd.parast.SymList[fwidx]);
|
|
|
+ if not(sp_implicitrename in currparasym.symoptions) and
|
|
|
+ not(sp_implicitrename in fwparasym.symoptions) then
|
|
|
+ begin
|
|
|
+ if (currparasym.name<>fwparasym.name) then
|
|
|
+ begin
|
|
|
+ MessagePos3(currpd.fileinfo,parser_e_header_different_var_names,
|
|
|
+ tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname);
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ { next parameter }
|
|
|
+ inc(curridx);
|
|
|
+ inc(fwidx);
|
|
|
+ until false;
|
|
|
+ end;
|
|
|
+ { check that the type parameter names for generic methods match;
|
|
|
+ we check this here and not in equal_generic_procdefs as the defs
|
|
|
+ might still be different due to their parameters, so we'd generate
|
|
|
+ errors without any need }
|
|
|
+ if currpd.is_generic and fwpd.is_generic then
|
|
|
+ { an error here is recoverable, so we simply continue }
|
|
|
+ check_generic_parameters(fwpd,currpd);
|
|
|
+ { Everything is checked, now we can update the forward declaration
|
|
|
+ with the new data from the implementation }
|
|
|
+ fwpd.forwarddef:=currpd.forwarddef;
|
|
|
+ fwpd.hasforward:=true;
|
|
|
+ fwpd.procoptions:=fwpd.procoptions+currpd.procoptions;
|
|
|
+
|
|
|
+ { marked as local but exported from unit? }
|
|
|
+ if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then
|
|
|
+ MessagePos(fwpd.fileinfo,type_e_cant_export_local);
|
|
|
+
|
|
|
+ if fwpd.extnumber=$ffff then
|
|
|
+ fwpd.extnumber:=currpd.extnumber;
|
|
|
+ while not currpd.aliasnames.empty do
|
|
|
+ fwpd.aliasnames.insert(currpd.aliasnames.getfirst);
|
|
|
+ { update fileinfo so position references the implementation,
|
|
|
+ also update funcretsym if it is already generated }
|
|
|
+ fwpd.fileinfo:=currpd.fileinfo;
|
|
|
+ if assigned(fwpd.funcretsym) then
|
|
|
+ fwpd.funcretsym.fileinfo:=currpd.fileinfo;
|
|
|
+ if assigned(currpd.deprecatedmsg) then
|
|
|
+ begin
|
|
|
+ stringdispose(fwpd.deprecatedmsg);
|
|
|
+ fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^);
|
|
|
+ end;
|
|
|
+ { import names }
|
|
|
+ if assigned(currpd.import_dll) then
|
|
|
+ begin
|
|
|
+ stringdispose(fwpd.import_dll);
|
|
|
+ fwpd.import_dll:=stringdup(currpd.import_dll^);
|
|
|
+ end;
|
|
|
+ if assigned(currpd.import_name) then
|
|
|
+ begin
|
|
|
+ stringdispose(fwpd.import_name);
|
|
|
+ fwpd.import_name:=stringdup(currpd.import_name^);
|
|
|
+ end;
|
|
|
+ fwpd.import_nr:=currpd.import_nr;
|
|
|
+ { for compilerproc defines we need to rename and update the
|
|
|
+ symbolname to lowercase so users can' access it (can't do
|
|
|
+ it immediately, because then the implementation symbol
|
|
|
+ won't be matched) }
|
|
|
+ if po_compilerproc in fwpd.procoptions then
|
|
|
+ begin
|
|
|
+ fwpd.setcompilerprocname;
|
|
|
+ current_module.add_public_asmsym(fwpd.procsym.realname,AB_GLOBAL,AT_FUNCTION);
|
|
|
+ end;
|
|
|
+ if po_public in fwpd.procoptions then
|
|
|
+ begin
|
|
|
+ item:=fwpd.aliasnames.first;
|
|
|
+ while assigned(item) do
|
|
|
+ begin
|
|
|
+ current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
|
|
|
+ item:=item.next;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { Release current procdef }
|
|
|
+ currpd.owner.deletedef(currpd);
|
|
|
+ currpd:=fwpd;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { abstract methods aren't forward defined, but this }
|
|
|
+ { needs another error message }
|
|
|
+ if (po_abstractmethod in fwpd.procoptions) then
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_abstract_no_definition)
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters);
|
|
|
+ tprocsym(currpd.procsym).write_parameter_lists(currpd);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { we found one proc with the same arguments, there are no others
|
|
|
+ so we can stop }
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { check for allowing overload directive }
|
|
|
+ if not(m_fpc in current_settings.modeswitches) then
|
|
|
+ begin
|
|
|
+ { overload directive turns on overloading }
|
|
|
+ if ((po_overload in currpd.procoptions) or
|
|
|
+ (po_overload in fwpd.procoptions)) then
|
|
|
+ begin
|
|
|
+ { check if all procs have overloading, but not if the proc is a method or
|
|
|
+ already declared forward, then the check is already done }
|
|
|
+ if not(fwpd.hasforward or
|
|
|
+ assigned(currpd.struct) or
|
|
|
+ (currpd.forwarddef<>fwpd.forwarddef) or
|
|
|
+ ((po_overload in currpd.procoptions) and
|
|
|
+ (po_overload in fwpd.procoptions))) then
|
|
|
+ begin
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
|
|
|
+ break;
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if not(fwpd.forwarddef) then
|
|
|
+ begin
|
|
|
+ if (m_tp7 in current_settings.modeswitches) then
|
|
|
+ MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off)
|
|
|
+ else
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname);
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end; { equal arguments }
|
|
|
+ end;
|
|
|
+
|
|
|
+ { if we didn't reuse a forwarddef then we add the procdef to the overloaded
|
|
|
+ list }
|
|
|
+ if not forwardfound then
|
|
|
+ begin
|
|
|
+ { can happen in Delphi mode }
|
|
|
+ if (currpd.proctypeoption = potype_function) and
|
|
|
+ is_void(currpd.returndef) then
|
|
|
+ MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname);
|
|
|
+ tprocsym(currpd.procsym).ProcdefList.Add(currpd);
|
|
|
+ if not currpd.forwarddef and (po_public in currpd.procoptions) then
|
|
|
+ begin
|
|
|
+ item:=currpd.aliasnames.first;
|
|
|
+ while assigned(item) do
|
|
|
+ begin
|
|
|
+ current_module.add_public_asmsym(TCmdStrListItem(item).str,AB_GLOBAL,AT_FUNCTION);
|
|
|
+ item:=item.next;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ proc_add_definition:=forwardfound;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ procedure build_parentfpstruct(pd: tprocdef);
|
|
|
+ var
|
|
|
+ nestedvars: tsym;
|
|
|
+ nestedvarsst: tsymtable;
|
|
|
+ pnestedvarsdef,
|
|
|
+ nestedvarsdef: tdef;
|
|
|
+ old_symtablestack: tsymtablestack;
|
|
|
+ begin
|
|
|
+ { make sure the defs are not registered in the current symtablestack,
|
|
|
+ because they may be for a parent procdef (changeowner does remove a def
|
|
|
+ from the symtable in which it was originally created, so that by itself
|
|
|
+ is not enough) }
|
|
|
+ old_symtablestack:=symtablestack;
|
|
|
+ symtablestack:=old_symtablestack.getcopyuntil(current_module.localsymtable);
|
|
|
+ { create struct to hold local variables and parameters that are
|
|
|
+ accessed from within nested routines (start with extra dollar to prevent
|
|
|
+ the JVM from thinking this is a nested class in the unit) }
|
|
|
+ nestedvarsst:=trecordsymtable.create('$'+current_module.realmodulename^+'$$_fpc_nestedvars$'+pd.unique_id_str,
|
|
|
+ current_settings.alignment.localalignmax,current_settings.alignment.localalignmin,current_settings.alignment.maxCrecordalign);
|
|
|
+ nestedvarsdef:=crecorddef.create(nestedvarsst.name^,nestedvarsst);
|
|
|
+ {$ifdef jvm}
|
|
|
+ maybe_guarantee_record_typesym(nestedvarsdef,nestedvarsdef.owner);
|
|
|
+ { don't add clone/FpcDeepCopy, because the field names are not all
|
|
|
+ representable in source form and we don't need them anyway }
|
|
|
+ symtablestack.push(trecorddef(nestedvarsdef).symtable);
|
|
|
+ maybe_add_public_default_java_constructor(trecorddef(nestedvarsdef));
|
|
|
+ insert_record_hidden_paras(trecorddef(nestedvarsdef));
|
|
|
+ symtablestack.pop(trecorddef(nestedvarsdef).symtable);
|
|
|
+ {$endif}
|
|
|
+ symtablestack.free;
|
|
|
+ symtablestack:=old_symtablestack.getcopyuntil(pd.localst);
|
|
|
+ pnestedvarsdef:=cpointerdef.getreusable(nestedvarsdef);
|
|
|
+ if not(po_assembler in pd.procoptions) then
|
|
|
+ begin
|
|
|
+ nestedvars:=clocalvarsym.create('$nestedvars',vs_var,nestedvarsdef,[],true);
|
|
|
+ include(nestedvars.symoptions,sp_internal);
|
|
|
+ pd.localst.insert(nestedvars);
|
|
|
+ pd.parentfpstruct:=nestedvars;
|
|
|
+ pd.parentfpinitblock:=cblocknode.create(nil);
|
|
|
+ end;
|
|
|
+ symtablestack.free;
|
|
|
+ pd.parentfpstructptrtype:=pnestedvarsdef;
|
|
|
+
|
|
|
+ symtablestack:=old_symtablestack;
|
|
|
+ end;
|
|
|
+
|
|
|
end.
|
Jonas Maebe