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

* synchronize with trunk

Browse Source 
git-svn-id: branches/z80@44519 -
This commit is contained in:
nickysn 2020-04-02 22:55:11 +00:00
commit f81c4a9454
19 changed files with 52 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/aasmcnst.pas
View File

@ -1840,7 +1840,7 @@ implementation
procedure ttai_typedconstbuilder.emit_procdef_const(pd: tprocdef);
begin
emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
emit_tai(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd,pc_address_only));
end;

20
compiler/arm/narmcnv.pas
View File

@ -32,27 +32,9 @@ interface
tarmtypeconvnode = class(tcgtypeconvnode)
protected
function first_int_to_real: tnode;override;
function first_real_to_real: tnode; override;
{ procedure second_int_to_int;override; }
{ procedure second_string_to_string;override; }
{ procedure second_cstring_to_pchar;override; }
{ procedure second_string_to_chararray;override; }
{ procedure second_array_to_pointer;override; }
// function first_int_to_real: tnode; override;
{ procedure second_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; }
function first_real_to_real: tnode;override;
procedure second_int_to_real;override;
// procedure second_real_to_real;override;
{ procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; }
{ procedure second_bool_to_int;override; }
procedure second_int_to_bool;override;
{ procedure second_load_smallset;override; }
{ procedure second_ansistring_to_pchar;override; }
{ procedure second_pchar_to_string;override; }
{ procedure second_class_to_intf;override; }
{ procedure second_char_to_char;override; }
end;
implementation

2
compiler/llvm/hlcgllvm.pas
View File

@ -567,7 +567,7 @@ implementation
{ if this is a complex procvar, get the non-tmethod-like equivalent }
if (pd.typ=procvardef) and
not pd.is_addressonly then
pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd));
pd:=tprocvardef(cprocvardef.getreusableprocaddr(pd,pc_address_only));
end;

22
compiler/llvm/llvmdef.pas
View File

@ -48,8 +48,8 @@ interface
tllvmprocdefdecltype = (lpd_def,lpd_decl,lpd_alias,lpd_procvar);
{ returns the identifier to use as typename for a def in llvm (llvm only
allows naming struct types) -- only supported for defs with a typesym, and
only for tabstractrecorddef descendantds and complex procvars }
allows naming struct types) -- only supported for tabstractrecorddef
descendantds and complex procvars }
function llvmtypeidentifier(def: tdef): TSymStr;
{ encode a type into the internal format used by LLVM (for a type
@ -130,9 +130,10 @@ implementation
function llvmtypeidentifier(def: tdef): TSymStr;
begin
if not assigned(def.typesym) then
internalerror(2015041901);
result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
if assigned(def.typesym) then
result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
else
result:='%"typ.'+def.fullownerhierarchyname(false)+def.unique_id_str+'"';
end;
@ -444,9 +445,7 @@ implementation
recorddef :
begin
{ avoid endlessly recursive definitions }
if assigned(def.typesym) and
((lef_inaggregate in flags) or
not(lef_typedecl in flags)) then
if not(lef_typedecl in flags) then
encodedstr:=encodedstr+llvmtypeidentifier(def)
else
llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr);
@ -537,9 +536,7 @@ implementation
if def.typ=procvardef then
encodedstr:=encodedstr+'*';
end
else if ((lef_inaggregate in flags) or
not(lef_typedecl in flags)) and
assigned(tprocvardef(def).typesym) then
else if not(lef_typedecl in flags) then
begin
{ in case the procvardef recursively references itself, e.g.
via a pointer }
@ -569,8 +566,7 @@ implementation
odt_object,
odt_cppclass:
begin
if not(lef_typedecl in flags) and
assigned(def.typesym) then
if not(lef_typedecl in flags) then
encodedstr:=encodedstr+llvmtypeidentifier(def)
else
llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr);

6
compiler/llvm/llvmtype.pas
View File

@ -574,8 +574,7 @@ implementation
symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
for i:=0 to symdeflist.Count-1 do
record_def(tllvmshadowsymtableentry(symdeflist[i]).def);
if assigned(def.typesym) then
list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
end;
@ -605,8 +604,7 @@ implementation
for i:=0 to def.paras.count-1 do
appenddef(list,llvmgetcgparadef(tparavarsym(def.paras[i]).paraloc[callerside],true,calleeside));
appenddef(list,llvmgetcgparadef(def.funcretloc[callerside],true,calleeside));
if assigned(def.typesym) and
not def.is_addressonly then
if not def.is_addressonly then
list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
end;

2
compiler/llvm/nllvmcnv.pas
View File

@ -229,7 +229,7 @@ procedure tllvmtypeconvnode.second_proc_to_procvar;
if location.loc<>LOC_REFERENCE then
internalerror(2015111902);
hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,'')),
cpointerdef.getreusable(cprocvardef.getreusableprocaddr(tprocdef(left.resultdef),pc_normal)),
cpointerdef.getreusable(resultdef),
location.reference);
end;

4
compiler/llvm/nllvmld.pas
View File

