paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 07:34:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* extend tabstractprocdef.getcopyas by a parameter to control whether the copy should be registered or not

Browse Source
This commit is contained in:
Sven/Sarah Barth 2022-03-30 22:17:07 +02:00
parent 90eabdd6b4
commit 7f3a5eb9ab
11 changed files with 35 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/arm/symcpu.pas
View File

@ -101,7 +101,7 @@ type
{ library symbol for AROS }
libsym : tsym;
libsymderef : tderef;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
procedure buildderef; override;
procedure deref; override;
end;
@ -208,7 +208,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
if newtyp=procdef then

2
compiler/blockutl.pas
View File

@ -207,7 +207,7 @@ implementation
exit;
end;
{ bare copy, so that self etc are not inserted }
result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,'',true));
{ will be called accoding to the ABI conventions }
result.proccalloption:=pocall_cdecl;
{ add po_is_block so that a block "self" pointer gets added (of the type

4
compiler/i386/symcpu.pas
View File

@ -97,7 +97,7 @@ type
{ library symbol for AROS }
libsym : tsym;
libsymderef : tderef;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
procedure buildderef; override;
procedure deref; override;
end;
@ -203,7 +203,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
if newtyp=procdef then

8
compiler/i8086/symcpu.pas
View File

@ -110,7 +110,7 @@ type
tcpuprocvardef = class(ti86procvardef)
constructor create(level:byte;doregister:boolean);override;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;override;
function address_type:tdef;override;
function ofs_address_type:tdef;override;
function size:asizeint;override;
@ -134,7 +134,7 @@ type
procedure Setinterfacedef(AValue: boolean);override;
public
constructor create(level:byte;doregister:boolean);override;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;override;
function address_type:tdef;override;
function ofs_address_type:tdef;override;
function size:asizeint;override;
@ -357,7 +357,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;
begin
result:=inherited;
handle_procdef_copyas(self,is_far,copytyp,tabstractprocdef(result));
@ -448,7 +448,7 @@ implementation
end;
function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;
begin
result:=inherited;
handle_procdef_copyas(self,is_far,copytyp,tabstractprocdef(result));

10
compiler/jvm/pjvm.pas
View File

@ -370,7 +370,7 @@ implementation
{ add a method to call the procvar using unwrapped arguments, which
then wraps them and calls through to JLRMethod.invoke }
methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,'',true));
finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
methoddef.synthetickind:=tsk_jvm_procvar_invoke;
methoddef.calcparas;
@ -403,7 +403,7 @@ implementation
{ add a method prototype matching the procvar (like the invoke
in the procvarclass itself) }
symtablestack.push(pvintf.symtable);
methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,'',true));
finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
{ can't be final/static/private/protected, and must be virtual
since it's an interface method }
@ -467,7 +467,7 @@ implementation
{ wrapper is part of the same symtable as the original procdef }
symtablestack.push(pd.owner);
{ get a copy of the virtual class method }
wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,''));
wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,'',true));
{ this one is not virtual nor override }
exclude(wrapperpd.procoptions,po_virtualmethod);
exclude(wrapperpd.procoptions,po_overridingmethod);
@ -498,7 +498,7 @@ implementation
wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
wrapperpd.skpara:=pd;
{ also create procvar type that we can use in the implementation }
wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,''));
wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,'',true));
handle_calling_convention(wrapperpv,hcc_default_actions_intf);
{ no use in creating a callback wrapper here, this procvar type isn't
for public consumption }
@ -526,7 +526,7 @@ implementation
{ wrapper is part of the same symtable as the original procdef }
symtablestack.push(pd.owner);
{ get a copy of the constructor }
wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'',true));
{ this one is a class method rather than a constructor }
include(wrapperpd.procoptions,po_classmethod);
wrapperpd.proctypeoption:=potype_function;

4
compiler/jvm/symcpu.pas
View File

