mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 12:59:24 +02:00
* moved the recording of aggregate type information during typed constant
parsing from nllvmtcon to aasmcnst
o added automatic insertion of padding bytes when fields need to be aligned,
so that once ncgvmt (and hopefully ncgrtti) are converted to the typed
constant builder class, we can get rid of all the explicit alignment
directives (only supported for non-bitpacked records for now)
git-svn-id: branches/hlcgllvm@28763 -
This commit is contained in:
Jonas Maebe
parent
95b95497d4
commit
d2b55b6f07
@ -107,9 +107,67 @@ type
|
||||
);
|
||||
ttcasmlistoptions = set of ttcasmlistoption;
|
||||
|
||||
|
||||
{ information about aggregates we are parsing }
|
||||
taggregateinformation = class
|
||||
private
|
||||
function getcuroffset: asizeint;
|
||||
function getfieldoffset(l: longint): asizeint;
|
||||
protected
|
||||
{ type of the aggregate }
|
||||
fdef: tdef;
|
||||
{ type of the aggregate }
|
||||
ftyp: ttypedconstkind;
|
||||
{ symtable entry of the previously emitted field in case of a
|
||||
record/object (nil if none emitted yet), used to insert alignment bytes
|
||||
if necessary for variant records and objects }
|
||||
fcurfield,
|
||||
{ field corresponding to the data that will be emitted next in case of a
|
||||
record/object (nil if not set), used to handle variant records and
|
||||
objects }
|
||||
fnextfield: tfieldvarsym;
|
||||
{ similar as the fcurfield/fnextfield above, but instead of fieldvarsyms
|
||||
these are indices in the symlist of a recorddef that correspond to
|
||||
fieldvarsyms. These are used only for non-variant records, simply
|
||||
traversing the fields in order. We could use the above method here as
|
||||
well, but to find the next field we'd always have to use
|
||||
symlist.indexof(fcurfield), which would be quite slow. These have -1 as
|
||||
value if they're not set }
|
||||
fcurindex,
|
||||
fnextindex: longint;
|
||||
{ anonymous record that is being built as we add constant data }
|
||||
fanonrecord: boolean;
|
||||
|
||||
property curindex: longint read fcurindex write fcurindex;
|
||||
property nextindex: longint read fnextindex write fnextindex;
|
||||
public
|
||||
constructor create(_def: tdef; _typ: ttypedconstkind);
|
||||
property def: tdef read fdef;
|
||||
property typ: ttypedconstkind read ftyp;
|
||||
property curfield: tfieldvarsym read fcurfield write fcurfield;
|
||||
property nextfield: tfieldvarsym read fnextfield write fnextfield;
|
||||
property fieldoffset[l: longint]: asizeint read getfieldoffset;
|
||||
property curoffset: asizeint read getcuroffset;
|
||||
property anonrecord: boolean read fanonrecord write fanonrecord;
|
||||
end;
|
||||
taggregateinformationclass = class of taggregateinformation;
|
||||
|
||||
{ Warning: never directly create a ttai_typedconstbuilder instance,
|
||||
instead create a cai_typedconstbuilder (this class can be overridden) }
|
||||
ttai_lowleveltypedconstbuilder = class abstract
|
||||
{ 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 }
|
||||
fasmlist: tasmlist;
|
||||
@ -117,6 +175,9 @@ type
|
||||
offset in the top-level array/record }
|
||||
fqueue_offset: asizeint;
|
||||
|
||||
{ array of caggregateinformation instances }
|
||||
faggregateinformation: tfpobjectlist;
|
||||
|
||||
{ ensure that finalize_asmlist is called only once }
|
||||
fasmlist_finalized: boolean;
|
||||
|
||||
@ -125,6 +186,14 @@ type
|
||||
function aggregate_kind(def: tdef): ttypedconstkind; virtual;
|
||||
{ finalize the asmlist: add the necessary symbols etc }
|
||||
procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
|
||||
|
||||
{ called by the public emit_tai() routines to actually add the typed
|
||||
constant data; the public ones also take care of adding extra padding
|
||||
bytes etc (by calling this one) }
|
||||
procedure do_emit_tai(p: tai; def: tdef); virtual;
|
||||
|
||||
{ easy access to the top level aggregate information instance }
|
||||
property curagginfo: taggregateinformation read getcurragginfo;
|
||||
public
|
||||
constructor create; virtual;
|
||||
destructor destroy; override;
|
||||
@ -160,7 +229,7 @@ type
|
||||
b) the def of the record should be automatically constructed based on
|
||||
the types of the emitted fields
|
||||
}
|
||||
procedure begin_anonymous_record(const optionalname: string; packrecords: shortint); virtual;
|
||||
function begin_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef; virtual;
|
||||
function end_anonymous_record: trecorddef; virtual;
|
||||
|
||||
{ The next group of routines are for constructing complex expressions.
|
||||
@ -202,6 +271,12 @@ type
|
||||
negative offset), but on some platforms such negative offsets are not
|
||||
supported this is equal to the header size }
|
||||
class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; virtual;
|
||||
|
||||
{ set the fieldvarsym whose data we will emit next; needed
|
||||
in case of variant records, so we know which part of the variant gets
|
||||
initialised. Also in case of objects, because the fieldvarsyms are spread
|
||||
over the symtables of the entire inheritance tree }
|
||||
property next_field: tfieldvarsym write set_next_field;
|
||||
protected
|
||||
{ this one always return the actual offset, called by the above (and
|
||||
overridden versions) }
|
||||
@ -216,7 +291,44 @@ implementation
|
||||
|
||||
uses
|
||||
verbose,globals,systems,widestr,
|
||||
symtable,defutil;
|
||||
symbase,symtable,defutil;
|
||||
|
||||
{****************************************************************************
|
||||
taggregateinformation
|
||||
****************************************************************************}
|
||||
|
||||
function taggregateinformation.getcuroffset: asizeint;
|
||||
var
|
||||
field: tfieldvarsym;
|
||||
begin
|
||||
if assigned(curfield) then
|
||||
result:=curfield.fieldoffset+curfield.vardef.size
|
||||
else if curindex<>-1 then
|
||||
begin
|
||||
field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[curindex]);
|
||||
result:=field.fieldoffset+field.vardef.size
|
||||
end
|
||||
else
|
||||
result:=0
|
||||
end;
|
||||
|
||||
|
||||
function taggregateinformation.getfieldoffset(l: longint): asizeint;
|
||||
var
|
||||
field: tfieldvarsym;
|
||||
begin
|
||||
field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[l]);
|
||||
result:=field.fieldoffset;
|
||||
end;
|
||||
|
||||
|
||||
constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
|
||||
begin
|
||||
fdef:=_def;
|
||||
ftyp:=_typ;
|
||||
fcurindex:=-1;
|
||||
fnextindex:=-1;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
@ -404,6 +516,81 @@ implementation
|
||||
ttai_lowleveltypedconstbuilder
|
||||
*****************************************************************************}
|
||||
|
||||
function ttai_lowleveltypedconstbuilder.getcurragginfo: taggregateinformation;
|
||||
begin
|
||||
if assigned(faggregateinformation) and
|
||||
(faggregateinformation.count>0) then
|
||||
result:=taggregateinformation(faggregateinformation[faggregateinformation.count-1])
|
||||
else
|
||||
result:=nil;
|
||||
end;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.set_next_field(AValue: tfieldvarsym);
|
||||
var
|
||||
info: taggregateinformation;
|
||||
begin
|
||||
info:=curagginfo;
|
||||
if not assigned(info) then
|
||||
internalerror(2014091206);
|
||||
info.nextfield:=AValue;
|
||||
end;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.prepare_next_field(nextfielddef: tdef);
|
||||
var
|
||||
nextoffset: asizeint;
|
||||
curoffset: asizeint;
|
||||
info: taggregateinformation;
|
||||
i: longint;
|
||||
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
|
||||
begin
|
||||
do_emit_tai(tai_const.create_8bit(0),u8inttype);
|
||||
inc(curoffset);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
class constructor ttai_lowleveltypedconstbuilder.classcreate;
|
||||
begin
|
||||
caggregateinformation:=taggregateinformation;
|
||||
end;
|
||||
|
||||
|
||||
function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
|
||||
begin
|
||||
if (def.typ in [recorddef,filedef,variantdef]) or
|
||||
@ -452,6 +639,13 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.do_emit_tai(p: tai; def: tdef);
|
||||
begin
|
||||
{ by default we don't care about the type }
|
||||
fasmlist.concat(p);
|
||||
end;
|
||||
|
||||
|
||||
function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; const options: ttcasmlistoptions): tasmlist;
|
||||
begin
|
||||
if not fasmlist_finalized then
|
||||
@ -520,16 +714,37 @@ implementation
|
||||
{ the queue should have been flushed if it was used }
|
||||
if fqueue_offset<>low(fqueue_offset) then
|
||||
internalerror(2014062901);
|
||||
faggregateinformation.free;
|
||||
fasmlist.free;
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef);
|
||||
var
|
||||
kind: ttypedconstkind;
|
||||
info: taggregateinformation;
|
||||
begin
|
||||
{ by default, we ignore the def info since we don't care about it at the
|
||||
the assembler level }
|
||||
fasmlist.concat(p);
|
||||
{ these elements can be aggregates themselves, e.g. a shortstring can
|
||||
be emitted as a series of bytes and char arrays }
|
||||
kind:=aggregate_kind(def);
|
||||
info:=curagginfo;
|
||||
if (kind<>tck_simple) and
|
||||
(not assigned(info) or
|
||||
(info.typ<>kind)) then
|
||||
internalerror(2014091001);
|
||||
{ if we're emitting a record, handle the padding bytes, and in case of
|
||||
an anonymous record also add the next field }
|
||||
if assigned(info) then
|
||||
begin
|
||||
if ((info.def.typ=recorddef) or
|
||||
is_object(info.def)) and
|
||||
{ may add support for these later }
|
||||
not is_packed_record_or_object(info.def) then
|
||||
prepare_next_field(def);
|
||||
end;
|
||||
{ emit the data }
|
||||
do_emit_tai(p,def);
|
||||
end;
|
||||
|
||||
|
||||
@ -693,27 +908,111 @@ implementation
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
|
||||
var
|
||||
info: taggregateinformation;
|
||||
tck: ttypedconstkind;
|
||||
begin
|
||||
{ do nothing }
|
||||
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);
|
||||
end;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef);
|
||||
var
|
||||
info: taggregateinformation;
|
||||
fillbytes: asizeint;
|
||||
tck: ttypedconstkind;
|
||||
begin
|
||||
{ do nothing }
|
||||
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;
|
||||
|
||||
|
||||
procedure ttai_lowleveltypedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint);
|
||||
function ttai_lowleveltypedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef;
|
||||
var
|
||||
anonrecorddef: trecorddef;
|
||||
srsym: tsym;
|
||||
srsymtable: tsymtable;
|
||||
found: boolean;
|
||||
begin
|
||||
{ do nothing }
|
||||
{ if the name is specified, we create a typesym with that name in order
|
||||
to ensure we can find it again later with that name -> reuse here as
|
||||
well if possible (and that also avoids duplicate type name issues) }
|
||||
if optionalname<>'' then
|
||||
begin
|
||||
if optionalname[1]='$' then
|
||||
found:=searchsym_type(copy(optionalname,2,length(optionalname)),srsym,srsymtable)
|
||||
else
|
||||
found:=searchsym_type(optionalname,srsym,srsymtable);
|
||||
if found then
|
||||
begin
|
||||
if ttypesym(srsym).typedef.typ<>recorddef then
|
||||
internalerror(2014091207);
|
||||
result:=trecorddef(ttypesym(srsym).typedef);
|
||||
maybe_begin_aggregate(result);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
{ create skeleton def }
|
||||
anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords);
|
||||
{ generic aggregate housekeeping }
|
||||
maybe_begin_aggregate(anonrecorddef);
|
||||
{ mark as anonymous record }
|
||||
curagginfo.anonrecord:=true;
|
||||
{ in case a descendent wants to do something with the anonrecorddef too }
|
||||
result:=anonrecorddef;
|
||||
end;
|
||||
|
||||
|
||||
function ttai_lowleveltypedconstbuilder.end_anonymous_record: trecorddef;
|
||||
var
|
||||
info: taggregateinformation;
|
||||
begin
|
||||
{ do nothing }
|
||||
result:=nil;
|
||||
info:=curagginfo;
|
||||
if not assigned(info) or
|
||||
(info.def.typ<>recorddef) then
|
||||
internalerror(2014080201);
|
||||
result:=trecorddef(info.def);
|
||||
{ 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
|
||||
trecordsymtable(result.symtable).addalignmentpadding;
|
||||
maybe_end_aggregate(result);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -32,12 +32,19 @@ interface
|
||||
ngtcon;
|
||||
|
||||
type
|
||||
tllvmtai_typedconstbuilder = class(ttai_lowleveltypedconstbuilder)
|
||||
protected
|
||||
{ aggregates (from outer to inner nested) that have been encountered,
|
||||
if any }
|
||||
faggregates: tfplist;
|
||||
tllvmaggregateinformation = class(taggregateinformation)
|
||||
private
|
||||
faggai: tai_aggregatetypedconst;
|
||||
public
|
||||
property aggai: tai_aggregatetypedconst read faggai write faggai;
|
||||
end;
|
||||
|
||||
tllvmtai_typedconstbuilder = class(ttai_lowleveltypedconstbuilder)
|
||||
protected type
|
||||
public
|
||||
{ set the default value for caggregateinformation (= tllvmaggregateinformation) }
|
||||
class constructor classcreate;
|
||||
protected
|
||||
fqueued_def: tdef;
|
||||
fqueued_tai,
|
||||
flast_added_tai: tai;
|
||||
@ -51,18 +58,14 @@ interface
|
||||
newindex indicates which operand is empty and can be filled with the
|
||||
next queued tai }
|
||||
procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
|
||||
procedure emit_tai_intern(p: tai; def: tdef);
|
||||
function wrap_with_type(p: tai; def: tdef): tai;
|
||||
procedure begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
|
||||
procedure do_emit_tai(p: tai; def: tdef); override;
|
||||
public
|
||||
constructor create; override;
|
||||
destructor destroy; override;
|
||||
procedure emit_tai(p: tai; def: tdef); 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 begin_anonymous_record(const optionalname: string; packrecords: shortint); override;
|
||||
function end_anonymous_record: trecorddef; override;
|
||||
procedure queue_init(todef: tdef); override;
|
||||
procedure queue_vecn(def: tdef; const index: tconstexprint); override;
|
||||
procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
|
||||
@ -87,6 +90,12 @@ implementation
|
||||
cpubase,llvmbase,
|
||||
symbase,symtable,llvmdef,defutil;
|
||||
|
||||
class constructor tllvmtai_typedconstbuilder.classcreate;
|
||||
begin
|
||||
caggregateinformation:=tllvmaggregateinformation;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
|
||||
var
|
||||
newasmlist: tasmlist;
|
||||
@ -132,11 +141,30 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.emit_tai_intern(p: tai; def: tdef);
|
||||
function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
|
||||
begin
|
||||
result:=tai_simpletypedconst.create(tck_simple,def,p);
|
||||
end;
|
||||
|
||||
|
||||
constructor tllvmtai_typedconstbuilder.create;
|
||||
begin
|
||||
inherited create;
|
||||
end;
|
||||
|
||||
|
||||
destructor tllvmtai_typedconstbuilder.destroy;
|
||||
begin
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
|
||||
var
|
||||
ai: tai;
|
||||
stc: tai_abstracttypedconst;
|
||||
kind: ttypedconstkind;
|
||||
info: tllvmaggregateinformation;
|
||||
begin
|
||||
if assigned(fqueued_tai) then
|
||||
begin
|
||||
@ -154,64 +182,20 @@ implementation
|
||||
end
|
||||
else
|
||||
stc:=tai_simpletypedconst.create(tck_simple,def,p);
|
||||
info:=tllvmaggregateinformation(curagginfo);
|
||||
{ these elements can be aggregates themselves, e.g. a shortstring can
|
||||
be emitted as a series of bytes and string data arrays }
|
||||
kind:=aggregate_kind(def);
|
||||
if (kind<>tck_simple) and
|
||||
(not assigned(faggregates) or
|
||||
(faggregates.count=0) or
|
||||
(tai_aggregatetypedconst(faggregates[faggregates.count-1]).adetyp<>kind)) then
|
||||
internalerror(2014052906);
|
||||
if assigned(faggregates) and
|
||||
(faggregates.count>0) then
|
||||
tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(stc)
|
||||
if (kind<>tck_simple) then
|
||||
begin
|
||||
if not assigned(info) or
|
||||
(info.aggai.adetyp<>kind) then
|
||||
internalerror(2014052906);
|
||||
end;
|
||||
if assigned(info) then
|
||||
info.aggai.addvalue(stc)
|
||||
else
|
||||
inherited emit_tai(stc,def);
|
||||
end;
|
||||
|
||||
|
||||
function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
|
||||
begin
|
||||
result:=tai_simpletypedconst.create(tck_simple,def,p);
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
|
||||
var
|
||||
agg: tai_aggregatetypedconst;
|
||||
begin
|
||||
if not assigned(faggregates) then
|
||||
faggregates:=tfplist.create;
|
||||
agg:=tai_aggregatetypedconst.create(tck,def);
|
||||
{ nested aggregate -> add to parent }
|
||||
if faggregates.count>0 then
|
||||
tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(agg)
|
||||
{ otherwise add to asmlist }
|
||||
else
|
||||
fasmlist.concat(agg);
|
||||
{ new top level aggregate, future data will be added to it }
|
||||
faggregates.add(agg);
|
||||
end;
|
||||
|
||||
|
||||
constructor tllvmtai_typedconstbuilder.create;
|
||||
begin
|
||||
inherited create;
|
||||
{ constructed as needed }
|
||||
faggregates:=nil;
|
||||
end;
|
||||
|
||||
|
||||
destructor tllvmtai_typedconstbuilder.destroy;
|
||||
begin
|
||||
faggregates.free;
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.emit_tai(p: tai; def: tdef);
|
||||
begin
|
||||
emit_tai_intern(p,def);
|
||||
inherited do_emit_tai(stc,def);
|
||||
end;
|
||||
|
||||
|
||||
@ -219,70 +203,53 @@ implementation
|
||||
begin
|
||||
if not pvdef.is_addressonly then
|
||||
pvdef:=tprocvardef(pvdef.getcopyas(procvardef,pc_address_only));
|
||||
emit_tai_intern(p,pvdef);
|
||||
emit_tai(p,pvdef);
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
|
||||
var
|
||||
agg: tai_aggregatetypedconst;
|
||||
tck: ttypedconstkind;
|
||||
curagg: tllvmaggregateinformation;
|
||||
begin
|
||||
tck:=aggregate_kind(def);
|
||||
if tck<>tck_simple then
|
||||
begin_aggregate_intern(tck,def);
|
||||
inherited;
|
||||
begin
|
||||
{ create new typed const aggregate }
|
||||
agg:=tai_aggregatetypedconst.create(tck,def);
|
||||
{ either add to the current typed const aggregate (if nested), or
|
||||
emit to the asmlist (if top level) }
|
||||
curagg:=tllvmaggregateinformation(curagginfo);
|
||||
if assigned(curagg) then
|
||||
curagg.aggai.addvalue(agg)
|
||||
else
|
||||
fasmlist.concat(agg);
|
||||
{ create aggregate information for this new aggregate }
|
||||
inherited;
|
||||
{ set new current typed const aggregate }
|
||||
tllvmaggregateinformation(curagginfo).aggai:=agg
|
||||
end
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.maybe_end_aggregate(def: tdef);
|
||||
var
|
||||
info: tllvmaggregateinformation;
|
||||
begin
|
||||
if aggregate_kind(def)<>tck_simple then
|
||||
begin
|
||||
if not assigned(faggregates) or
|
||||
(faggregates.count=0) then
|
||||
info:=tllvmaggregateinformation(curagginfo);
|
||||
if not assigned(info) then
|
||||
internalerror(2014060101);
|
||||
tai_aggregatetypedconst(faggregates[faggregates.count-1]).finish;
|
||||
{ already added to the asmlist if necessary }
|
||||
faggregates.count:=faggregates.count-1;
|
||||
info.aggai.finish;
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint);
|
||||
var
|
||||
recorddef: trecorddef;
|
||||
begin
|
||||
inherited;
|
||||
recorddef:=crecorddef.create_global_internal(optionalname,packrecords);
|
||||
begin_aggregate_intern(tck_record,recorddef);
|
||||
end;
|
||||
|
||||
|
||||
function tllvmtai_typedconstbuilder.end_anonymous_record: trecorddef;
|
||||
var
|
||||
agg: tai_aggregatetypedconst;
|
||||
ele: tai_abstracttypedconst;
|
||||
defs: tfplist;
|
||||
begin
|
||||
result:=inherited;
|
||||
if assigned(result) then
|
||||
exit;
|
||||
if not assigned(faggregates) or
|
||||
(faggregates.count=0) or
|
||||
(tai_aggregatetypedconst(faggregates[faggregates.count-1]).def.typ<>recorddef) then
|
||||
internalerror(2014080201);
|
||||
agg:=tai_aggregatetypedconst(faggregates[faggregates.count-1]);
|
||||
defs:=tfplist.create;
|
||||
for ele in agg do
|
||||
defs.add(ele.def);
|
||||
result:=trecorddef(agg.def);
|
||||
result.add_fields_from_deflist(defs);
|
||||
{ already added to the asmlist if necessary }
|
||||
faggregates.count:=faggregates.count-1;
|
||||
end;
|
||||
|
||||
|
||||
procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
@ -1422,9 +1422,14 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
if string2guid(hs,tmpguid) then
|
||||
begin
|
||||
ftcb.maybe_begin_aggregate(rec_tguid);
|
||||
{ variant record -> must specify which fields get initialised }
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[0]);
|
||||
ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[1]);
|
||||
ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[2]);
|
||||
ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[3]);
|
||||
for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
|
||||
ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
|
||||
ftcb.maybe_end_aggregate(rec_tguid);
|
||||
@ -1450,9 +1455,14 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
begin
|
||||
ftcb.maybe_begin_aggregate(rec_tguid);
|
||||
tmpguid:=tguidconstnode(n).value;
|
||||
{ variant record -> must specify which fields get initialised }
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[0]);
|
||||
ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[1]);
|
||||
ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[2]);
|
||||
ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
|
||||
ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[3]);
|
||||
for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
|
||||
ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
|
||||
ftcb.maybe_end_aggregate(rec_tguid);
|
||||
@ -1557,7 +1567,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
if tfieldvarsym(srsym).fieldoffset>recoffset then
|
||||
begin
|
||||
if not(is_packed) then
|
||||
fillbytes:=tfieldvarsym(srsym).fieldoffset-recoffset
|
||||
fillbytes:=0
|
||||
else
|
||||
begin
|
||||
flush_packed_value(bp);
|
||||
@ -1578,6 +1588,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
inc(recoffset,tfieldvarsym(srsym).vardef.packedbitsize);
|
||||
|
||||
{ read the data }
|
||||
ftcb.next_field:=tfieldvarsym(srsym);
|
||||
if not(is_packed) or
|
||||
{ only orddefs and enumdefs are bitpacked, as in gcc/gpc }
|
||||
not(tfieldvarsym(srsym).vardef.typ in [orddef,enumdef]) then
|
||||
@ -1624,7 +1635,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
if not error then
|
||||
begin
|
||||
if not(is_packed) then
|
||||
fillbytes:=def.size-recoffset
|
||||
fillbytes:=0
|
||||
else
|
||||
begin
|
||||
flush_packed_value(bp);
|
||||
@ -1731,19 +1742,13 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
(oo_has_vmt in def.objectoptions) and
|
||||
(def.vmt_offset<fieldoffset) then
|
||||
begin
|
||||
for i:=1 to def.vmt_offset-objoffset do
|
||||
ftcb.emit_tai(tai_const.create_8bit(0),u8inttype);
|
||||
// TODO VMT type proper tdef?
|
||||
ftcb.emit_tai(tai_const.createname(def.vmt_mangledname,AT_DATA,0),voidpointertype);
|
||||
{ this is more general }
|
||||
objoffset:=def.vmt_offset + sizeof(pint);
|
||||
ftcb.next_field:=tfieldvarsym(def.vmt_field);
|
||||
ftcb.emit_tai(tai_const.createname(def.vmt_mangledname,AT_DATA,0),tfieldvarsym(def.vmt_field).vardef);
|
||||
objoffset:=def.vmt_offset+tfieldvarsym(def.vmt_field).vardef.size;
|
||||
vmtwritten:=true;
|
||||
end;
|
||||
|
||||
{ if needed fill }
|
||||
if fieldoffset>objoffset then
|
||||
for i:=1 to fieldoffset-objoffset do
|
||||
ftcb.emit_tai(Tai_const.Create_8bit(0),u8inttype);
|
||||
ftcb.next_field:=tfieldvarsym(srsym);
|
||||
|
||||
{ new position }
|
||||
objoffset:=fieldoffset+vardef.size;
|
||||
@ -1768,8 +1773,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
|
||||
{ this is more general }
|
||||
objoffset:=def.vmt_offset + sizeof(pint);
|
||||
end;
|
||||
for i:=1 to def.size-objoffset do
|
||||
ftcb.emit_tai(Tai_const.Create_8bit(0),u8inttype);
|
||||
ftcb.maybe_end_aggregate(def);
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user