@ -92,7 +92,7 @@ procedure tllvmloadnode.pass_generate_code;
(resultdef.typ in [symconst.procdef,procvardef]) and
not tabstractprocdef(resultdef).is_addressonly then
begin
pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal,''));
pvdef:=cprocvardef.getreusableprocaddr(procdef,pc_normal);
{ on little endian, location.register contains proc and
location.registerhi contains self; on big endian, it's the
other way around }
@ -117,7 +117,7 @@ procedure tllvmloadnode.pass_generate_code;
selfdef:=cpointerdef.getreusable(left.resultdef);
mpref:=href;
hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(pvdef),cpointerdef.getreusable(methodpointertype),mpref);
hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef),trecorddef(methodpointertype),procreg,'proc',mpref);
hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef,pc_address_only),trecorddef(methodpointertype),procreg,'proc',mpref);
hlcg.g_load_reg_field_by_name(current_asmdata.CurrAsmList,selfdef,trecorddef(methodpointertype),selfreg,'self',mpref);
location_reset_ref(location,LOC_REFERENCE,location.size,href.alignment,href.volatility);
location.reference:=href;

6
compiler/llvm/nllvmtcon.pas
View File

@ -408,7 +408,7 @@ implementation
procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
begin
if not pvdef.is_addressonly then
pvdef:=cprocvardef.getreusableprocaddr(pvdef);
pvdef:=cprocvardef.getreusableprocaddr(pvdef,pc_address_only);
emit_tai(p,pvdef);
end;
@ -731,7 +731,7 @@ implementation
the procdef }
if (fromdef.typ=procdef) and
(todef.typ<>procdef) then
fromdef:=cprocvardef.getreusableprocaddr(tprocdef(fromdef));
fromdef:=cprocvardef.getreusableprocaddr(tprocdef(fromdef),pc_address_only);
{ typecasting a pointer-sized entity to a complex procvardef -> convert
to the pointer-component of the complex procvardef (not always, because
e.g. a tmethod to complex procvar initialises the entire complex
@ -739,7 +739,7 @@ implementation
if (todef.typ=procvardef) and
not tprocvardef(todef).is_addressonly and
(fromdef.size<todef.size) then
todef:=cprocvardef.getreusableprocaddr(tprocvardef(todef));
todef:=cprocvardef.getreusableprocaddr(tprocvardef(todef),pc_address_only);
op:=llvmconvop(fromdef,todef,false);
case op of
la_ptrtoint_to_x,

2
compiler/llvm/nllvmutil.pas
View File

@ -174,7 +174,7 @@ implementation
begin
pd:=tprocdef(procdefs[0]);
fields[0]:=s32inttype;
fields[1]:=pd.getcopyas(procvardef,pc_address_only,'');
fields[1]:=cprocvardef.getreusableprocaddr(pd,pc_address_only);
fields[2]:=voidpointertype;
itemdef:=llvmgettemprecorddef(fields,C_alignment,
targetinfos[target_info.system]^.alignment.recordalignmin);

4
compiler/ncgcal.pas
View File

@ -501,7 +501,7 @@ implementation
hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,cpointerdef.getreusable(literaldef),true);
{ load the invoke pointer }
hlcg.reference_reset_base(href,right.resultdef,right.location.register,0,ctempposinvalid,right.resultdef.alignment,[]);
callprocdef:=cprocvardef.getreusableprocaddr(procdefinition);
callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
toreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
hlcg.g_load_field_reg_by_name(current_asmdata.CurrAsmList,literaldef,callprocdef,'INVOKE',href,toreg);
end;
@ -851,7 +851,7 @@ implementation
of far calls where the procvardef was defined does not matter,
even though the procvardef constructor called by getcopyas looks at
it) }
callprocdef:=cprocvardef.getreusableprocaddr(procdefinition);
callprocdef:=cprocvardef.getreusableprocaddr(procdefinition,pc_address_only);
reg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,callprocdef);
{ 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

2
compiler/ncgcnv.pas
View File

@ -572,7 +572,7 @@ interface
begin
location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
{ code field is the first one }
hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,''))),cpointerdef.getreusable(resultdef),left.location.reference);
hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(cprocvardef.getreusableprocaddr(tprocdef(left.resultdef),pc_normal)),cpointerdef.getreusable(resultdef),left.location.reference);
hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
end;
LOC_REGISTER,LOC_CREGISTER:

4
compiler/ncgld.pas
View File

@ -646,8 +646,8 @@ implementation
begin
{ load address of the function }
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname,AT_FUNCTION),0,procdef.address_type.alignment,[]);
location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef));
hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,procdef,cprocvardef.getreusableprocaddr(procdef),href,location.register);
location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cprocvardef.getreusableprocaddr(procdef,pc_address_only));
hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,procdef,cprocvardef.getreusableprocaddr(procdef,pc_address_only),href,location.register);
end;
{ to get methodpointers stored correctly, code and self register must be swapped on

2
compiler/ncgrtti.pas
View File

@ -1385,7 +1385,7 @@ implementation
internalerror(201603021)
else
tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
cprocvardef.getreusableprocaddr(procdef));
cprocvardef.getreusableprocaddr(procdef,pc_address_only));
end;
end;

