+ support for emitting simple placeholder elements in the high level

typed const builder, for use when e.g. emitting a table preceded by
    the number of elements in case that number is only known afterwards

git-svn-id: trunk@31648 -
This commit is contained in:
Jonas Maebe 2015-09-12 23:33:24 +00:00
parent f49d6e5f26
commit 5a2217f645
2 changed files with 142 additions and 0 deletions

View File

@ -92,6 +92,7 @@ type
procedure addvalue(val: tai_abstracttypedconst);
function valuecount: longint;
procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
procedure finish;
destructor destroy; override;
end;
@ -168,6 +169,14 @@ type
end;
taggregateinformationclass = class of taggregateinformation;
{ information about a placeholder element that has been added, and which has
to be replaced later with a real data element }
ttypedconstplaceholder = class abstract
def: tdef;
constructor create(d: tdef);
procedure replace(ai: tai; d: tdef); virtual; abstract;
end;
{ Warning: never directly create a ttai_typedconstbuilder instance,
instead create a cai_typedconstbuilder (this class can be overridden) }
ttai_typedconstbuilder = class abstract
@ -327,6 +336,16 @@ type
function begin_anonymous_record(const optionalname: string; packrecords, recordalign, recordalignmin, maxcrecordalign: shortint): trecorddef; virtual;
function end_anonymous_record: trecorddef; virtual;
{ add a placeholder element at the current position that later can be
filled in with the actual data (via ttypedconstplaceholder.replace)
useful in case you have table preceded by the number of elements, and
you cound the elements while building the table }
function emit_placeholder(def: tdef): ttypedconstplaceholder; virtual; abstract;
{ common code to check whether a placeholder can be added at the current
position }
procedure check_add_placeholder(def: tdef);
{ The next group of routines are for constructing complex expressions.
While parsing a typed constant these operators are encountered from
outer to inner, so that is also the order in which they should be
@ -397,6 +416,13 @@ type
property anonrecmarker: tai read fanonrecmarker write fanonrecmarker;
end;
tlowleveltypedconstplaceholder = class(ttypedconstplaceholder)
list: tasmlist;
insertpos: tai;
constructor create(l: tasmlist; pos: tai; d: tdef);
procedure replace(ai: tai; d: tdef); override;
end;
ttai_lowleveltypedconstbuilder = class(ttai_typedconstbuilder)
protected
procedure mark_anon_aggregate_alignment; override;
@ -404,6 +430,7 @@ type
public
{ set the default value for caggregateinformation (= tlowlevelaggregateinformation) }
class constructor classcreate;
function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
end;
var
@ -508,6 +535,15 @@ implementation
end;
{****************************************************************************
ttypedconstplaceholder
****************************************************************************}
constructor ttypedconstplaceholder.create(d: tdef);
begin
def:=d;
end;
{****************************************************************************
tai_abstracttypedconst
****************************************************************************}
@ -685,6 +721,13 @@ implementation
end;
function tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
begin
result:=tai_abstracttypedconst(fvalues[pos]);
fvalues[pos]:=val;
end;
procedure tai_aggregatetypedconst.finish;
begin
if fisstring then
@ -1430,6 +1473,22 @@ implementation
end;
procedure ttai_typedconstbuilder.check_add_placeholder(def: tdef);
begin
{ it only makes sense to add a placeholder inside an aggregate
(otherwise there can be but one element)
we cannot add a placeholder in the middle of a queued expression
either
the placeholder cannot be an aggregate }
if not assigned(curagginfo) or
queue_is_active or
(aggregate_kind(def)<>tck_simple) then
internalerror(2015091001);
end;
procedure ttai_typedconstbuilder.queue_init(todef: tdef);
var
info: taggregateinformation;
@ -1609,6 +1668,28 @@ implementation
end;
{****************************************************************************
tlowleveltypedconstplaceholder
****************************************************************************}
constructor tlowleveltypedconstplaceholder.create(l: tasmlist; pos: tai; d: tdef);
begin
inherited create(d);
list:=l;
insertpos:=pos;
end;
procedure tlowleveltypedconstplaceholder.replace(ai: tai; d: tdef);
begin
if d<>def then
internalerror(2015091001);
list.insertafter(ai,insertpos);
list.remove(insertpos);
insertpos.free;
end;
{****************************************************************************
tai_abstracttypedconst
****************************************************************************}
@ -1619,6 +1700,17 @@ implementation
end;
function ttai_lowleveltypedconstbuilder.emit_placeholder(def: tdef): ttypedconstplaceholder;
var
p: tai;
begin
check_add_placeholder(def);
p:=tai_marker.Create(mark_position);
emit_tai(p,def);
result:=tlowleveltypedconstplaceholder.create(fasmlist,p,def);
end;
procedure ttai_lowleveltypedconstbuilder.mark_anon_aggregate_alignment;
var
marker: tai_marker;

View File

@ -45,6 +45,13 @@ interface
property anonrecalignpos: longint read fanonrecalignpos write fanonrecalignpos;
end;
tllvmtypedconstplaceholder = class(ttypedconstplaceholder)
agginfo: tllvmaggregateinformation;
pos: longint;
constructor create(info: tllvmaggregateinformation; p: longint; d: tdef);
procedure replace(ai: tai; d: tdef); override;
end;
tllvmtai_typedconstbuilder = class(ttai_typedconstbuilder)
protected type
public
@ -88,6 +95,8 @@ interface
procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
procedure queue_emit_ordconst(value: int64; def: tdef); override;
function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
end;
@ -117,6 +126,31 @@ implementation
end;
{ tllvmtypedconstplaceholder }
constructor tllvmtypedconstplaceholder.create(info: tllvmaggregateinformation; p: longint; d: tdef);
begin
inherited create(d);
agginfo:=info;
pos:=p;
end;
procedure tllvmtypedconstplaceholder.replace(ai: tai; d: tdef);
var
oldconst: tai_abstracttypedconst;
begin
if d<>def then
internalerror(2015091002);
oldconst:=agginfo.aggai.replacevalueatpos(
tai_simpletypedconst.create(tck_simple,d,ai),pos
);
oldconst.free;
end;
{ tllvmtai_typedconstbuilder }
class constructor tllvmtai_typedconstbuilder.classcreate;
begin
caggregateinformation:=tllvmaggregateinformation;
@ -576,6 +610,22 @@ implementation
end;
function tllvmtai_typedconstbuilder.emit_placeholder(def: tdef): ttypedconstplaceholder;
var
pos: longint;
begin
check_add_placeholder(def);
{ we can't support extended constants, because those are transformed into
an array of bytes, so we can't easily replace them afterwards }
if (def.typ=floatdef) and
(tfloatdef(def).floattype=s80real) then
internalerror(2015091003);
pos:=tllvmaggregateinformation(curagginfo).aggai.valuecount;
emit_tai(tai_marker.Create(mark_position),def);
result:=tllvmtypedconstplaceholder.create(tllvmaggregateinformation(curagginfo),pos,def);
end;
class function tllvmtai_typedconstbuilder.get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint;
begin
{ LLVM does not support labels in the middle of a declaration }