Browse Source

+ 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 -

Jonas Maebe 10 years ago
parent
commit
6f5905684f
3 changed files with 53 additions and 12 deletions
  1. 33 1
      compiler/aasmcnst.pas
  2. 7 7
      compiler/nobj.pas
  3. 13 4
      compiler/symdef.pas

+ 33 - 1
compiler/aasmcnst.pas

@@ -120,8 +120,10 @@ type
    { information about aggregates we are parsing }
    { information about aggregates we are parsing }
    taggregateinformation = class
    taggregateinformation = class
     private
     private
+     fnextfieldname: TIDString;
      function getcuroffset: asizeint;
      function getcuroffset: asizeint;
      function getfieldoffset(l: longint): asizeint;
      function getfieldoffset(l: longint): asizeint;
+     procedure setnextfieldname(AValue: TIDString);
     protected
     protected
      { type of the aggregate }
      { type of the aggregate }
      fdef: tdef;
      fdef: tdef;
@@ -159,6 +161,7 @@ type
      property typ: ttypedconstkind read ftyp;
      property typ: ttypedconstkind read ftyp;
      property curfield: tfieldvarsym read fcurfield write fcurfield;
      property curfield: tfieldvarsym read fcurfield write fcurfield;
      property nextfield: tfieldvarsym read fnextfield write fnextfield;
      property nextfield: tfieldvarsym read fnextfield write fnextfield;
+     property nextfieldname: TIDString write setnextfieldname;
      property fieldoffset[l: longint]: asizeint read getfieldoffset;
      property fieldoffset[l: longint]: asizeint read getfieldoffset;
      property curoffset: asizeint read getcuroffset;
      property curoffset: asizeint read getcuroffset;
      property anonrecord: boolean read fanonrecord write fanonrecord;
      property anonrecord: boolean read fanonrecord write fanonrecord;
@@ -174,6 +177,7 @@ type
     private
     private
      function getcurragginfo: taggregateinformation;
      function getcurragginfo: taggregateinformation;
      procedure set_next_field(AValue: tfieldvarsym);
      procedure set_next_field(AValue: tfieldvarsym);
+     procedure set_next_field_name(AValue: TIDString);
     protected
     protected
      { temporary list in which all data is collected }
      { temporary list in which all data is collected }
      fasmlist: tasmlist;
      fasmlist: tasmlist;
@@ -366,6 +370,9 @@ type
        initialised. Also in case of objects, because the fieldvarsyms are spread
        initialised. Also in case of objects, because the fieldvarsyms are spread
        over the symtables of the entire inheritance tree }
        over the symtables of the entire inheritance tree }
      property next_field: tfieldvarsym write set_next_field;
      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
     protected
      { this one always return the actual offset, called by the above (and
      { this one always return the actual offset, called by the above (and
        overridden versions) }
        overridden versions) }
@@ -428,6 +435,15 @@ implementation
       end;
       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);
     constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
       begin
       begin
         fdef:=_def;
         fdef:=_def;
@@ -461,7 +477,12 @@ implementation
             { if we are constructing this record as data gets emitted, add a field
             { if we are constructing this record as data gets emitted, add a field
               for this data }
               for this data }
             if anonrecord then
             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 }
             { find next field }
             i:=curindex;
             i:=curindex;
             repeat
             repeat
@@ -701,6 +722,17 @@ implementation
      end;
      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);
    procedure ttai_typedconstbuilder.pad_next_field(nextfielddef: tdef);
      var
      var
        fillbytes: asizeint;
        fillbytes: asizeint;

+ 7 - 7
compiler/nobj.pas

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

+ 13 - 4
compiler/symdef.pas

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