4
compiler/ncgvmt.pas
View File

@ -733,7 +733,7 @@ implementation
pd:=tprocdef(AImplIntf.procdefs[i]);
hs:=CreateWrapperName(_Class,AImplIntf,i,pd);
{ create reference }
datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd,pc_address_only));
end;
end
else
@ -992,7 +992,7 @@ implementation
if current_module.moduleid<>vmtpd.owner.moduleid then
current_module.addimportedsym(vmtpd.procsym);
end;
tcb.emit_tai(Tai_const.Createname(procname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(vmtpd));
tcb.emit_tai(Tai_const.Createname(procname,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(vmtpd,pc_address_only));
{$ifdef vtentry}
hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint));
current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0,voidpointerdef));

2
compiler/ncnv.pas
View File

@ -2339,7 +2339,7 @@ implementation
copytype:=pc_address_only
else
copytype:=pc_normal;
resultdef:=pd.getcopyas(procvardef,copytype,'');
resultdef:=cprocvardef.getreusableprocaddr(pd,copytype);
end;
end;

2
compiler/ngtcon.pas
View File

@ -1456,7 +1456,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
{ get the address of the procedure, except if it's a C-block (then we
we will end up with a record that represents the C-block) }
if not is_block(def) then
procaddrdef:=cprocvardef.getreusableprocaddr(def)
procaddrdef:=cprocvardef.getreusableprocaddr(def,pc_address_only)
else
procaddrdef:=def;
ftcb.queue_init(procaddrdef);

2
compiler/nobj.pas
View File

@ -889,7 +889,7 @@ implementation
{ now add the methods }
for i:=0 to _class.vmtentries.count-1 do
vmtdef.add_field_by_def('',
cprocvardef.getreusableprocaddr(pvmtentry(_class.vmtentries[i])^.procdef)
cprocvardef.getreusableprocaddr(pvmtentry(_class.vmtentries[i])^.procdef,pc_address_only)
);
{ the VMT ends with a nil pointer }
vmtdef.add_field_by_def('',voidcodepointertype);

4
compiler/psystem.pas
View File

@ -243,7 +243,9 @@ implementation
s64floattype:=cfloatdef.create(s64real,true);
s80floattype:=cfloatdef.create(s80real,true);
sc80floattype:=cfloatdef.create(sc80real,true);
end else begin
end
else
begin
s32floattype:=nil;
s64floattype:=nil;
s80floattype:=nil;

26
compiler/symdef.pas
View File

@ -640,15 +640,16 @@ interface
pno_mangledname, pno_noparams);
tprocnameoptions = set of tprocnameoption;
tproccopytyp = (pc_normal,
{ creates a procvardef describing only the code pointer
of a method/netsted function/... }
pc_address_only,
{ everything except for hidden parameters }
pc_normal_no_hidden,
{ always creates a top-level function, removes all
special parameters (self, vmt, parentfp, ...) }
pc_bareproc,
{ creates a procvardef describing only the code pointer
of a method/netsted function/... }
pc_address_only
pc_bareproc
);
tcacheableproccopytyp = pc_normal..pc_address_only;
tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type }
@ -703,7 +704,7 @@ interface
tprocvardef = class(tabstractprocdef)
constructor create(level:byte);virtual;
{ returns a procvardef that represents the address of a proc(var)def }
class function getreusableprocaddr(def: tabstractprocdef): tprocvardef; virtual;
class function getreusableprocaddr(def: tabstractprocdef; copytyp: tcacheableproccopytyp): tprocvardef; virtual;
{ same as above, but in case the def must never be freed after the
current module has been compiled -- even if the def was not written
to the ppu file (for defs in para locations, as we don't reset them
@ -6958,14 +6959,21 @@ implementation
end;
class function tprocvardef.getreusableprocaddr(def: tabstractprocdef): tprocvardef;
class function tprocvardef.getreusableprocaddr(def: tabstractprocdef; copytyp: tcacheableproccopytyp): tprocvardef;
var
res: PHashSetItem;
oldsymtablestack: tsymtablestack;
key: packed record
def: tabstractprocdef;
copytyp: tcacheableproccopytyp;
end;
begin
if not assigned(current_module) then
internalerror(2011081301);
res:=current_module.procaddrdefs.FindOrAdd(@def,sizeof(def));
key.def:=def;
key.copytyp:=copytyp;
res:=current_module.procaddrdefs.FindOrAdd(@key,sizeof(key));
if not assigned(res^.Data) then
begin
{ since these pointerdefs can be reused anywhere in the current
@ -6977,7 +6985,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,pc_address_only,''));
result:=tprocvardef(def.getcopyas(procvardef,copytyp,''));
setup_reusable_def(def,result,res,oldsymtablestack);
{ res^.Data may still be nil -> don't overwrite result }
exit;
@ -6988,7 +6996,7 @@ implementation
class function tprocvardef.getreusableprocaddr_no_free(def: tabstractprocdef): tprocvardef;
begin
result:=getreusableprocaddr(def);
result:=getreusableprocaddr(def,pc_address_only);
if not result.is_registered then
include(result.defoptions,df_not_registered_no_free);
end;