From e2cf90ad8ae7d674a4858e9ddb2655df8a504fe7 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 19 Apr 2015 21:37:46 +0000 Subject: [PATCH] * add type declarations for structure types in the llvm code so that we can handle recursive record references (rec= record prec: ^rec) o llvm unfortunately does not support recursive references to array types or function pointers, so those will currently still result in endless recursion when the compiler tries to write them out. Solving those will require a lot of typecasting in the generated code git-svn-id: trunk@30675 - --- .gitattributes | 1 + compiler/llvm/agllvm.pas | 15 +- compiler/llvm/llvmdef.pas | 114 +++++++---- compiler/llvm/llvmtype.pas | 378 ++++++++++++++++++++++++++++++++++++ compiler/llvm/nllvmtcon.pas | 2 +- compiler/llvm/nllvmutil.pas | 17 +- 6 files changed, 487 insertions(+), 40 deletions(-) create mode 100644 compiler/llvm/llvmtype.pas diff --git a/.gitattributes b/.gitattributes index 0fb7c3b341..efb2f02ef2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -358,6 +358,7 @@ compiler/llvm/llvmnode.pas svneol=native#text/plain compiler/llvm/llvmpara.pas svneol=native#text/plain compiler/llvm/llvmsym.pas svneol=native#text/plain compiler/llvm/llvmtarg.pas svneol=native#text/plain +compiler/llvm/llvmtype.pas svneol=native#text/plain compiler/llvm/nllvmadd.pas svneol=native#text/plain compiler/llvm/nllvmcal.pas svneol=native#text/plain compiler/llvm/nllvmcnv.pas svneol=native#text/plain diff --git a/compiler/llvm/agllvm.pas b/compiler/llvm/agllvm.pas index da90b576b3..b6eb0dc421 100644 --- a/compiler/llvm/agllvm.pas +++ b/compiler/llvm/agllvm.pas @@ -198,7 +198,7 @@ implementation if i<>0 then result:=result+', '; para:=pllvmcallpara(o.paras[i]); - result:=result+llvmencodetype(para^.def); + result:=result+llvmencodetypename(para^.def); if para^.valueext<>lve_none then result:=result+llvmvalueextension2str[para^.valueext]; case para^.loc of @@ -283,7 +283,7 @@ implementation getopstr:=getreferencestring(o.ref^,refwithalign); top_def: begin - getopstr:=llvmencodetype(o.def); + getopstr:=llvmencodetypename(o.def); end; top_cond: begin @@ -355,6 +355,13 @@ implementation opstart:=0; nested:=false; case op of + la_type: + begin + owner.asmwrite(llvmtypeidentifier(taillvm(hp).oper[0]^.def)); + owner.asmwrite(' = type '); + owner.asmwrite(llvmencodetypedecl(taillvm(hp).oper[0]^.def)); + done:=true; + end; la_ret, la_br, la_switch, la_indirectbr, la_invoke, la_resume, la_unreachable, @@ -670,7 +677,7 @@ implementation defstr: TSymStr; first, gotstring: boolean; begin - defstr:=llvmencodetype(hp.def); + defstr:=llvmencodetypename(hp.def); { write the struct, array or simple type } case hp.adetyp of tck_record: @@ -898,7 +905,7 @@ implementation asmwrite('global '); if not assigned(taillvmdecl(hp).initdata) then begin - asmwrite(llvmencodetype(taillvmdecl(hp).def)); + asmwrite(llvmencodetypename(taillvmdecl(hp).def)); if not(taillvmdecl(hp).namesym.bind in [AB_EXTERNAL, AB_WEAK_EXTERNAL]) then asmwrite(' zeroinitializer'); end diff --git a/compiler/llvm/llvmdef.pas b/compiler/llvm/llvmdef.pas index 9822da497d..4f3f448c95 100644 --- a/compiler/llvm/llvmdef.pas +++ b/compiler/llvm/llvmdef.pas @@ -40,19 +40,23 @@ interface b) alias declaration of a procdef implemented in the current module c) defining a procvar type The main differences between the contexts are: - a) information about sign extension of result type, proc name, parameter names & types - b) no information about sign extension of result type, proc name, no parameter names, parameter types - c) information about sign extension of result type, no proc name, no parameter names, parameter types + a) information about sign extension of result type, proc name, parameter names & sign-extension info & types + b) no information about sign extension of result type, proc name, no parameter names, information about sign extension of parameters, parameter types + c) no information about sign extension of result type, no proc name, no parameter names, no information about sign extension of parameters, parameter types } tllvmprocdefdecltype = (lpd_decl,lpd_alias,lpd_procvar); - { Encode a type into the internal format used by LLVM. } - function llvmencodetype(def: tdef): TSymStr; + { 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 } + function llvmtypeidentifier(def: tdef): TSymStr; - { incremental version of llvmencodetype(). "inaggregate" indicates whether - this was a recursive call to get the type of an entity part of an - aggregate type (array, record, ...) } - procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr); + { encode a type into the internal format used by LLVM (for a type + declaration) } + function llvmencodetypedecl(def: tdef): TSymStr; + + { same as above, but use a type name if possible (for any use) } + function llvmencodetypename(def: tdef): TSymStr; { encode a procdef/procvardef into the internal format used by LLVM } function llvmencodeproctype(def: tabstractprocdef; const customname: TSymStr; pddecltype: tllvmprocdefdecltype): TSymStr; @@ -120,6 +124,14 @@ implementation Type encoding *******************************************************************} + function llvmtypeidentifier(def: tdef): TSymStr; + begin + if not assigned(def.typesym) then + internalerror(2015041901); + result:='%"typ.'+def.fullownerhierarchyname+'.'+def.typesym.realname+'"' + end; + + function llvmaggregatetype(def: tdef): boolean; begin result:= @@ -239,9 +251,13 @@ implementation end; - procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward; + procedure llvmaddencodedabstractrecordtype(def: tabstractrecorddef; var encodedstr: TSymStr); forward; - procedure llvmaddencodedtype_intern(def: tdef; inaggregate, noimplicitderef: boolean; var encodedstr: TSymStr); + type + tllvmencodeflag = (lef_inaggregate, lef_noimplicitderef, lef_typedecl); + tllvmencodeflags = set of tllvmencodeflag; + + procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr); begin case def.typ of stringdef : @@ -287,7 +303,7 @@ implementation encodedstr:=encodedstr+'i8*' else begin - llvmaddencodedtype_intern(tpointerdef(def).pointeddef,inaggregate,false,encodedstr); + llvmaddencodedtype_intern(tpointerdef(def).pointeddef,[],encodedstr); encodedstr:=encodedstr+'*'; end; end; @@ -302,7 +318,7 @@ implementation s80real: { prevent llvm from allocating the standard ABI size for extended } - if inaggregate then + if lef_inaggregate in flags then encodedstr:=encodedstr+'[10 x i8]' else encodedstr:=encodedstr+'x86_fp80'; @@ -325,21 +341,27 @@ implementation begin case tfiledef(def).filetyp of ft_text : - llvmaddencodedtype_intern(search_system_type('TEXTREC').typedef,inaggregate,false,encodedstr); + llvmaddencodedtype_intern(search_system_type('TEXTREC').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr); ft_typed, ft_untyped : - llvmaddencodedtype_intern(search_system_type('FILEREC').typedef,inaggregate,false,encodedstr); + llvmaddencodedtype_intern(search_system_type('FILEREC').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr); else internalerror(2013100203); end; end; recorddef : begin - llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr); + { avoid endlessly recursive definitions } + if assigned(def.typesym) and + ((lef_inaggregate in flags) or + not(lef_typedecl in flags)) then + encodedstr:=encodedstr+llvmtypeidentifier(def) + else + llvmaddencodedabstractrecordtype(trecorddef(def),encodedstr); end; variantdef : begin - llvmaddencodedtype_intern(search_system_type('TVARDATA').typedef,inaggregate,false,encodedstr); + llvmaddencodedtype_intern(search_system_type('TVARDATA').typedef,[lef_inaggregate]+[lef_typedecl]*flags,encodedstr); end; classrefdef : begin @@ -352,7 +374,7 @@ implementation array of i1" or so, this requires special support in backends and guarantees nothing about the internal format } if is_smallset(def) then - llvmaddencodedtype_intern(cgsize_orddef(def_cgsize(def)),inaggregate,false,encodedstr) + llvmaddencodedtype_intern(cgsize_orddef(def_cgsize(def)),[lef_inaggregate],encodedstr) else encodedstr:=encodedstr+'['+tostr(tsetdef(def).size)+' x i8]'; end; @@ -367,18 +389,18 @@ implementation if is_array_of_const(def) then begin encodedstr:=encodedstr+'[0 x '; - llvmaddencodedtype_intern(search_system_type('TVARREC').typedef,true,false,encodedstr); + llvmaddencodedtype_intern(search_system_type('TVARREC').typedef,[lef_inaggregate],encodedstr); encodedstr:=encodedstr+']'; end else if is_open_array(def) then begin encodedstr:=encodedstr+'[0 x '; - llvmaddencodedtype_intern(tarraydef(def).elementdef,true,false,encodedstr); + llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr); encodedstr:=encodedstr+']'; end else if is_dynamic_array(def) then begin - llvmaddencodedtype_intern(tarraydef(def).elementdef,inaggregate,false,encodedstr); + llvmaddencodedtype_intern(tarraydef(def).elementdef,[],encodedstr); encodedstr:=encodedstr+'*'; end else if is_packed_array(def) then @@ -386,13 +408,13 @@ implementation encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div tarraydef(def).elementdef.packedbitsize)+' x '; { encode as an array of integers with the size on which we perform the packedbits operations } - llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(packedbitsloadsize(tarraydef(def).elementdef.packedbitsize))),true,false,encodedstr); + llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(packedbitsloadsize(tarraydef(def).elementdef.packedbitsize))),[lef_inaggregate],encodedstr); encodedstr:=encodedstr+']'; end else begin encodedstr:=encodedstr+'['+tostr(tarraydef(def).elecount)+' x '; - llvmaddencodedtype_intern(tarraydef(def).elementdef,true,false,encodedstr); + llvmaddencodedtype_intern(tarraydef(def).elementdef,[lef_inaggregate],encodedstr); encodedstr:=encodedstr+']'; end; end; @@ -406,6 +428,14 @@ 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 + begin + { in case the procvardef recursively references itself, e.g. + via a pointer } + encodedstr:=encodedstr+llvmtypeidentifier(def) + end else begin encodedstr:=encodedstr+'{'; @@ -423,9 +453,12 @@ implementation odt_object, odt_cppclass: begin - { for now don't handle fields yet } - encodedstr:=encodedstr+'{[i8 x '+tostr(def.size)+']}'; - if not noimplicitderef and + if not(lef_typedecl in flags) and + assigned(def.typesym) then + encodedstr:=encodedstr+llvmtypeidentifier(def) + else + llvmaddencodedabstractrecordtype(tabstractrecorddef(def),encodedstr); + if ([lef_typedecl,lef_noimplicitderef]*flags=[]) and is_implicit_pointer_object_type(def) then encodedstr:=encodedstr+'*' end; @@ -451,9 +484,22 @@ implementation end; - procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr); + function llvmencodetypename(def: tdef): TSymStr; begin - llvmaddencodedtype_intern(def,inaggregate,false,encodedstr); + result:=''; + llvmaddencodedtype_intern(def,[],result); + end; + + + procedure llvmaddencodedtype(def: tdef; inaggregate: boolean; var encodedstr: TSymStr); + var + flags: tllvmencodeflags; + begin + if inaggregate then + flags:=[lef_inaggregate] + else + flags:=[]; + llvmaddencodedtype_intern(def,flags,encodedstr); end; @@ -479,14 +525,14 @@ implementation { insert the struct for the class rather than a pointer to the struct } if (tllvmshadowsymtableentry(symdeflist[0]).def.typ<>objectdef) then internalerror(2008070601); - llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[0]).def,true,true,encodedstr); + llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[0]).def,[lef_inaggregate,lef_noimplicitderef],encodedstr); inc(i); end; while i0 then encodedstr:=encodedstr+', '; - llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[i]).def,true,false,encodedstr); + llvmaddencodedtype_intern(tllvmshadowsymtableentry(symdeflist[i]).def,[lef_inaggregate],encodedstr); inc(i); end; end; @@ -540,7 +586,7 @@ implementation encodedstr:=encodedstr+', ' else first:=false; - llvmaddencodedtype(usedef,false,encodedstr); + llvmaddencodedtype_intern(usedef,[lef_inaggregate],encodedstr); { in case signextstr<>'', there should be only one paraloc -> no need to clear (reason: it means that the paraloc is larger than the original parameter) } @@ -598,7 +644,7 @@ implementation if pddecltype in [lpd_decl] then encodedstr:=encodedstr+llvmvalueextension2str[signext]; encodedstr:=encodedstr+' '; - llvmaddencodedtype_intern(usedef,false,false,encodedstr); + llvmaddencodedtype_intern(usedef,[lef_inaggregate],encodedstr); end else begin @@ -723,10 +769,10 @@ implementation end; - function llvmencodetype(def: tdef): TSymStr; + function llvmencodetypedecl(def: tdef): TSymStr; begin result:=''; - llvmaddencodedtype(def,false,result); + llvmaddencodedtype_intern(def,[lef_typedecl],result); end; diff --git a/compiler/llvm/llvmtype.pas b/compiler/llvm/llvmtype.pas new file mode 100644 index 0000000000..179a6c2478 --- /dev/null +++ b/compiler/llvm/llvmtype.pas @@ -0,0 +1,378 @@ +{ + 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, + finput, + dbgbase; + + + { TLLVMTypeInfo } + type + TLLVMTypeInfo = class(TDebugInfo) + protected + 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_variant(list:TAsmList;def: tvariantdef);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 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); + + public + constructor Create;override; + destructor Destroy;override; + procedure inserttypeinfo;override; + end; + +implementation + + uses + sysutils,cutils,cfileutl,constexp, + version,globals,verbose,systems, + cpubase,cgbase,paramgr, + fmodule,nobj, + defutil,symconst,symtable, + llvmbase, aasmllvm, aasmcnst; + +{**************************************************************************** + TDebugInfoDwarf +****************************************************************************} + + + function TLLVMTypeInfo.record_def(def:tdef): tdef; + begin + result:=def; + if def.dbg_state<>dbg_state_unused then + exit; + def.dbg_state:=dbg_state_used; + deftowritelist.Add(def); + defnumberlist.Add(def); + end; + + + constructor TLLVMTypeInfo.Create; + begin + inherited Create; + end; + + + destructor TLLVMTypeInfo.Destroy; + begin + 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)); + end; + end; + + + procedure TLLVMTypeInfo.process_llvmins(deftypelist: tasmlist; p: tai); + var + opidx, paraidx: longint; + callpara: pllvmcallpara; + begin + for opidx:=0 to taillvm(p).ops-1 do + case taillvm(p).oper[opidx]^.typ of + top_def: + appenddef(deftypelist,taillvm(p).oper[opidx]^.def); + top_tai: + process_tai(deftypelist,taillvm(p).oper[opidx]^.ai); + top_para: + for paraidx:=0 to taillvm(p).oper[opidx]^.paras.count-1 do + begin + callpara:=pllvmcallpara(taillvm(p).oper[opidx]^.paras[paraidx]); + appenddef(deftypelist,callpara^.def); + end; + end; + end; + + + procedure TLLVMTypeInfo.process_tai(deftypelist: tasmlist; p: tai); + begin + case p.typ of + ait_llvmalias: + appenddef(deftypelist,taillvmalias(p).def); + ait_llvmdecl: + appenddef(deftypelist,taillvmdecl(p).def); + ait_llvmins: + process_llvmins(deftypelist,p); + ait_typedconst: + appenddef(deftypelist,tai_abstracttypedconst(p).def); + end; + end; + + + procedure TLLVMTypeInfo.process_asmlist(deftypelist, asmlist: tasmlist); + var + hp: tai; + begin + if not assigned(asmlist) then + exit; + hp:=tai(asmlist.first); + while assigned(hp) do + begin + process_tai(deftypelist,hp); + 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 + appenddef(list,tllvmshadowsymtableentry(symdeflist[i]).def); + if assigned(def.typesym) then + 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 } + for i:=0 to def.paras.count-1 do + appenddef(list,tparavarsym(def.paras[i]).vardef); + appenddef(list,def.returndef); + if assigned(def.typesym) and + 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.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(200610052); + dbg_state_unused: + internalerror(200610053); + 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 + storefilepos:=current_filepos; + current_filepos:=current_module.mainfilepos; + + defnumberlist:=TFPObjectList.create(false); + deftowritelist:=TFPObjectList.create(false); + + { write all global/static variables, part of flaggin 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 + process_asmlist(current_asmdata.asmlists[al_start],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]); + if assigned(def) then + begin + def.dbg_state:=dbg_state_unused; + end; + end; + + defnumberlist.free; + defnumberlist:=nil; + deftowritelist.free; + deftowritelist:=nil; + + current_filepos:=storefilepos; + end; + + + procedure TLLVMTypeInfo.appenddef_object(list:TAsmList;def: tobjectdef); + begin + appenddef_abstractrecord(list,def); + end; + + + procedure TLLVMTypeInfo.appenddef_variant(list:TAsmList;def: tvariantdef); + begin + appenddef(list,tabstractrecorddef(search_system_type('TVARDATA').typedef)); + end; + +end. diff --git a/compiler/llvm/nllvmtcon.pas b/compiler/llvm/nllvmtcon.pas index 25e8c849cf..179b64c8cf 100644 --- a/compiler/llvm/nllvmtcon.pas +++ b/compiler/llvm/nllvmtcon.pas @@ -136,7 +136,7 @@ implementation this typed const? -> insert type conversion } if not assigned(fqueued_tai) and (resdef<>fqueued_def) and - (llvmencodetype(resdef)<>llvmencodetype(fqueued_def)) then + (llvmencodetypename(resdef)<>llvmencodetypename(fqueued_def)) then queue_typeconvn(resdef,fqueued_def); if assigned(fqueued_tai) then begin diff --git a/compiler/llvm/nllvmutil.pas b/compiler/llvm/nllvmutil.pas index d7657931cd..2b7d7fbb2c 100644 --- a/compiler/llvm/nllvmutil.pas +++ b/compiler/llvm/nllvmutil.pas @@ -42,6 +42,7 @@ interface class procedure InsertResourceTablesTable; override; class procedure InsertResourceInfo(ResourcesUsed : boolean); override; class procedure InsertMemorySizes; override; + class procedure InsertObjectInfo; override; end; @@ -50,7 +51,8 @@ implementation uses verbose,cutils,globals,fmodule, aasmbase,aasmtai,cpubase,llvmbase,aasmllvm, - symbase,symtable,defutil; + symbase,symtable,defutil, + llvmtype; class procedure tllvmnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); var @@ -103,6 +105,19 @@ implementation end; + class procedure tllvmnodeutils.InsertObjectInfo; + begin + inherited; + + { add "type xx = .." statements for all used recorddefs } + with TLLVMTypeInfo.Create do + begin + inserttypeinfo; + free; + end; + end; + + begin cnodeutils:=tllvmnodeutils; end.