From 74da8720c55f630494f418223f2c4dafe7773cb5 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 3 May 2015 16:51:02 +0000 Subject: [PATCH] * insert type conversions in case a symbol is declared via 'external' as an 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 - --- compiler/llvm/llvmtype.pas | 237 +++++++++++++++++++++++++++++++++---- 1 file changed, 217 insertions(+), 20 deletions(-) diff --git a/compiler/llvm/llvmtype.pas b/compiler/llvm/llvmtype.pas index 179a6c2478..42b71b505c 100644 --- a/compiler/llvm/llvmtype.pas +++ b/compiler/llvm/llvmtype.pas @@ -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;