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

* ensure that the def used when calling procvars matches the value in

Browse Source 
the register (e.g., change it to only the procedure address in case of
    a complex procvar)

git-svn-id: trunk@32418 -
This commit is contained in:
Jonas Maebe 2015-11-21 12:37:24 +00:00
parent 00a5dd87c9
commit 32796f4af9
1 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
compiler/ncgcal.pas
View File

@ -105,11 +105,11 @@ interface
{ loads the code pointer of a complex procvar (one with a self/ { loads the code pointer of a complex procvar (one with a self/
parentfp/... and a procedure address) into a register and returns it } parentfp/... and a procedure address) into a register and returns it }
function load_complex_procvar_codeptr: tregister; virtual; procedure load_complex_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef); virtual;
{ loads the procvar code pointer into a register } { loads the procvar code pointer into a register with type def }
function load_procvar_codeptr: tregister; procedure load_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
procedure load_block_invoke(toreg: tregister);virtual; procedure load_block_invoke(toreg: tregister; out callprocdef: tabstractprocdef);virtual;
function get_call_reg(list: TAsmList): tregister; virtual; function get_call_reg(list: TAsmList): tregister; virtual;
procedure unget_call_reg(list: TAsmList; reg: tregister); virtual; procedure unget_call_reg(list: TAsmList; reg: tregister); virtual;
@ -436,7 +436,7 @@ implementation
end; end;
procedure tcgcallnode.load_block_invoke(toreg: tregister); procedure tcgcallnode.load_block_invoke(toreg: tregister; out callprocdef: tabstractprocdef);
var var
href: treference; href: treference;
srsym: tsym; srsym: tsym;
@ -453,6 +453,7 @@ implementation
internalerror(2014071506); internalerror(2014071506);
href.offset:=tfieldvarsym(srsym).fieldoffset; href.offset:=tfieldvarsym(srsym).fieldoffset;
hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,tfieldvarsym(srsym).vardef,procdefinition,href,toreg); hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,tfieldvarsym(srsym).vardef,procdefinition,href,toreg);
callprocdef:=procdefinition;
end; end;
@ -778,18 +779,17 @@ implementation
end; end;
function tcgcallnode.load_complex_procvar_codeptr: tregister; procedure tcgcallnode.load_complex_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
var var
srcreg: tregister; srcreg: tregister;
codeprocdef: tabstractprocdef;
begin begin
{ this is safe even on i8086, because procvardef code pointers are { this is safe even on i8086, because procvardef code pointers are
always far there (so the current state of far calls vs the state always far there (so the current state of far calls vs the state
of far calls where the procvardef was defined does not matter, of far calls where the procvardef was defined does not matter,
even though the procvardef constructor called by getcopyas looks at even though the procvardef constructor called by getcopyas looks at
it) } it) }
codeprocdef:=cprocvardef.getreusableprocaddr(procdefinition); callprocdef:=cprocvardef.getreusableprocaddr(procdefinition);
result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,codeprocdef); reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
{ in case we have a method pointer on a big endian target in registers, { in case we have a method pointer on a big endian target in registers,
the method address is stored in registerhi (it's the first field the method address is stored in registerhi (it's the first field
in the tmethod record) } in the tmethod record) }
@ -801,31 +801,33 @@ implementation
srcreg:=right.location.registerhi srcreg:=right.location.registerhi
else else
srcreg:=right.location.register; srcreg:=right.location.register;
hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,codeprocdef,codeprocdef,srcreg,result) hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,callprocdef,callprocdef,srcreg,reg)
end end
else else
begin begin
hlcg.location_force_mem(current_asmdata.CurrAsmList,right.location,procdefinition); hlcg.location_force_mem(current_asmdata.CurrAsmList,right.location,procdefinition);
hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(procdefinition),cpointerdef.getreusable(codeprocdef),right.location.reference); hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(procdefinition),cpointerdef.getreusable(callprocdef),right.location.reference);
hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,codeprocdef,codeprocdef,right.location.reference,result); hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,callprocdef,callprocdef,right.location.reference,reg);
end; end;
end; end;
function tcgcallnode.load_procvar_codeptr: tregister; procedure tcgcallnode.load_procvar_codeptr(out reg: tregister; out callprocdef: tabstractprocdef);
begin begin
if po_is_block in procdefinition.procoptions then if po_is_block in procdefinition.procoptions then
begin begin
result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition); reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition);
load_block_invoke(result); load_block_invoke(reg,callprocdef);
end end
else if not(procdefinition.is_addressonly) then else if not(procdefinition.is_addressonly) then
result:=load_complex_procvar_codeptr load_complex_procvar_codeptr(reg,callprocdef)
else else
begin begin
result:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition); reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,procdefinition);
hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,procdefinition,procdefinition,right.location,result); hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,procdefinition,procdefinition,right.location,reg);
callprocdef:=procdefinition;
end; end;
callprocdef.init_paraloc_info(callerside);
end; end;
@ -860,6 +862,7 @@ implementation
pvreg : tregister; pvreg : tregister;
oldaktcallnode : tcallnode; oldaktcallnode : tcallnode;
retlocitem: pcgparalocation; retlocitem: pcgparalocation;
callpvdef: tabstractprocdef;
pd : tprocdef; pd : tprocdef;
callref: boolean; callref: boolean;
{$ifdef vtentry} {$ifdef vtentry}
@ -1074,9 +1077,12 @@ implementation
end; end;
if not callref then if not callref then
pvreg:=load_procvar_codeptr load_procvar_codeptr(pvreg,callpvdef)
else else
pvreg:=NR_INVALID; begin
pvreg:=NR_INVALID;
callpvdef:=nil;
end;
location_freetemp(current_asmdata.CurrAsmList,right.location); location_freetemp(current_asmdata.CurrAsmList,right.location);
{ Load parameters that are in temporary registers in the { Load parameters that are in temporary registers in the
@ -1110,7 +1116,7 @@ implementation
if callref then if callref then
retloc:=do_call_ref(href) retloc:=do_call_ref(href)
else else
retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,procdefinition,pvreg,paralocs); retloc:=hlcg.a_call_reg(current_asmdata.CurrAsmList,callpvdef,pvreg,paralocs);
extra_post_call_code; extra_post_call_code;
end; end;