@ -336,7 +336,7 @@ implementation
proc_add_definition will give an error }
end;
{ add method with the correct visibility }
pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,'',true));
{ get rid of the import accessorname for inherited virtual class methods,
it has to be regenerated rather than amended }
if [po_classmethod,po_virtualmethod]<=pd.procoptions then
@ -396,7 +396,7 @@ implementation
begin
{ getter/setter could have parameters in case of indexed access
-> copy original procdef }
pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,'',true));
exclude(pd.procoptions,po_abstractmethod);
exclude(pd.procoptions,po_overridingmethod);
{ can only construct the artificial accessorname now, because it requires

4
compiler/m68k/symcpu.pas
View File

@ -97,7 +97,7 @@ type
{ library symbol for AmigaOS/MorphOS }
libsym : tsym;
libsymderef : tderef;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
procedure buildderef; override;
procedure deref; override;
end;
@ -203,7 +203,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
if newtyp=procdef then

4
compiler/powerpc/symcpu.pas
View File

@ -97,7 +97,7 @@ type
{ library symbol for AmigaOS/MorphOS }
libsym : tsym;
libsymderef : tderef;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
procedure buildderef; override;
procedure deref; override;
end;
@ -203,7 +203,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
if newtyp=procdef then

6
compiler/symcreat.pas
View File

@ -357,7 +357,7 @@ implementation
end;
{ if we get here, we did not find it in the current objectdef ->
add }
childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,'',true));
{ get rid of the import name for inherited virtual class methods,
it has to be regenerated rather than amended }
if [po_classmethod,po_virtualmethod]<=childpd.procoptions then
@ -1163,7 +1163,7 @@ implementation
parameter names so we don't get issues in the body in case
we e.g. reference system.initialize and one of the parameters
is called "system") }
result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_'));
result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_',true));
{ set the mangled name to the wrapper name }
result.setmangledname(newmangledname);
{ finish creating the copy }
@ -1436,7 +1436,7 @@ implementation
{ prefixing the parameters here is useless, because the new procdef will
just be an external declaration without a body }
newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,'',true));
insert_funcret_para(newpd);
newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
stringdispose(orgpd.import_name);

20
compiler/symdef.pas
View File

@ -711,7 +711,7 @@ interface
function is_addressonly:boolean;virtual;
function no_self_node:boolean;
{ get either a copy as a procdef or procvardef }
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; virtual;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; virtual;
function compatible_with_pointerdef_size(ptr: tpointerdef): boolean; virtual;
procedure check_mark_as_nested;
procedure init_paraloc_info(side: tcallercallee);
@ -752,7 +752,7 @@ interface
function is_methodpointer:boolean;override;
function is_addressonly:boolean;override;
function getmangledparaname:TSymStr;override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
end;
tprocvardefclass = class of tprocvardef;
@ -895,7 +895,7 @@ interface
needs to be finalised afterwards by calling
symcreat.finish_copied_procdef() afterwards
}
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
function getcopy: tstoreddef; override;
function GetTypeName : string;override;
function mangledname : TSymStr; virtual;
@ -5774,7 +5774,7 @@ implementation
end;
function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef;
function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
var
j, nestinglevel: longint;
pvs, npvs: tparavarsym;
@ -5783,9 +5783,9 @@ implementation
if newtyp=procdef then
begin
if (copytyp<>pc_bareproc) then
result:=cprocdef.create(nestinglevel,true)
result:=cprocdef.create(nestinglevel,doregister)
else
result:=cprocdef.create(normal_function_level,true);
result:=cprocdef.create(normal_function_level,doregister);
tprocdef(result).visibility:=vis_public;
end
else
@ -6815,7 +6815,7 @@ implementation
end;
function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
var
j : longint;
begin
@ -6886,7 +6886,7 @@ implementation
function tprocdef.getcopy: tstoreddef;
begin
result:=getcopyas(procdef,pc_normal,'');
result:=getcopyas(procdef,pc_normal,'',true);
end;
@ -7281,7 +7281,7 @@ implementation
{ do not simply push/pop current_module.localsymtable, because
that can have side-effects (e.g., it removes helpers) }
symtablestack:=nil;
result:=tprocvardef(def.getcopyas(procvardef,copytyp,''));
result:=tprocvardef(def.getcopyas(procvardef,copytyp,'',true));
setup_reusable_def(def,result,res,oldsymtablestack);
{ res^.Data may still be nil -> don't overwrite result }
exit;
@ -7420,7 +7420,7 @@ implementation
end;
function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
tabstractprocdef(result).calcparas;

4
compiler/x86_64/symcpu.pas
View File

@ -97,7 +97,7 @@ type
{ library symbol for AROS }
libsym : tsym;
libsymderef : tderef;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
procedure buildderef; override;
procedure deref; override;
end;
@ -203,7 +203,7 @@ implementation
end;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
begin
result:=inherited;
if newtyp=procdef then