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

* insert type conversions in case a symbol is declared via 'external' as an

Browse Source 
alias for another symbol with a different type (such as
    FPC_ANSISTR_UNIQUE, which is defined as a function and referenced as a
    procedure)

git-svn-id: trunk@30781 -
This commit is contained in:
Jonas Maebe 2015-05-03 16:51:02 +00:00
parent 65bcfdc42d
commit 74da8720c5
1 changed files with 217 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

237
compiler/llvm/llvmtype.pas
View File

@ -35,6 +35,7 @@ interface
cclasses,globtype,
aasmbase,aasmtai,aasmdata,
symbase,symtype,symdef,symsym,
aasmllvm,aasmcnst,
finput,
dbgbase;
@ -43,6 +44,19 @@ interface
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;
procedure record_asmsym_def(sym: TAsmSymbol; def: tdef);
function get_asmsym_def(sym: TAsmSymbol): tdef;
function record_def(def:tdef): tdef;
procedure appenddef_array(list:TAsmList;def:tarraydef);override;
@ -64,9 +78,14 @@ interface
procedure enum_membersyms_callback(p:TObject;arg:pointer);
procedure process_llvmins(deftypelist: tasmlist; p: tai);
procedure process_tai(deftypelist: tasmlist; p: tai);
procedure process_asmlist(deftypelist, asmlist: tasmlist);
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(p: taillvm);
procedure insert_typedconst_typeconversion(p: tai_abstracttypedconst);
procedure insert_tai_typeconversions(p: tai);
procedure insert_asmlist_typeconversions(list: tasmlist);
public
constructor Create;override;
@ -81,13 +100,38 @@ implementation
version,globals,verbose,systems,
cpubase,cgbase,paramgr,
fmodule,nobj,
defutil,symconst,symtable,
llvmbase, aasmllvm, aasmcnst;
defutil,defcmp,symconst,symtable,
llvmbase,llvmdef
;
{****************************************************************************
TDebugInfoDwarf
****************************************************************************}
procedure TLLVMTypeInfo.record_asmsym_def(sym: TAsmSymbol; def: tdef);
var
res: PHashSetItem;
begin
res:=asmsymtypes.FindOrAdd(@sym,sizeof(sym));
{ if there are multiple definitions of the same symbol, we're in
trouble anyway, so don't bother checking whether data is already
assigned }
res^.Data:=def;
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;
begin
@ -103,11 +147,13 @@ implementation
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;
@ -120,44 +166,49 @@ implementation
end;
end;
procedure TLLVMTypeInfo.process_llvmins(deftypelist: tasmlist; p: tai);
procedure TLLVMTypeInfo.collect_llvmins_info(deftypelist: tasmlist; p: taillvm);
var
opidx, paraidx: longint;
callpara: pllvmcallpara;
begin
for opidx:=0 to taillvm(p).ops-1 do
case taillvm(p).oper[opidx]^.typ of
for opidx:=0 to p.ops-1 do
case p.oper[opidx]^.typ of
top_def:
appenddef(deftypelist,taillvm(p).oper[opidx]^.def);
appenddef(deftypelist,p.oper[opidx]^.def);
top_tai:
process_tai(deftypelist,taillvm(p).oper[opidx]^.ai);
collect_tai_info(deftypelist,p.oper[opidx]^.ai);
top_para:
for paraidx:=0 to taillvm(p).oper[opidx]^.paras.count-1 do
for paraidx:=0 to p.oper[opidx]^.paras.count-1 do
begin
callpara:=pllvmcallpara(taillvm(p).oper[opidx]^.paras[paraidx]);
callpara:=pllvmcallpara(p.oper[opidx]^.paras[paraidx]);
appenddef(deftypelist,callpara^.def);
end;
end;
end;
procedure TLLVMTypeInfo.process_tai(deftypelist: tasmlist; p: tai);
procedure TLLVMTypeInfo.collect_tai_info(deftypelist: tasmlist; p: tai);
begin
case p.typ of
ait_llvmalias:
appenddef(deftypelist,taillvmalias(p).def);
begin
appenddef(deftypelist,taillvmalias(p).def);
record_asmsym_def(taillvmalias(p).newsym,taillvmalias(p).def);
end;
ait_llvmdecl:
appenddef(deftypelist,taillvmdecl(p).def);
begin
appenddef(deftypelist,taillvmdecl(p).def);
record_asmsym_def(taillvmdecl(p).namesym,taillvmdecl(p).def);
end;
ait_llvmins:
process_llvmins(deftypelist,p);
collect_llvmins_info(deftypelist,taillvm(p));
ait_typedconst:
appenddef(deftypelist,tai_abstracttypedconst(p).def);
end;
end;
procedure TLLVMTypeInfo.process_asmlist(deftypelist, asmlist: tasmlist);
procedure TLLVMTypeInfo.collect_asmlist_info(deftypelist, asmlist: tasmlist);
var
hp: tai;
begin
@ -166,7 +217,149 @@ implementation
hp:=tai(asmlist.first);
while assigned(hp) do
begin
process_tai(deftypelist,hp);
collect_tai_info(deftypelist,hp);
hp:=tai(hp.next);
end;
end;
function equal_llvm_defs(def1, def2: tdef): boolean;
var
def1str, def2str: TSymStr;
begin
if def1=def2 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;
procedure TLLVMTypeInfo.insert_llvmins_typeconversions(p: taillvm);
var
symdef,
opdef: tdef;
cnv: taillvm;
i: longint;
begin
case p.llvmopcode of
la_call:
if p.oper[3]^.typ=top_ref then
begin
symdef:=get_asmsym_def(p.oper[3]^.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[0]^.def) then
begin
if symdef.typ=procdef then
{ ugly, but can't use getcopyas(procvardef) due to the
symtablestack not being available here (getpointerdef
is hardcoded to put things in the current module's
symtable) and "pointer to procedure" results in the
correct llvm type }
symdef:=getpointerdef(tprocdef(symdef));
cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[3]^.ref^.symbol,p.oper[0]^.def);
p.loadtai(3,cnv);
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
(p.oper[i]^.ref^.symbol.bind<>AB_TEMP) then
begin
symdef:=get_asmsym_def(p.oper[i]^.ref^.symbol);
opdef:=p.spilling_get_reg_type(i);
if not equal_llvm_defs(symdef,opdef) then
begin
cnv:=taillvm.op_reg_size_sym_size(la_bitcast,NR_NO,symdef,p.oper[i]^.ref^.symbol,opdef);
p.loadtai(i,cnv);
end;
end;
top_tai:
insert_tai_typeconversions(p.oper[i]^.ai);
end;
end;
end;
end;
procedure TLLVMTypeInfo.insert_typedconst_typeconversion(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
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:=getpointerdef(symdef);
if not equal_llvm_defs(symdef,p.def) then
begin
cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(tck_simple,symdef,tai_simpletypedconst(p).val),p.def);
tai_simpletypedconst(p).val:=cnv;
end;
end;
else
insert_tai_typeconversions(tai_const(tai_simpletypedconst(p).val));
end;
end;
tck_array,
tck_record:
begin
for elementp in tai_aggregatetypedconst(p) do
insert_typedconst_typeconversion(elementp);
end;
end;
end;
procedure TLLVMTypeInfo.insert_tai_typeconversions(p: tai);
begin
case p.typ of
ait_llvmins:
insert_llvmins_typeconversions(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(tai_abstracttypedconst(p));
ait_llvmdecl:
insert_asmlist_typeconversions(taillvmdecl(p).initdata);
end;
end;
procedure TLLVMTypeInfo.insert_asmlist_typeconversions(list: tasmlist);
var
hp: tai;
begin
if not assigned(list) then
exit;
hp:=tai(list.first);
while assigned(hp) do
begin
insert_tai_typeconversions(hp);
hp:=tai(hp.next);
end;
end;
@ -340,7 +533,11 @@ implementation
{ process all llvm instructions, part of flagging all required tdefs }
for hal:=low(TasmlistType) to high(TasmlistType) do
if hal<>al_start then
process_asmlist(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
collect_asmlist_info(current_asmdata.asmlists[al_start],current_asmdata.asmlists[hal]);
for hal:=low(TasmlistType) to high(TasmlistType) do
if hal<>al_start then
insert_asmlist_typeconversions(current_asmdata.asmlists[hal]);
{ write all used defs }
write_defs_to_write;