paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 14:10:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* handle typed constant definitions of variant records using different fields

Browse Source 
than the one we use to construct the LLVM equivalent (which doesn't support
    variants), or in case the complete record is not defined in the source and
    has to be padded with zeroes
   o we do this by creating a new recorddef in this case with as elements the
     defs of the actually emitted constant data, and replacing the original
     def with this new def; note that this can also replace arrays in case of,
     e.g., an array of a variant record type
   o the pass in llvmtype takes care of inserting type conversions (bitcasts)
     when these constants are accessed using the original def

git-svn-id: trunk@32719 -
This commit is contained in:
Jonas Maebe 2015-12-25 21:05:45 +00:00
parent 926e62c886
commit 99aaec5431
2 changed files with 123 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
compiler/llvm/nllvmtcon.pas
View File

@ -36,6 +36,13 @@ interface
private
faggai: tai_aggregatetypedconst;
fanonrecalignpos: longint;
{ if this is a non-anonymous record, keep track of the current field at
the llvm level that gets emitted, so we know when the data types of the
Pascal and llvm representation don't match up (because of variant
records, or because not all fields are defined at the Pascal level and
the rest is zeroed) }
fllvmnextfieldindex: longint;
fdoesnotmatchllvmdef: boolean;
public
constructor create(_def: tdef; _typ: ttypedconstkind); override;
@ -43,6 +50,8 @@ interface
property aggai: tai_aggregatetypedconst read faggai write faggai;
property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
property llvmnextfieldindex: longint read fllvmnextfieldindex write fllvmnextfieldindex;
property doesnotmatchllvmdef: boolean read fdoesnotmatchllvmdef write fdoesnotmatchllvmdef;
end;
tllvmtypedconstplaceholder = class(ttypedconstplaceholder)
@ -58,6 +67,8 @@ interface
{ set the default value for caggregateinformation (= tllvmaggregateinformation) }
class constructor classcreate;
protected
foverriding_def: tdef;
fqueued_tai,
flast_added_tai: tai;
fqueued_tai_opidx: longint;
@ -82,6 +93,11 @@ interface
function get_internal_data_section_internal_label: tasmlabel; override;
procedure do_emit_extended_in_aggregate(p: tai);
{ mark the current agginfo, and hence also all the ones higher up in ther
aggregate hierarchy, as not matching our canonical llvm definition for
their def }
procedure mark_aggregate_hierarchy_llvmdef_mismatch(new_current_level_def: trecorddef);
public
destructor destroy; override;
procedure emit_tai(p: tai; def: tdef); override;
@ -107,7 +123,7 @@ implementation
verbose,systems,
aasmdata,
cpubase,cpuinfo,llvmbase,
symbase,symtable,llvmdef,defutil;
symbase,symtable,llvmdef,defutil,defcmp;
{ tllvmaggregateinformation }
@ -115,6 +131,7 @@ implementation
begin
inherited;
fanonrecalignpos:=-1;
fllvmnextfieldindex:=0;
end;
@ -164,6 +181,8 @@ implementation
decl: taillvmdecl;
begin
newasmlist:=tasmlist.create;
if assigned(foverriding_def) then
def:=foverriding_def;
{ llvm declaration with as initialisation data all the elements from the
original asmlist }
decl:=taillvmdecl.createdef(sym,def,fasmlist,section,alignment);
@ -269,7 +288,22 @@ implementation
internalerror(2014052906);
end;
if assigned(info) then
info.aggai.addvalue(stc)
begin
{ are we emitting data that does not match the equivalent data in
the llvm structure? If so, record this so that we know we have to
use a custom recorddef to emit this data }
if not(info.anonrecord) and
(info.def.typ<>procvardef) and
(aggregate_kind(info.def)=tck_record) then
begin
if not info.doesnotmatchllvmdef and
(info.llvmnextfieldindex<tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.symdeflist.count) and
not equal_defs(def,tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.entries_by_llvm_index[info.llvmnextfieldindex].def) then
info.doesnotmatchllvmdef:=true;
info.llvmnextfieldindex:=info.llvmnextfieldindex+1;
end;
info.aggai.addvalue(stc);
end
else
inherited do_emit_tai(stc,def);
end;
@ -301,11 +335,44 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.maybe_emit_tail_padding(def: tdef);
var
info: tllvmaggregateinformation;
constdata: tai_abstracttypedconst;
newdef: trecorddef;
begin
{ in case we let LLVM align, don't add padding ourselves }
if df_llvm_no_struct_packing in def.defoptions then
exit;
inherited;
{ we can only check here whether the aggregate does not match our
cononical llvm definition, as the tail padding may cause a mismatch
(in case not all fields have been defined), and we can't do it inside
end_aggregate_internal as its inherited method (which calls this
method) frees curagginfo before it returns }
info:=tllvmaggregateinformation(curagginfo);
if info.doesnotmatchllvmdef then
begin
{ create a new recorddef representing this mismatched def; this can
even replace an array in case it contains e.g. variant records }
case info.def.typ of
arraydef:
{ in an array, all elements come right after each other ->
replace with a packed record }
newdef:=crecorddef.create_global_internal('',1,1,1);
recorddef,
objectdef:
newdef:=crecorddef.create_global_internal('',
tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignment,
tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).recordalignmin,
tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).maxCrecordalign);
else
internalerror(2015122401);
end;
for constdata in tai_aggregatetypedconst(info.aggai) do
newdef.add_field_by_def('',constdata.def);
tai_aggregatetypedconst(info.aggai).changetorecord(newdef);
mark_aggregate_hierarchy_llvmdef_mismatch(newdef);
end;
end;
@ -397,15 +464,31 @@ implementation
procedure tllvmtai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
var
info: tllvmaggregateinformation;
was_aggregate: boolean;
begin
was_aggregate:=false;
if aggregate_kind(def)<>tck_simple then
begin
was_aggregate:=true;
info:=tllvmaggregateinformation(curagginfo);
if not assigned(info) then
internalerror(2014060101);
info.aggai.finish;
end;
inherited;
info:=tllvmaggregateinformation(curagginfo);
if assigned(info) and
was_aggregate then
begin
{ are we emitting data that does not match the equivalent data in
the llvm structure? If so, record this so that we know we have to
use a custom recorddef to emit this data }
if not info.anonrecord and
(aggregate_kind(info.def)=tck_record) and
not equal_defs(def,tabstractrecordsymtable(tabstractrecorddef(info.def).symtable).llvmst.entries_by_llvm_index[info.llvmnextfieldindex].def) then
info.doesnotmatchllvmdef:=true;
info.llvmnextfieldindex:=info.llvmnextfieldindex+1;
end;
end;
@ -455,6 +538,30 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.mark_aggregate_hierarchy_llvmdef_mismatch(new_current_level_def: trecorddef);
var
aggregate_level,
i: longint;
info: tllvmaggregateinformation;
begin
if assigned(faggregateinformation) then
begin
aggregate_level:=faggregateinformation.count;
{ the top element, at aggregate_level-1, is already marked, since
that's why we are marking the rest }
for i:=aggregate_level-2 downto 0 do
begin
info:=tllvmaggregateinformation(faggregateinformation[i]);
if info.doesnotmatchllvmdef then
break;
info.doesnotmatchllvmdef:=true;
end;
if aggregate_level=1 then
foverriding_def:=new_current_level_def;
end;
end;
procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
begin
inherited;

16
compiler/symtable.pas
View File

@ -157,13 +157,19 @@ interface
curroffset: aint;
recordalignmin: shortint;
function get(f: tfieldvarsym): tllvmshadowsymtableentry;
function get_by_llvm_index(index: longint): tllvmshadowsymtableentry;
public
symdeflist: TFPObjectList;
constructor create(st: tabstractrecordsymtable);
destructor destroy; override;
property items[index: tfieldvarsym]: tllvmshadowsymtableentry read get; default;
property entries[index: tfieldvarsym]: tllvmshadowsymtableentry read get; default;
{ warning: do not call this with field.llvmfieldnr, as
field.llvmfieldnr will only be initialised when the llvm shadow
symtable is accessed for the first time. Use the default/entries
property instead in this case }
property entries_by_llvm_index[index: longint]: tllvmshadowsymtableentry read get_by_llvm_index;
private
// generate the table
procedure generate;
@ -1795,10 +1801,16 @@ implementation
function tllvmshadowsymtable.get(f: tfieldvarsym): tllvmshadowsymtableentry;
begin
result:=tllvmshadowsymtableentry(symdeflist[f.llvmfieldnr])
result:=get_by_llvm_index(f.llvmfieldnr)
end;
function tllvmshadowsymtable.get_by_llvm_index(index: longint): tllvmshadowsymtableentry;
begin
result:=tllvmshadowsymtableentry(symdeflist[index]);
end;
constructor tllvmshadowsymtable.create(st: tabstractrecordsymtable);
begin
equivst:=st;