From 6f5905684febf242d36f87cc5b1d63f4d2b9d9e9 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Thu, 30 Jul 2015 16:57:58 +0000 Subject: [PATCH] + support for specifying the name of fields added to anonymous record types that are constructed on the fly by the high level typed const builder git-svn-id: trunk@31249 - --- compiler/aasmcnst.pas | 34 +++++++++++++++++++++++++++++++++- compiler/nobj.pas | 14 +++++++------- compiler/symdef.pas | 17 +++++++++++++---- 3 files changed, 53 insertions(+), 12 deletions(-) diff --git a/compiler/aasmcnst.pas b/compiler/aasmcnst.pas index 06b78a6230..4b148b1504 100644 --- a/compiler/aasmcnst.pas +++ b/compiler/aasmcnst.pas @@ -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; diff --git a/compiler/nobj.pas b/compiler/nobj.pas index d01af90af4..7acc3ed732 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index df49e1e3cd..06740fced0 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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;