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

* several fixes for emitting aggregate typed constants with C/ABI packing:

Browse Source 
o don't emit explicit padding bytes (LLVM adds them)
   o don't mark them in LLVM as packed either

git-svn-id: trunk@31187 -
This commit is contained in:
Jonas Maebe 2015-07-03 20:04:15 +00:00
parent 4edb6e68fd
commit 7a8b5fd6c5
3 changed files with 60 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compiler/aasmcnst.pas
View File

@ -153,7 +153,7 @@ type
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;
function prepare_next_field(nextfielddef: tdef): asizeint; virtual;
property def: tdef read fdef;
property typ: ttypedconstkind read ftyp;
@ -269,6 +269,7 @@ type
procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); virtual;
protected
procedure maybe_emit_tail_padding(def: tdef); virtual;
function emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel):tasmlabofs;
procedure begin_aggregate_internal(def: tdef; anonymous: boolean); virtual;
procedure end_aggregate_internal(def: tdef; anonymous: boolean); virtual;
@ -1009,6 +1010,30 @@ implementation
end;
procedure ttai_typedconstbuilder.maybe_emit_tail_padding(def: tdef);
var
info: taggregateinformation;
fillbytes: asizeint;
begin
info:=curagginfo;
if not assigned(info) then
internalerror(2014091002);
if def<>info.def then
internalerror(2014091205);
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;
end;
function ttai_typedconstbuilder.emit_string_const_common(stringtype: tstringtype; len: asizeint; encoding: tstringencoding; var startlab: tasmlabel): tasmlabofs;
var
string_symofs: asizeint;
@ -1102,30 +1127,15 @@ implementation
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;
maybe_emit_tail_padding(def);
{ pop and free the information }
info:=curagginfo;
faggregateinformation.count:=faggregateinformation.count-1;
info.free;
end;

12
compiler/llvm/agllvm.pas
View File

@ -81,7 +81,7 @@ implementation
SysUtils,
cutils,cfileutl,systems,
fmodule,verbose,
aasmcnst,symconst,symdef,
aasmcnst,symconst,symdef,symtable,
llvmbase,aasmllvm,itllvm,llvmdef,
cgbase,cgutils,cpubase;
@ -685,7 +685,10 @@ implementation
begin
AsmWrite(defstr);
AsmWrite(' ');
AsmWrite('<{');
if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
AsmWrite('<{')
else
AsmWrite('{');
first:=true;
for p in tai_aggregatetypedconst(hp) do
begin
@ -695,7 +698,10 @@ implementation
first:=false;
WriteTypedConstData(p);
end;
AsmWrite('}>');
if tabstractrecordsymtable(tabstractrecorddef(hp.def).symtable).usefieldalignment<>C_alignment then
AsmWrite('}>')
else
AsmWrite('}');
end;
tck_array:
begin

23
compiler/llvm/nllvmtcon.pas
View File

@ -39,6 +39,8 @@ interface
public
constructor create(_def: tdef; _typ: ttypedconstkind); override;
function prepare_next_field(nextfielddef: tdef): asizeint; override;
property aggai: tai_aggregatetypedconst read faggai write faggai;
property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
end;
@ -66,11 +68,14 @@ interface
procedure do_emit_tai(p: tai; def: tdef); override;
procedure mark_anon_aggregate_alignment; override;
procedure insert_marked_aggregate_alignment(def: tdef); override;
procedure maybe_emit_tail_padding(def: tdef); override;
procedure begin_aggregate_internal(def: tdef; anonymous: boolean); override;
procedure end_aggregate_internal(def: tdef; anonymous: boolean); override;
function get_internal_data_section_start_label: tasmlabel; override;
function get_internal_data_section_internal_label: tasmlabel; override;
procedure do_emit_extended_in_aggregate(p: tai);
public
destructor destroy; override;
procedure emit_tai(p: tai; def: tdef); override;
@ -104,6 +109,14 @@ implementation
fanonrecalignpos:=-1;
end;
function tllvmaggregateinformation.prepare_next_field(nextfielddef: tdef): asizeint;
begin
result:=inherited;
{ in case of C/ABI alignment, the padding gets added by LLVM }
if tabstractrecordsymtable(tabstractrecorddef(def).symtable).usefieldalignment=C_alignment then
result:=0;
end;
class constructor tllvmtai_typedconstbuilder.classcreate;
begin
@ -249,6 +262,16 @@ implementation
end;
end;
procedure tllvmtai_typedconstbuilder.maybe_emit_tail_padding(def: tdef);
begin
{ in case of C/ABI alignment, the padding gets added by LLVM }
if (is_record(def) or
is_object(def)) and
(tabstractrecordsymtable(tabstractrecorddef(def).symtable).usefieldalignment=C_alignment) then
exit;
inherited;
end;
procedure tllvmtai_typedconstbuilder.emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef);
begin