mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 05:58:02 +02:00

Will be the default starting with LLVM 15, and required with LLVM 16. Tested with LLVM 14 and '-mllvm -opaque-pointers'. See https://releases.llvm.org/14.0.0/docs/OpaquePointers.html for more information.
818 lines
29 KiB
ObjectPascal
818 lines
29 KiB
ObjectPascal
{
|
|
Copyright (c) 2008,2015 by Peter Vreman, Florian Klaempfl and Jonas Maebe
|
|
|
|
This units contains support for generating LLVM type info
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
{
|
|
This units contains support for LLVM type info generation.
|
|
|
|
It's based on the debug info system, since it's quite similar
|
|
}
|
|
unit llvmtype;
|
|
|
|
{$i fpcdefs.inc}
|
|
{$h+}
|
|
|
|
interface
|
|
|
|
uses
|
|
cclasses,globtype,
|
|
aasmbase,aasmtai,aasmdata,
|
|
symbase,symtype,symdef,symsym,
|
|
aasmllvm,aasmcnst,
|
|
finput,
|
|
dbgbase;
|
|
|
|
|
|
{ TLLVMTypeInfo }
|
|
type
|
|
TLLVMTypeInfo = class(TDebugInfo)
|
|
protected
|
|
{ using alias/external declarations it's possible to refer to the same
|
|
assembler symbol using multiple types:
|
|
function f(p: pointer): pointer; [public, alias: 'FPC_FUNC'];
|
|
procedure test(p: pointer); external name 'FPC_FUNC';
|
|
|
|
We have to insert the appropriate typecasts (per module) for LLVM in
|
|
this case. That can only be done after all code for a module has been
|
|
generated, as these alias declarations can appear anywhere }
|
|
asmsymtypes: THashSet;
|
|
|
|
function check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
|
|
procedure record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
|
|
function get_asmsym_def(sym: TAsmSymbol): tdef;
|
|
|
|
function record_def(def:tdef): tdef;
|
|
|
|
procedure appenddef_array(list:TAsmList;def:tarraydef);override;
|
|
procedure appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
|
|
procedure appenddef_record(list:TAsmList;def:trecorddef);override;
|
|
procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override;
|
|
procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
|
|
procedure appendprocdef(list:TAsmList;def:tprocdef);override;
|
|
procedure appenddef_object(list:TAsmList;def: tobjectdef);override;
|
|
procedure appenddef_classref(list: TAsmList; def: tclassrefdef);override;
|
|
procedure appenddef_variant(list:TAsmList;def: tvariantdef);override;
|
|
procedure appenddef_file(list:TasmList;def:tfiledef);override;
|
|
|
|
procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
|
|
procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
|
|
procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
|
|
procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override;
|
|
procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override;
|
|
procedure appendsym_const(list:TAsmList;sym:tconstsym);override;
|
|
procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override;
|
|
|
|
procedure afterappenddef(list: TAsmList; def: tdef); override;
|
|
|
|
procedure enum_membersyms_callback(p:TObject;arg:pointer);
|
|
|
|
procedure collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
|
|
procedure collect_tai_info(deftypelist: tasmlist; p: tai);
|
|
procedure collect_asmlist_info(deftypelist, asmlist: tasmlist);
|
|
|
|
procedure insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
|
|
procedure insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
|
|
procedure insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
|
|
procedure insert_asmlist_typeconversions(toplevellist, list: tasmlist);
|
|
procedure maybe_insert_extern_sym_decl(toplevellist: tasmlist; asmsym: tasmsymbol; def: tdef);
|
|
procedure update_asmlist_alias_types(list: tasmlist);
|
|
|
|
public
|
|
constructor Create;override;
|
|
destructor Destroy;override;
|
|
procedure inserttypeinfo;override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
cutils,cfileutl,constexp,
|
|
version,globals,verbose,systems,
|
|
cpubase,cgbase,paramgr,
|
|
fmodule,nobj,
|
|
defutil,defcmp,symconst,symtable,
|
|
llvminfo,llvmbase,llvmdef
|
|
;
|
|
|
|
{****************************************************************************
|
|
TLLVMTypeInfo
|
|
****************************************************************************}
|
|
|
|
procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef; redefine: boolean);
|
|
var
|
|
res: PHashSetItem;
|
|
begin
|
|
record_def(def);
|
|
res:=asmsymtypes.FindOrAdd(@sym,sizeof(sym));
|
|
{ due to internal aliases with different signatures, we may end up with
|
|
multiple defs for the same symbol -> use the one from the declaration,
|
|
and insert typecasts as necessary elsewhere }
|
|
if redefine or
|
|
not assigned(res^.Data) then
|
|
res^.Data:=def;
|
|
end;
|
|
|
|
|
|
function equal_llvm_defs(def1, def2: tdef): boolean;
|
|
var
|
|
def1str, def2str: TSymStr;
|
|
begin
|
|
if def1=def2 then
|
|
exit(true);
|
|
{ this function is only used to the pointees of pointer types, to know
|
|
whether the pointer types are equal. With opaque pointers, all
|
|
pointers are represented by "ptr" and hence by definition equal,
|
|
regardless of what they point to (there is one exception related to
|
|
arrays, but that is already handled during code generation in
|
|
thlcgllvm.g_ptrtypecast_ref) }
|
|
if (llvmflag_opaque_ptr in llvmversion_properties[current_settings.llvmversion]) then
|
|
exit(true);
|
|
def1str:=llvmencodetypename(def1);
|
|
def2str:=llvmencodetypename(def2);
|
|
{ normalise both type representations in case one is a procdef
|
|
and the other is a procvardef}
|
|
if def1.typ=procdef then
|
|
def1str:=def1str+'*';
|
|
if def2.typ=procdef then
|
|
def2str:=def2str+'*';
|
|
result:=def1str=def2str;
|
|
end;
|
|
|
|
|
|
function TLLVMTypeInfo.check_insert_bitcast(toplevellist: tasmlist; sym: tasmsymbol; const opdef: tdef): taillvm;
|
|
var
|
|
opcmpdef: tdef;
|
|
symdef: tdef;
|
|
begin
|
|
result:=nil;
|
|
case opdef.typ of
|
|
pointerdef:
|
|
opcmpdef:=tpointerdef(opdef).pointeddef;
|
|
procvardef,
|
|
procdef:
|
|
opcmpdef:=opdef;
|
|
else
|
|
internalerror(2015073101);
|
|
end;
|
|
maybe_insert_extern_sym_decl(toplevellist, sym, opcmpdef);
|
|
symdef:=get_asmsym_def(sym);
|
|
if not equal_llvm_defs(symdef, opcmpdef) then
|
|
begin
|
|
if symdef.typ=procdef then
|
|
symdef:=cpointerdef.getreusable(symdef);
|
|
result:=taillvm.op_reg_size_sym_size(la_bitcast, NR_NO, cpointerdef.getreusable(symdef), sym, opdef);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TLLVMTypeInfo.get_asmsym_def(sym: TAsmSymbol): tdef;
|
|
var
|
|
res: PHashSetItem;
|
|
begin
|
|
res:=asmsymtypes.Find(@sym,sizeof(sym));
|
|
{ we must have a def for every used asmsym }
|
|
if not assigned(res) or
|
|
not assigned(res^.data) then
|
|
internalerror(2015042701);
|
|
result:=tdef(res^.Data);
|
|
end;
|
|
|
|
|
|
function TLLVMTypeInfo.record_def(def:tdef): tdef;
|
|
var
|
|
i: longint;
|
|
begin
|
|
result:=def;
|
|
if def.stab_number<>0 then
|
|
exit;
|
|
{ the external symbol may never be called, in which case the types
|
|
of its parameters will never be process -> do it here }
|
|
if (def.typ=procdef) then
|
|
begin
|
|
{ can't use this condition to determine whether or not we need
|
|
to generate the argument defs, because this information does
|
|
not get reset when multiple units are compiled during a
|
|
single compiler invocation }
|
|
tprocdef(def).init_paraloc_info(callerside);
|
|
for i:=0 to tprocdef(def).paras.count-1 do
|
|
record_def(llvmgetcgparadef(tparavarsym(tprocdef(def).paras[i]).paraloc[callerside],true,calleeside));
|
|
record_def(llvmgetcgparadef(tprocdef(def).funcretloc[callerside],true,calleeside));
|
|
end;
|
|
def.stab_number:=1;
|
|
{ this is an internal llvm type }
|
|
if def=llvm_metadatatype then
|
|
exit;
|
|
if def.dbg_state=dbg_state_unused then
|
|
begin
|
|
def.dbg_state:=dbg_state_used;
|
|
deftowritelist.Add(def);
|
|
end;
|
|
defnumberlist.Add(def);
|
|
end;
|
|
|
|
|
|
constructor TLLVMTypeInfo.Create;
|
|
begin
|
|
inherited Create;
|
|
asmsymtypes:=THashSet.Create(current_asmdata.AsmSymbolDict.Count,true,false);
|
|
end;
|
|
|
|
|
|
destructor TLLVMTypeInfo.Destroy;
|
|
begin
|
|
asmsymtypes.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.enum_membersyms_callback(p:TObject; arg: pointer);
|
|
begin
|
|
case tsym(p).typ of
|
|
fieldvarsym:
|
|
appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p));
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
|
|
var
|
|
opidx, paraidx: longint;
|
|
callpara: pllvmcallpara;
|
|
begin
|
|
for opidx:=0 to p.ops-1 do
|
|
case p.oper[opidx]^.typ of
|
|
top_def:
|
|
record_def(p.oper[opidx]^.def);
|
|
top_tai:
|
|
collect_tai_info(deftypelist,p.oper[opidx]^.ai);
|
|
top_ref:
|
|
begin
|
|
if (p.llvmopcode<>la_br) and
|
|
assigned(p.oper[opidx]^.ref^.symbol) and
|
|
(p.oper[opidx]^.ref^.symbol.bind<>AB_TEMP) then
|
|
begin
|
|
if (opidx=4) and
|
|
(p.llvmopcode in [la_call,la_invoke]) then
|
|
record_asmsym_def(p.oper[opidx]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef,false)
|
|
{ not a named register }
|
|
else if (p.oper[opidx]^.ref^.refaddr<>addr_full) then
|
|
record_asmsym_def(p.oper[opidx]^.ref^.symbol,p.spilling_get_reg_type(opidx),false);
|
|
end;
|
|
end;
|
|
top_para:
|
|
for paraidx:=0 to p.oper[opidx]^.paras.count-1 do
|
|
begin
|
|
callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
|
|
record_def(callpara^.def);
|
|
if callpara^.val.typ=top_tai then
|
|
collect_tai_info(deftypelist,callpara^.val.ai);
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.collect_tai_info(deftypelist: tasmlist; p: tai);
|
|
var
|
|
value: tai_abstracttypedconst;
|
|
begin
|
|
if not assigned(p) then
|
|
exit;
|
|
case p.typ of
|
|
ait_llvmalias:
|
|
begin
|
|
record_asmsym_def(taillvmalias(p).newsym,taillvmalias(p).def,true);
|
|
end;
|
|
ait_llvmdecl:
|
|
begin
|
|
record_asmsym_def(taillvmdecl(p).namesym,taillvmdecl(p).def,true);
|
|
collect_asmlist_info(deftypelist,taillvmdecl(p).initdata);
|
|
end;
|
|
ait_llvmins:
|
|
collect_llvmins_info(deftypelist,taillvm(p));
|
|
ait_typedconst:
|
|
begin
|
|
record_def(tai_abstracttypedconst(p).def);
|
|
case tai_abstracttypedconst(p).adetyp of
|
|
tck_simple:
|
|
collect_tai_info(deftypelist,tai_simpletypedconst(p).val);
|
|
tck_array,tck_record:
|
|
for value in tai_aggregatetypedconst(p) do
|
|
collect_tai_info(deftypelist,value);
|
|
end;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.collect_asmlist_info(deftypelist, asmlist: tasmlist);
|
|
var
|
|
hp: tai;
|
|
begin
|
|
if not assigned(asmlist) then
|
|
exit;
|
|
hp:=tai(asmlist.first);
|
|
while assigned(hp) do
|
|
begin
|
|
collect_tai_info(deftypelist,hp);
|
|
hp:=tai(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.insert_llvmins_typeconversions(toplevellist: tasmlist; p: taillvm);
|
|
var
|
|
symdef,
|
|
opdef: tdef;
|
|
callpara: pllvmcallpara;
|
|
cnv: taillvm;
|
|
i, paraidx: longint;
|
|
begin
|
|
case p.llvmopcode of
|
|
la_call,
|
|
la_invoke:
|
|
begin
|
|
if p.oper[4]^.typ=top_ref then
|
|
begin
|
|
maybe_insert_extern_sym_decl(toplevellist,p.oper[4]^.ref^.symbol,tpointerdef(p.oper[3]^.def).pointeddef);
|
|
symdef:=get_asmsym_def(p.oper[4]^.ref^.symbol);
|
|
{ the type used in the call is different from the type used to
|
|
declare the symbol -> insert a typecast }
|
|
if not equal_llvm_defs(symdef,p.oper[3]^.def) then
|
|
begin
|
|
if symdef.typ=procdef then
|
|
{ ugly, but can't use getcopyas(procvardef) due to the
|
|
symtablestack not being available here (cpointerdef.getreusable
|
|
is hardcoded to put things in the current module's
|
|
symtable) and "pointer to procedure" results in the
|
|
correct llvm type }
|
|
symdef:=cpointerdef.getreusable(tprocdef(symdef));
|
|
cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[4]^.ref^.symbol,p.oper[3]^.def);
|
|
p.loadtai(4,cnv);
|
|
end;
|
|
end;
|
|
for i:=0 to p.ops-1 do
|
|
begin
|
|
if p.oper[i]^.typ=top_para then
|
|
begin
|
|
for paraidx:=0 to p.oper[i]^.paras.count-1 do
|
|
begin
|
|
callpara:=pllvmcallpara(p.oper[i]^.paras[paraidx]);
|
|
case callpara^.val.typ of
|
|
top_tai:
|
|
insert_tai_typeconversions(toplevellist,callpara^.val.ai);
|
|
top_ref:
|
|
begin
|
|
cnv:=check_insert_bitcast(toplevellist,callpara^.val.sym,callpara^.def);
|
|
if assigned(cnv) then
|
|
begin
|
|
callpara^.loadtai(cnv);
|
|
end;
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else if p.llvmopcode<>la_br then
|
|
begin
|
|
{ check the types of all symbolic operands }
|
|
for i:=0 to p.ops-1 do
|
|
case p.oper[i]^.typ of
|
|
top_ref:
|
|
if (p.oper[i]^.ref^.refaddr<>addr_full) and
|
|
assigned(p.oper[i]^.ref^.symbol) and
|
|
(p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
|
|
begin
|
|
opdef:=p.spilling_get_reg_type(i);
|
|
cnv:=check_insert_bitcast(toplevellist,p.oper[i]^.ref^.symbol, opdef);
|
|
if assigned(cnv) then
|
|
p.loadtai(i, cnv);
|
|
end;
|
|
top_tai:
|
|
insert_tai_typeconversions(toplevellist,p.oper[i]^.ai);
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.insert_typedconst_typeconversion(toplevellist: tasmlist; p: tai_abstracttypedconst);
|
|
var
|
|
symdef: tdef;
|
|
cnv: taillvm;
|
|
elementp: tai_abstracttypedconst;
|
|
begin
|
|
case p.adetyp of
|
|
tck_simple:
|
|
begin
|
|
case tai_simpletypedconst(p).val.typ of
|
|
ait_const:
|
|
if assigned(tai_const(tai_simpletypedconst(p).val).sym) and
|
|
not assigned(tai_const(tai_simpletypedconst(p).val).endsym) then
|
|
begin
|
|
maybe_insert_extern_sym_decl(toplevellist,tai_const(tai_simpletypedconst(p).val).sym,p.def);
|
|
symdef:=get_asmsym_def(tai_const(tai_simpletypedconst(p).val).sym);
|
|
{ all references to symbols in typed constants are
|
|
references to the address of a global symbol (you can't
|
|
refer to the data itself, just like you can't initialise
|
|
a Pascal (typed) constant with the contents of another
|
|
typed constant) }
|
|
symdef:=cpointerdef.getreusable(symdef);
|
|
if not equal_llvm_defs(symdef,p.def) then
|
|
begin
|
|
cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(symdef,tai_simpletypedconst(p).val),p.def);
|
|
tai_simpletypedconst(p).val:=cnv;
|
|
end;
|
|
end;
|
|
else
|
|
insert_tai_typeconversions(toplevellist,tai_simpletypedconst(p).val);
|
|
end;
|
|
end;
|
|
tck_array,
|
|
tck_record:
|
|
begin
|
|
for elementp in tai_aggregatetypedconst(p) do
|
|
insert_typedconst_typeconversion(toplevellist,elementp);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.insert_tai_typeconversions(toplevellist: tasmlist; p: tai);
|
|
begin
|
|
if not assigned(p) then
|
|
exit;
|
|
case p.typ of
|
|
ait_llvmins:
|
|
insert_llvmins_typeconversions(toplevellist,taillvm(p));
|
|
{ can also be necessary in case someone initialises a typed const with
|
|
the address of an external symbol aliasing one declared with a
|
|
different type in the same mmodule. }
|
|
ait_typedconst:
|
|
insert_typedconst_typeconversion(toplevellist,tai_abstracttypedconst(p));
|
|
ait_llvmdecl:
|
|
begin
|
|
if (ldf_definition in taillvmdecl(p).flags) and
|
|
(taillvmdecl(p).def.typ=procdef) and
|
|
assigned(tprocdef(taillvmdecl(p).def).personality) then
|
|
maybe_insert_extern_sym_decl(toplevellist,
|
|
current_asmdata.RefAsmSymbol(tprocdef(taillvmdecl(p).def).personality.mangledname,AT_FUNCTION,false),
|
|
tprocdef(taillvmdecl(p).def).personality);
|
|
insert_asmlist_typeconversions(toplevellist,taillvmdecl(p).initdata);
|
|
end;
|
|
else
|
|
;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.insert_asmlist_typeconversions(toplevellist, list: tasmlist);
|
|
var
|
|
hp: tai;
|
|
begin
|
|
if not assigned(list) then
|
|
exit;
|
|
hp:=tai(list.first);
|
|
while assigned(hp) do
|
|
begin
|
|
insert_tai_typeconversions(toplevellist,hp);
|
|
hp:=tai(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.maybe_insert_extern_sym_decl(toplevellist: tasmlist; asmsym: tasmsymbol; def: tdef);
|
|
var
|
|
sec: tasmsectiontype;
|
|
i: longint;
|
|
begin
|
|
{ Necessery for "external" declarations for symbols not declared in the
|
|
current unit. We can't create these declarations when the alias is
|
|
initially generated, because the symbol may still be defined later at
|
|
that point.
|
|
|
|
We also do it for all other external symbol references (e.g.
|
|
references to symbols declared in other units), because then this
|
|
handling is centralised in one place. }
|
|
if not(asmsym.declared) then
|
|
begin
|
|
if def.typ=procdef then
|
|
sec:=sec_code
|
|
else
|
|
sec:=sec_data;
|
|
toplevellist.Concat(taillvmdecl.createdecl(asmsym,nil,def,nil,sec,def.alignment));
|
|
record_asmsym_def(asmsym,def,true);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.update_asmlist_alias_types(list: tasmlist);
|
|
var
|
|
hp: tai;
|
|
def: tdef;
|
|
begin
|
|
if not assigned(list) then
|
|
exit;
|
|
hp:=tai(list.first);
|
|
while assigned(hp) do
|
|
begin
|
|
case hp.typ of
|
|
ait_llvmalias:
|
|
begin
|
|
{ replace the def of the alias declaration with the def of
|
|
the aliased symbol -> we'll insert the appropriate type
|
|
conversions for all uses of this symbol in the code (since
|
|
every use also specifies the used type) }
|
|
record_asmsym_def(taillvmalias(hp).oldsym,taillvmalias(hp).def,false);
|
|
def:=get_asmsym_def(taillvmalias(hp).oldsym);
|
|
if taillvmalias(hp).def<>def then
|
|
begin
|
|
taillvmalias(hp).def:=def;
|
|
record_asmsym_def(taillvmalias(hp).newsym,def,true);
|
|
end;
|
|
end;
|
|
ait_llvmdecl:
|
|
update_asmlist_alias_types(taillvmdecl(hp).initdata);
|
|
else
|
|
;
|
|
end;
|
|
hp:=tai(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_array(list:TAsmList;def:tarraydef);
|
|
begin
|
|
appenddef(list,def.elementdef);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_abstractrecord(list:TAsmList;def:tabstractrecorddef);
|
|
var
|
|
symdeflist: tfpobjectlist;
|
|
i: longint;
|
|
begin
|
|
symdeflist:=tabstractrecordsymtable(def.symtable).llvmst.symdeflist;
|
|
for i:=0 to symdeflist.Count-1 do
|
|
record_def(tllvmshadowsymtableentry(symdeflist[i]).def);
|
|
list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_record(list:TAsmList;def:trecorddef);
|
|
begin
|
|
appenddef_abstractrecord(list,def);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_pointer(list:TAsmList;def:tpointerdef);
|
|
begin
|
|
appenddef(list,def.pointeddef);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_procvar(list:TAsmList;def:tprocvardef);
|
|
var
|
|
i: longint;
|
|
begin
|
|
{ todo: handle mantis #25551; there is no way to create a symbolic
|
|
la_type for a procvardef (unless it's a procedure of object/record),
|
|
which means that recursive references should become plain "procedure"
|
|
types that are then casted to the real type when they are used }
|
|
def.init_paraloc_info(callerside);
|
|
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 not def.is_addressonly then
|
|
list.concat(taillvm.op_size(LA_TYPE,record_def(def)));
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendprocdef(list:TAsmList;def:tprocdef);
|
|
begin
|
|
{ the procdef itself is already written by appendprocdef_implicit }
|
|
|
|
{ last write the types from this procdef }
|
|
if assigned(def.parast) then
|
|
write_symtable_defs(current_asmdata.asmlists[al_start],def.parast);
|
|
if assigned(def.localst) and
|
|
(def.localst.symtabletype=localsymtable) then
|
|
write_symtable_defs(current_asmdata.asmlists[al_start],def.localst);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
|
|
begin
|
|
appenddef(list,sym.vardef);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);
|
|
begin
|
|
appendsym_var(list,sym);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_localvar(list:TAsmList;sym:tlocalvarsym);
|
|
begin
|
|
appendsym_var(list,sym);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_paravar(list:TAsmList;sym:tparavarsym);
|
|
begin
|
|
appendsym_var(list,sym);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
|
|
begin
|
|
appenddef(list,sym.vardef);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_const(list:TAsmList;sym:tconstsym);
|
|
begin
|
|
appenddef(list,sym.constdef);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);
|
|
begin
|
|
appenddef(list,sym.vardef);
|
|
end;
|
|
|
|
procedure TLLVMTypeInfo.afterappenddef(list: TAsmList; def: tdef);
|
|
begin
|
|
record_def(def);
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.inserttypeinfo;
|
|
|
|
procedure write_defs_to_write;
|
|
var
|
|
n : integer;
|
|
looplist,
|
|
templist: TFPObjectList;
|
|
def : tdef;
|
|
begin
|
|
templist := TFPObjectList.Create(False);
|
|
looplist := deftowritelist;
|
|
while looplist.count > 0 do
|
|
begin
|
|
deftowritelist := templist;
|
|
for n := 0 to looplist.count - 1 do
|
|
begin
|
|
def := tdef(looplist[n]);
|
|
case def.dbg_state of
|
|
dbg_state_written:
|
|
continue;
|
|
dbg_state_writing:
|
|
internalerror(2006100501);
|
|
dbg_state_unused:
|
|
internalerror(2006100505);
|
|
dbg_state_used:
|
|
appenddef(current_asmdata.asmlists[al_start],def)
|
|
else
|
|
internalerror(200610054);
|
|
end;
|
|
end;
|
|
looplist.clear;
|
|
templist := looplist;
|
|
looplist := deftowritelist;
|
|
end;
|
|
templist.free;
|
|
end;
|
|
|
|
|
|
var
|
|
storefilepos: tfileposinfo;
|
|
def: tdef;
|
|
i: longint;
|
|
hal: tasmlisttype;
|
|
begin
|
|
if cs_no_regalloc in current_settings.globalswitches then
|
|
exit;
|
|
storefilepos:=current_filepos;
|
|
current_filepos:=current_module.mainfilepos;
|
|
|
|
defnumberlist:=TFPObjectList.create(false);
|
|
deftowritelist:=TFPObjectList.create(false);
|
|
|
|
{ write all global/static variables, part of flagging all required tdefs }
|
|
if assigned(current_module.globalsymtable) then
|
|
write_symtable_syms(current_asmdata.asmlists[al_start],current_module.globalsymtable);
|
|
if assigned(current_module.localsymtable) then
|
|
write_symtable_syms(current_asmdata.asmlists[al_start],current_module.localsymtable);
|
|
|
|
{ write all procedures and methods, part of flagging all required tdefs }
|
|
if assigned(current_module.globalsymtable) then
|
|
write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.globalsymtable);
|
|
if assigned(current_module.localsymtable) then
|
|
write_symtable_procdefs(current_asmdata.asmlists[al_start],current_module.localsymtable);
|
|
|
|
{ process all llvm instructions, part of flagging all required tdefs }
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
if hal<>al_start then
|
|
collect_asmlist_info(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
|
|
|
|
{ update the defs of all alias declarations so they match those of the
|
|
declarations of the symbols they alias }
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
if hal<>al_start then
|
|
update_asmlist_alias_types(current_asmdata.asmlists[hal]);
|
|
|
|
{ and insert the necessary type conversions }
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
if hal<>al_start then
|
|
insert_asmlist_typeconversions(
|
|
current_asmdata.asmlists[hal],
|
|
current_asmdata.asmlists[hal]);
|
|
|
|
{ write all used defs }
|
|
write_defs_to_write;
|
|
|
|
{ reset all def labels }
|
|
for i:=0 to defnumberlist.count-1 do
|
|
begin
|
|
def:=tdef(defnumberlist[i]);
|
|
def.dbg_state:=dbg_state_unused;
|
|
def.stab_number:=0;
|
|
end;
|
|
|
|
defnumberlist.free;
|
|
defnumberlist:=nil;
|
|
deftowritelist.free;
|
|
deftowritelist:=nil;
|
|
|
|
current_filepos:=storefilepos;
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_object(list:TAsmList;def: tobjectdef);
|
|
begin
|
|
if is_interface(def) then
|
|
begin
|
|
record_def(def.vmt_def);
|
|
end
|
|
else
|
|
appenddef_abstractrecord(list,def);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_classref(list: TAsmList; def: tclassrefdef);
|
|
begin
|
|
{ can also be an objcclass, which doesn't have a vmt }
|
|
if is_class(tclassrefdef(def).pointeddef) then
|
|
record_def(tobjectdef(tclassrefdef(def).pointeddef).vmt_def);
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_variant(list:TAsmList;def: tvariantdef);
|
|
begin
|
|
appenddef(list,tabstractrecorddef(search_system_type('TVARDATA').typedef));
|
|
end;
|
|
|
|
|
|
procedure TLLVMTypeInfo.appenddef_file(list: TasmList; def: tfiledef);
|
|
begin
|
|
case tfiledef(def).filetyp of
|
|
ft_text :
|
|
appenddef(list,tabstractrecorddef(search_system_type('TEXTREC').typedef));
|
|
ft_typed,
|
|
ft_untyped :
|
|
appenddef(list,tabstractrecorddef(search_system_type('FILEREC').typedef));
|
|
end;
|
|
end;
|
|
|
|
end.
|