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

* add type declarations for structure types in the llvm code so that we can

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2015-04-19 21:37:46 +00:00
parent 1941e64488
commit e2cf90ad8a
6 changed files with 487 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

15
compiler/llvm/agllvm.pas
View File

@ -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

114
compiler/llvm/llvmdef.pas
View File

@ -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 i<symdeflist.count do
begin
if i<>0 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;

378
compiler/llvm/llvmtype.pas Normal file
View File

@ -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.

2
compiler/llvm/nllvmtcon.pas
View File

@ -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

17
compiler/llvm/nllvmutil.pas
View File

@ -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.