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

* fixed adding padding bytes before anonymous records: the alignment of such

Browse Source 
records is only known once we have completely parsed all of their data
    (the alignment of a record depends on the alignment requirements of its
     field with the largest alignment) -> only insert the padding bytes after
    completely parsing them

git-svn-id: branches/hlcgllvm@28765 -
This commit is contained in:
Jonas Maebe 2014-10-06 20:53:51 +00:00
parent 5a9b931e5c
commit 76e0ee7a41
2 changed files with 258 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

319
compiler/aasmcnst.pas
View File

@ -88,6 +88,8 @@ type
constructor create(_adetyp: ttypedconstkind; _fdef: tdef);
function getenumerator: tadeenumerator;
procedure addvalue(val: tai_abstracttypedconst);
function valuecount: longint;
procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
procedure finish;
destructor destroy; override;
end;
@ -141,7 +143,11 @@ type
property curindex: longint read fcurindex write fcurindex;
property nextindex: longint read fnextindex write fnextindex;
public
constructor create(_def: tdef; _typ: ttypedconstkind);
constructor create(_def: tdef; _typ: ttypedconstkind); virtual;
{ calculated padding bytes for alignment if needed, and add the def of the
next field in case we are constructing an anonymous record }
function prepare_next_field(nextfielddef: tdef): asizeint;
property def: tdef read fdef;
property typ: ttypedconstkind read ftyp;
property curfield: tfieldvarsym read fcurfield write fcurfield;
@ -158,15 +164,8 @@ type
{ class type to use when creating new aggregate information instances }
protected class var
caggregateinformation: taggregateinformationclass;
public
{ set the default value for caggregateinformation (= taggregateinformation) }
class constructor classcreate;
private
function getcurragginfo: taggregateinformation;
{ add padding bytes for alignment if needed, and add the def of the next
field in case we are constructing an anonymous record }
procedure prepare_next_field(nextfielddef: tdef);
procedure set_next_field(AValue: tfieldvarsym);
protected
{ temporary list in which all data is collected }
@ -192,6 +191,10 @@ type
bytes etc (by calling this one) }
procedure do_emit_tai(p: tai; def: tdef); virtual;
{ calls prepare_next_field() and adds the padding bytes in the current
location }
procedure pad_next_field(nextfielddef: tdef);
{ easy access to the top level aggregate information instance }
property curagginfo: taggregateinformation read getcurragginfo;
public
@ -208,6 +211,14 @@ type
protected
function emit_string_const_common(list: TAsmList; stringtype: tstringtype; len: asizeint; encoding: tstringencoding; out startlab: tasmlabel):tasmlabofs;
procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
{ when building an anonymous record, we cannot immediately insert the
alignment before it in case it's nested, since we only know the required
alignment once all fields have been inserted -> mark the location before
the anonymous record, and insert the alignment once it's finished }
procedure mark_anon_aggregate_alignment; virtual; abstract;
procedure insert_marked_aggregate_alignment(def: tdef); virtual; abstract;
public
class function get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
{ class functions and an extra list parameter, because emitting the data
@ -220,10 +231,10 @@ type
that consists of multiple tai constant data entries, or that
represents an aggregate at the Pascal level (a record, a non-dynamic
array, ... }
procedure maybe_begin_aggregate(def: tdef); virtual;
procedure maybe_begin_aggregate(def: tdef);
{ end a potential aggregate type. Must be paired with every
maybe_begin_aggregate }
procedure maybe_end_aggregate(def: tdef); virtual;
procedure maybe_end_aggregate(def: tdef);
{ similar as above, but in case
a) it's definitely a record
b) the def of the record should be automatically constructed based on
@ -284,6 +295,22 @@ type
end;
ttai_typedconstbuilderclass = class of ttai_typedconstbuilder;
tlowlevelaggregateinformation = class(taggregateinformation)
protected
fanonrecmarker: tai;
public
property anonrecmarker: tai read fanonrecmarker write fanonrecmarker;
end;
ttai_lowleveltypedconstbuilder = class(ttai_typedconstbuilder)
protected
procedure mark_anon_aggregate_alignment; override;
procedure insert_marked_aggregate_alignment(def: tdef); override;
public
{ set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
class constructor classcreate;
end;
var
ctai_typedconstbuilder: ttai_typedconstbuilderclass;
@ -331,6 +358,45 @@ implementation
end;
function taggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
var
currentoffset,nextoffset: asizeint;
i: longint;
begin
{ get the next field and its offset, and make that next field the current
one }
if assigned(nextfield) then
begin
nextoffset:=nextfield.fieldoffset;
currentoffset:=curoffset;
curfield:=nextfield;
end
else
begin
{ must set nextfield for unions and objects, as we cannot
automatically detect the "next" field in that case }
if ((def.typ=recorddef) and
trecorddef(def).isunion) or
is_object(def) then
internalerror(2014091202);
{ if we are constructing this record as data gets emitted, add a field
for this data }
if anonrecord then
trecorddef(def).add_field_by_def(nextfielddef);
{ find next field }
i:=curindex;
repeat
inc(i);
until tsym(tabstractrecorddef(def).symtable.symlist[i]).typ=fieldvarsym;
nextoffset:=fieldoffset[i];
currentoffset:=curoffset;
curindex:=i;
end;
{ need padding? }
result:=nextoffset-currentoffset;
end;
{****************************************************************************
tai_abstracttypedconst
****************************************************************************}
@ -490,6 +556,18 @@ implementation
end;
function tai_aggregatetypedconst.valuecount: longint;
begin
result:=fvalues.count;
end;
procedure tai_aggregatetypedconst.insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
begin
fvalues.insert(pos,val);
end;
procedure tai_aggregatetypedconst.finish;
begin
if fisstring then
@ -537,60 +615,19 @@ implementation
end;
procedure ttai_typedconstbuilder.prepare_next_field(nextfielddef: tdef);
procedure ttai_typedconstbuilder.pad_next_field(nextfielddef: tdef);
var
nextoffset: asizeint;
curoffset: asizeint;
info: taggregateinformation;
i: longint;
fillbytes: asizeint;
begin
info:=curagginfo;
if not assigned(info) then
internalerror(2014091002);
{ current offset in the data }
curoffset:=info.curoffset;
{ get the next field and its offset, and make that next field the current
one }
if assigned(info.nextfield) then
begin
nextoffset:=info.nextfield.fieldoffset;
info.curfield:=info.nextfield;
end
else
begin
{ must set nextfield for unions and objects, as we cannot
automatically detect the "next" field in that case }
if ((info.def.typ=recorddef) and
trecorddef(info.def).isunion) or
is_object(info.def) then
internalerror(2014091202);
{ if we are constructing this record as data gets emitted, add a field
for this data }
if info.anonrecord then
trecorddef(info.def).add_field_by_def(nextfielddef);
{ find next field }
i:=info.curindex;
repeat
inc(i);
until tsym(tabstractrecorddef(info.def).symtable.symlist[i]).typ=fieldvarsym;
nextoffset:=info.fieldoffset[i];
info.curindex:=i;
end;
{ need padding? }
while curoffset<nextoffset do
fillbytes:=curagginfo.prepare_next_field(nextfielddef);
while fillbytes>0 do
begin
do_emit_tai(tai_const.create_8bit(0),u8inttype);
inc(curoffset);
dec(fillbytes);
end;
end;
class constructor ttai_typedconstbuilder.classcreate;
begin
caggregateinformation:=taggregateinformation;
end;
function ttai_typedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
begin
if (def.typ in [recorddef,filedef,variantdef]) or
@ -741,7 +778,7 @@ implementation
is_object(info.def)) and
{ may add support for these later }
not is_packed_record_or_object(info.def) then
prepare_next_field(def);
pad_next_field(def);
end;
{ emit the data }
do_emit_tai(p,def);
@ -808,6 +845,70 @@ implementation
end;
procedure ttai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
var
info: taggregateinformation;
tck: ttypedconstkind;
begin
tck:=aggregate_kind(def);
if tck=tck_simple then
exit;
if not assigned(faggregateinformation) then
faggregateinformation:=tfpobjectlist.create
{ if we're starting an anonymous record, we can't align it yet because
the alignment depends on the fields that will be added -> we'll do
it at the end }
else if not anonymous then
begin
{ add padding if necessary, and update the current field/offset }
info:=curagginfo;
if is_record(curagginfo.def) or
is_object(curagginfo.def) then
pad_next_field(def);
end
{ if this is the outer record, no padding is required; the alignment
has to be specified explicitly in that case via get_final_asmlist() }
else if assigned(curagginfo) and
(curagginfo.def.typ=recorddef) then
{ mark where we'll have to insert the padding bytes at the end }
mark_anon_aggregate_alignment;
info:=caggregateinformation.create(def,aggregate_kind(def));
faggregateinformation.add(info);
end;
procedure ttai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
var
info: taggregateinformation;
fillbytes: asizeint;
tck: ttypedconstkind;
begin
tck:=aggregate_kind(def);
if tck=tck_simple then
exit;
info:=curagginfo;
if not assigned(info) then
internalerror(2014091002);
if def<>info.def then
internalerror(2014091205);
{ add tail padding if necessary }
if (is_record(def) or
is_object(def)) and
not is_packed_record_or_object(def) then
begin
fillbytes:=def.size-info.curoffset;
while fillbytes>0 do
begin
do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
dec(fillbytes)
end;
end;
{ pop and free the information }
faggregateinformation.count:=faggregateinformation.count-1;
info.free;
end;
class function ttai_typedconstbuilder.get_dynstring_rec_name(typ: tstringtype; winlike: boolean; len: asizeint): string;
begin
case typ of
@ -908,57 +1009,14 @@ implementation
procedure ttai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
var
info: taggregateinformation;
tck: ttypedconstkind;
begin
tck:=aggregate_kind(def);
if tck=tck_simple then
exit;
if not assigned(faggregateinformation) then
faggregateinformation:=tfpobjectlist.create
else
begin
{ add padding if necessary, and update the current field/offset }
info:=curagginfo;
if is_record(curagginfo.def) or
is_object(curagginfo.def) then
prepare_next_field(def);
end;
info:=caggregateinformation.create(def,aggregate_kind(def));
faggregateinformation.add(info);
begin_aggregate_internal(def,false);
end;
procedure ttai_typedconstbuilder.maybe_end_aggregate(def: tdef);
var
info: taggregateinformation;
fillbytes: asizeint;
tck: ttypedconstkind;
begin
tck:=aggregate_kind(def);
if tck=tck_simple then
exit;
info:=curagginfo;
if not assigned(info) then
internalerror(2014091002);
if def<>info.def then
internalerror(2014091205);
{ add tail padding if necessary }
if (is_record(def) or
is_object(def)) and
not is_packed_record_or_object(def) then
begin
fillbytes:=def.size-info.curoffset;
while fillbytes>0 do
begin
do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
dec(fillbytes)
end;
end;
{ pop and free the information }
faggregateinformation.count:=faggregateinformation.count-1;
info.free;
end_aggregate_internal(def,false);
end;
@ -990,7 +1048,7 @@ implementation
{ create skeleton def }
anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords);
{ generic aggregate housekeeping }
maybe_begin_aggregate(anonrecorddef);
begin_aggregate_internal(anonrecorddef,true);
{ mark as anonymous record }
curagginfo.anonrecord:=true;
{ in case a descendent wants to do something with the anonrecorddef too }
@ -1001,18 +1059,26 @@ implementation
function ttai_typedconstbuilder.end_anonymous_record: trecorddef;
var
info: taggregateinformation;
anonrecord: boolean;
begin
info:=curagginfo;
if not assigned(info) or
(info.def.typ<>recorddef) then
internalerror(2014080201);
result:=trecorddef(info.def);
{ make a copy, as we need it after info has been freed by
maybe_end_aggregate(result) }
anonrecord:=info.anonrecord;
{ finalise the record skeleton (all fields have been added already by
emit_tai()) -- anonrecord may not be set in case we reused an earlier
constructed def }
if info.anonrecord then
if anonrecord then
trecordsymtable(result.symtable).addalignmentpadding;
maybe_end_aggregate(result);
end_aggregate_internal(result,true);
if anonrecord and
assigned(curagginfo) and
(curagginfo.def.typ=recorddef) then
insert_marked_aggregate_alignment(result);
end;
@ -1122,7 +1188,48 @@ implementation
end;
{****************************************************************************
tai_abstracttypedconst
****************************************************************************}
class constructor ttai_lowleveltypedconstbuilder.classcreate;
begin
caggregateinformation:=tlowlevelaggregateinformation;
end;
procedure ttai_lowleveltypedconstbuilder.mark_anon_aggregate_alignment;
var
marker: tai_marker;
begin
marker:=tai_marker.Create(mark_position);
fasmlist.concat(marker);
tlowlevelaggregateinformation(curagginfo).anonrecmarker:=marker;
end;
procedure ttai_lowleveltypedconstbuilder.insert_marked_aggregate_alignment(def: tdef);
var
info: tlowlevelaggregateinformation;
fillbytes: asizeint;
begin
info:=tlowlevelaggregateinformation(curagginfo);
if not assigned(info.anonrecmarker) then
internalerror(2014091401);
fillbytes:=info.prepare_next_field(def);
while fillbytes>0 do
begin
fasmlist.insertafter(tai_const.create_8bit(0),info.anonrecmarker);
dec(fillbytes);
end;
fasmlist.remove(info.anonrecmarker);
info.anonrecmarker.free;
info.anonrecmarker:=nil;
end;
begin
ctai_typedconstbuilder:=ttai_typedconstbuilder;
ctai_typedconstbuilder:=ttai_lowleveltypedconstbuilder;
end.

49
compiler/llvm/nllvmtcon.pas
View File

@ -35,8 +35,12 @@ interface
tllvmaggregateinformation = class(taggregateinformation)
private
faggai: tai_aggregatetypedconst;
fanonrecalignpos: longint;
public
constructor create(_def: tdef; _typ: ttypedconstkind); override;
property aggai: tai_aggregatetypedconst read faggai write faggai;
property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
end;
tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
@ -60,12 +64,14 @@ interface
procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
function wrap_with_type(p: tai; def: tdef): tai;
procedure do_emit_tai(p: tai; def: tdef); override;
procedure mark_anon_aggregate_alignment; override;
procedure insert_marked_aggregate_alignment(def: tdef); override;
procedure begin_aggregate_internal(def: tdef; anonymous: boolean); override;
procedure end_aggregate_internal(def: tdef; anonymous: boolean); override;
public
constructor create; override;
destructor destroy; override;
procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
procedure maybe_begin_aggregate(def: tdef); override;
procedure maybe_end_aggregate(def: tdef); override;
procedure queue_init(todef: tdef); override;
procedure queue_vecn(def: tdef; const index: tconstexprint); override;
procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@ -90,6 +96,15 @@ implementation
cpubase,llvmbase,
symbase,symtable,llvmdef,defutil;
{ tllvmaggregateinformation }
constructor tllvmaggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
begin
inherited;
fanonrecalignpos:=-1;
end;
class constructor tllvmtai_typedconstbuilder.classcreate;
begin
caggregateinformation:=tllvmaggregateinformation;
@ -199,6 +214,32 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.mark_anon_aggregate_alignment;
var
info: tllvmaggregateinformation;
begin
info:=tllvmaggregateinformation(curagginfo);
info.anonrecalignpos:=info.aggai.valuecount;
end;
procedure tllvmtai_typedconstbuilder.insert_marked_aggregate_alignment(def: tdef);
var
info: tllvmaggregateinformation;
fillbytes: asizeint;
begin
info:=tllvmaggregateinformation(curagginfo);
if info.anonrecalignpos=-1 then
internalerror(2014091501);
fillbytes:=info.prepare_next_field(def);
while fillbytes>0 do
begin
info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(tck_simple,u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
dec(fillbytes);
end;
end;
procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
begin
if not pvdef.is_addressonly then
@ -207,7 +248,7 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
procedure tllvmtai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
var
agg: tai_aggregatetypedconst;
tck: ttypedconstkind;
@ -235,7 +276,7 @@ implementation
end;
procedure tllvmtai_typedconstbuilder.maybe_end_aggregate(def: tdef);
procedure tllvmtai_typedconstbuilder.end_aggregate_internal(def: tdef; anonymous: boolean);
var
info: tllvmaggregateinformation;
begin