Ver código fonte

+ 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 anos atrás
pai
commit
6f5905684f
3 arquivos alterados com 53 adições e 12 exclusões
  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 }
    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;

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

+ 13 - 4
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;