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

+ support for specifying the name of fields added to anonymous record

Browse Source 
types that are constructed on the fly by the high level typed const
    builder

git-svn-id: trunk@31249 -
This commit is contained in:
Jonas Maebe 2015-07-30 16:57:58 +00:00
parent b55c7df996
commit 6f5905684f
3 changed files with 53 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/aasmcnst.pas
View File

@ -120,8 +120,10 @@ type
{ information about aggregates we are parsing }
taggregateinformation = class
private
fnextfieldname: TIDString;
function getcuroffset: asizeint;
function getfieldoffset(l: longint): asizeint;
procedure setnextfieldname(AValue: TIDString);
protected
{ type of the aggregate }
fdef: tdef;
@ -159,6 +161,7 @@ type
property typ: ttypedconstkind read ftyp;
property curfield: tfieldvarsym read fcurfield write fcurfield;
property nextfield: tfieldvarsym read fnextfield write fnextfield;
property nextfieldname: TIDString write setnextfieldname;
property fieldoffset[l: longint]: asizeint read getfieldoffset;
property curoffset: asizeint read getcuroffset;
property anonrecord: boolean read fanonrecord write fanonrecord;
@ -174,6 +177,7 @@ type
private
function getcurragginfo: taggregateinformation;
procedure set_next_field(AValue: tfieldvarsym);
procedure set_next_field_name(AValue: TIDString);
protected
{ temporary list in which all data is collected }
fasmlist: tasmlist;
@ -366,6 +370,9 @@ type
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;
{ set the name of the next field that will be emitted for an anonymous
record (or the next of the next started anonymous record) }
property next_field_name: TIDString write set_next_field_name;
protected
{ this one always return the actual offset, called by the above (and
overridden versions) }
@ -428,6 +435,15 @@ implementation
end;
procedure taggregateinformation.setnextfieldname(AValue: TIDString);
begin
if assigned(fnextfieldname) or
not anonrecord then
internalerror(2015071503);
fnextfieldname:=AValue;
end;
constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
begin
fdef:=_def;
@ -461,7 +477,12 @@ implementation
{ 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);
begin
trecorddef(def).add_field_by_def(fnextfieldname,nextfielddef);
fnextfieldname:='';
end
else if fnextfieldname<>'' then
internalerror(2015071501);
{ find next field }
i:=curindex;
repeat
@ -701,6 +722,17 @@ implementation
end;
procedure ttai_typedconstbuilder.set_next_field_name(AValue: TIDString);
var
info: taggregateinformation;
begin
info:=curagginfo;
if not assigned(info) then
internalerror(2015071502);
info.nextfieldname:='$'+AValue;
end;
procedure ttai_typedconstbuilder.pad_next_field(nextfielddef: tdef);
var
fillbytes: asizeint;

14
compiler/nobj.pas
View File

@ -842,7 +842,7 @@ implementation
sym:=tsym(trecorddef(systemvmt).symtable.SymList[i]);
if sym.typ<>fieldvarsym then
internalerror(2015052602);
vmtdef.add_field_by_def(tfieldvarsym(sym).vardef);
vmtdef.add_field_by_def('',tfieldvarsym(sym).vardef);
end;
end;
odt_interfacecom,odt_interfacecorba,odt_dispinterface:
@ -851,11 +851,11 @@ implementation
odt_object:
begin
{ size, -size, parent vmt [, dmt ] }
vmtdef.add_field_by_def(ptrsinttype);
vmtdef.add_field_by_def(ptrsinttype);
vmtdef.add_field_by_def(voidpointertype);
vmtdef.add_field_by_def('',ptrsinttype);
vmtdef.add_field_by_def('',ptrsinttype);
vmtdef.add_field_by_def('',voidpointertype);
{$ifdef WITHDMT}
vmtdef.add_field_by_def(voidpointertype);
vmtdef.add_field_by_def('',voidpointertype);
{$endif WITHDMT}
end;
else
@ -864,11 +864,11 @@ implementation
{ now add the methods }
for i:=0 to _class.vmtentries.count-1 do
vmtdef.add_field_by_def(
vmtdef.add_field_by_def('',
cprocvardef.getreusableprocaddr(pvmtentry(_class.vmtentries[i])^.procdef)
);
{ the VMT ends with a nil pointer }
vmtdef.add_field_by_def(voidcodepointertype);
vmtdef.add_field_by_def('',voidcodepointertype);
end;

17
compiler/symdef.pas
View File

@ -302,7 +302,7 @@ interface
isunion : boolean;
constructor create(const n:string; p:TSymtable);virtual;
constructor create_global_internal(n: string; packrecords, recordalignmin, maxCrecordalign: shortint); virtual;
procedure add_field_by_def(def: tdef);
procedure add_field_by_def(const optionalname: TIDString; def: tdef);
procedure add_fields_from_deflist(fieldtypes: tfplist);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
@ -4142,11 +4142,20 @@ implementation
end;
procedure trecorddef.add_field_by_def(def: tdef);
procedure trecorddef.add_field_by_def(const optionalname: TIDString; def: tdef);
var
sym: tfieldvarsym;
name: TIDString;
pname: ^TIDString;
begin
sym:=cfieldvarsym.create('$f'+tostr(trecordsymtable(symtable).symlist.count),vs_value,def,[]);
if optionalname='' then
begin
name:='$f'+tostr(trecordsymtable(symtable).symlist.count);
pname:=@name
end
else
pname:=@optionalname;
sym:=cfieldvarsym.create(pname^,vs_value,def,[]);
symtable.insert(sym);
trecordsymtable(symtable).addfield(sym,vis_hidden);
end;
@ -4157,7 +4166,7 @@ implementation
i: longint;
begin
for i:=0 to fieldtypes.count-1 do
add_field_by_def(tdef(fieldtypes[i]));
add_field_by_def('',tdef(fieldtypes[i]));
end;