Browse Source

* moved the recording of aggregate type information during typed constant
parsing from nllvmtcon to aasmcnst
o added automatic insertion of padding bytes when fields need to be aligned,
so that once ncgvmt (and hopefully ncgrtti) are converted to the typed
constant builder class, we can get rid of all the explicit alignment
directives (only supported for non-bitpacked records for now)

git-svn-id: branches/hlcgllvm@28763 -

Jonas Maebe 10 years ago
parent
commit
d2b55b6f07
3 changed files with 400 additions and 131 deletions
  1. 310 11
      compiler/aasmcnst.pas
  2. 73 106
      compiler/llvm/nllvmtcon.pas
  3. 17 14
      compiler/ngtcon.pas

+ 310 - 11
compiler/aasmcnst.pas

@@ -107,9 +107,67 @@ type
    );
    );
    ttcasmlistoptions = set of ttcasmlistoption;
    ttcasmlistoptions = set of ttcasmlistoption;
 
 
+
+   { information about aggregates we are parsing }
+   taggregateinformation = class
+    private
+     function getcuroffset: asizeint;
+     function getfieldoffset(l: longint): asizeint;
+    protected
+     { type of the aggregate }
+     fdef: tdef;
+     { type of the aggregate }
+     ftyp: ttypedconstkind;
+     { symtable entry of the previously emitted field in case of a
+       record/object (nil if none emitted yet), used to insert alignment bytes
+       if necessary for variant records and objects }
+     fcurfield,
+     { field corresponding to the data that will be emitted next in case of a
+       record/object (nil if not set), used to handle variant records and
+       objects }
+     fnextfield: tfieldvarsym;
+     { similar as the fcurfield/fnextfield above, but instead of fieldvarsyms
+       these are indices in the symlist of a recorddef that correspond to
+       fieldvarsyms. These are used only for non-variant records, simply
+       traversing the fields in order. We could use the above method here as
+       well, but to find the next field we'd always have to use
+       symlist.indexof(fcurfield), which would be quite slow. These have -1 as
+       value if they're not set }
+     fcurindex,
+     fnextindex: longint;
+     { anonymous record that is being built as we add constant data }
+     fanonrecord: boolean;
+
+     property curindex: longint read fcurindex write fcurindex;
+     property nextindex: longint read fnextindex write fnextindex;
+    public
+     constructor create(_def: tdef; _typ: ttypedconstkind);
+     property def: tdef read fdef;
+     property typ: ttypedconstkind read ftyp;
+     property curfield: tfieldvarsym read fcurfield write fcurfield;
+     property nextfield: tfieldvarsym read fnextfield write fnextfield;
+     property fieldoffset[l: longint]: asizeint read getfieldoffset;
+     property curoffset: asizeint read getcuroffset;
+     property anonrecord: boolean read fanonrecord write fanonrecord;
+   end;
+   taggregateinformationclass = class of taggregateinformation;
+
    { Warning: never directly create a ttai_typedconstbuilder instance,
    { Warning: never directly create a ttai_typedconstbuilder instance,
      instead create a cai_typedconstbuilder (this class can be overridden) }
      instead create a cai_typedconstbuilder (this class can be overridden) }
    ttai_lowleveltypedconstbuilder = class abstract
    ttai_lowleveltypedconstbuilder = class abstract
+    { class type to use when creating new aggregate information instances }
+    protected class var
+     caggregateinformation: taggregateinformationclass;
+    public
+     { set the default value for caggregateinformation (= taggregateinformation) }
+     class constructor classcreate;
+
+    private
+     function getcurragginfo: taggregateinformation;
+     { add padding bytes for alignment if needed, and add the def of the next
+       field in case we are constructing an anonymous record }
+     procedure prepare_next_field(nextfielddef: tdef);
+     procedure set_next_field(AValue: tfieldvarsym);
     protected
     protected
      { temporary list in which all data is collected }
      { temporary list in which all data is collected }
      fasmlist: tasmlist;
      fasmlist: tasmlist;
@@ -117,6 +175,9 @@ type
        offset in the top-level array/record }
        offset in the top-level array/record }
      fqueue_offset: asizeint;
      fqueue_offset: asizeint;
 
 
+     { array of caggregateinformation instances }
+     faggregateinformation: tfpobjectlist;
+
      { ensure that finalize_asmlist is called only once }
      { ensure that finalize_asmlist is called only once }
      fasmlist_finalized: boolean;
      fasmlist_finalized: boolean;
 
 
@@ -125,6 +186,14 @@ type
      function aggregate_kind(def: tdef): ttypedconstkind; virtual;
      function aggregate_kind(def: tdef): ttypedconstkind; virtual;
      { finalize the asmlist: add the necessary symbols etc }
      { finalize the asmlist: add the necessary symbols etc }
      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
+
+     { called by the public emit_tai() routines to actually add the typed
+       constant data; the public ones also take care of adding extra padding
+       bytes etc (by calling this one) }
+     procedure do_emit_tai(p: tai; def: tdef); virtual;
+
+     { easy access to the top level aggregate information instance }
+     property curagginfo: taggregateinformation read getcurragginfo;
     public
     public
      constructor create; virtual;
      constructor create; virtual;
      destructor destroy; override;
      destructor destroy; override;
@@ -160,7 +229,7 @@ type
         b) the def of the record should be automatically constructed based on
         b) the def of the record should be automatically constructed based on
            the types of the emitted fields
            the types of the emitted fields
      }
      }
-     procedure begin_anonymous_record(const optionalname: string; packrecords: shortint); virtual;
+     function begin_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef; virtual;
      function end_anonymous_record: trecorddef; virtual;
      function end_anonymous_record: trecorddef; virtual;
 
 
      { The next group of routines are for constructing complex expressions.
      { The next group of routines are for constructing complex expressions.
@@ -202,6 +271,12 @@ type
        negative offset), but on some platforms such negative offsets are not
        negative offset), but on some platforms such negative offsets are not
        supported this is equal to the header size }
        supported this is equal to the header size }
      class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; virtual;
      class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; virtual;
+
+     { set the fieldvarsym whose data we will emit next; needed
+       in case of variant records, so we know which part of the variant gets
+       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;
     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) }
@@ -216,7 +291,44 @@ implementation
 
 
    uses
    uses
      verbose,globals,systems,widestr,
      verbose,globals,systems,widestr,
-     symtable,defutil;
+     symbase,symtable,defutil;
+
+{****************************************************************************
+                       taggregateinformation
+ ****************************************************************************}
+
+    function taggregateinformation.getcuroffset: asizeint;
+      var
+        field: tfieldvarsym;
+      begin
+        if assigned(curfield) then
+          result:=curfield.fieldoffset+curfield.vardef.size
+        else if curindex<>-1 then
+          begin
+            field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[curindex]);
+            result:=field.fieldoffset+field.vardef.size
+          end
+        else
+          result:=0
+      end;
+
+
+    function taggregateinformation.getfieldoffset(l: longint): asizeint;
+      var
+        field: tfieldvarsym;
+      begin
+        field:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[l]);
+        result:=field.fieldoffset;
+      end;
+
+
+    constructor taggregateinformation.create(_def: tdef; _typ: ttypedconstkind);
+      begin
+        fdef:=_def;
+        ftyp:=_typ;
+        fcurindex:=-1;
+        fnextindex:=-1;
+      end;
 
 
 
 
 {****************************************************************************
 {****************************************************************************
@@ -404,6 +516,81 @@ implementation
                               ttai_lowleveltypedconstbuilder
                               ttai_lowleveltypedconstbuilder
  *****************************************************************************}
  *****************************************************************************}
 
 
+   function ttai_lowleveltypedconstbuilder.getcurragginfo: taggregateinformation;
+     begin
+       if assigned(faggregateinformation) and
+          (faggregateinformation.count>0) then
+         result:=taggregateinformation(faggregateinformation[faggregateinformation.count-1])
+       else
+         result:=nil;
+     end;
+
+
+   procedure ttai_lowleveltypedconstbuilder.set_next_field(AValue: tfieldvarsym);
+     var
+       info: taggregateinformation;
+     begin
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091206);
+       info.nextfield:=AValue;
+     end;
+
+
+   procedure ttai_lowleveltypedconstbuilder.prepare_next_field(nextfielddef: tdef);
+     var
+       nextoffset: asizeint;
+       curoffset: asizeint;
+       info: taggregateinformation;
+       i: longint;
+     begin
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091002);
+       { current offset in the data }
+       curoffset:=info.curoffset;
+       { get the next field and its offset, and make that next field the current
+         one }
+       if assigned(info.nextfield) then
+         begin
+           nextoffset:=info.nextfield.fieldoffset;
+           info.curfield:=info.nextfield;
+         end
+       else
+         begin
+           { must set nextfield for unions and objects, as we cannot
+             automatically detect the "next" field in that case }
+           if ((info.def.typ=recorddef) and
+               trecorddef(info.def).isunion) or
+              is_object(info.def) then
+             internalerror(2014091202);
+           { if we are constructing this record as data gets emitted, add a field
+             for this data }
+           if info.anonrecord then
+             trecorddef(info.def).add_field_by_def(nextfielddef);
+           { find next field }
+           i:=info.curindex;
+           repeat
+             inc(i);
+           until tsym(tabstractrecorddef(info.def).symtable.symlist[i]).typ=fieldvarsym;
+           nextoffset:=info.fieldoffset[i];
+           info.curindex:=i;
+         end;
+       { need padding? }
+       while curoffset<nextoffset do
+         begin
+           do_emit_tai(tai_const.create_8bit(0),u8inttype);
+           inc(curoffset);
+         end;
+     end;
+
+
+   class constructor ttai_lowleveltypedconstbuilder.classcreate;
+     begin
+       caggregateinformation:=taggregateinformation;
+     end;
+
+
    function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
    function ttai_lowleveltypedconstbuilder.aggregate_kind(def: tdef): ttypedconstkind;
      begin
      begin
        if (def.typ in [recorddef,filedef,variantdef]) or
        if (def.typ in [recorddef,filedef,variantdef]) or
@@ -452,6 +639,13 @@ implementation
      end;
      end;
 
 
 
 
+   procedure ttai_lowleveltypedconstbuilder.do_emit_tai(p: tai; def: tdef);
+     begin
+       { by default we don't care about the type }
+       fasmlist.concat(p);
+     end;
+
+
    function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; const options: ttcasmlistoptions): tasmlist;
    function ttai_lowleveltypedconstbuilder.get_final_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: longint; const options: ttcasmlistoptions): tasmlist;
      begin
      begin
        if not fasmlist_finalized then
        if not fasmlist_finalized then
@@ -520,16 +714,37 @@ implementation
        { the queue should have been flushed if it was used }
        { the queue should have been flushed if it was used }
        if fqueue_offset<>low(fqueue_offset) then
        if fqueue_offset<>low(fqueue_offset) then
          internalerror(2014062901);
          internalerror(2014062901);
+       faggregateinformation.free;
        fasmlist.free;
        fasmlist.free;
        inherited destroy;
        inherited destroy;
      end;
      end;
 
 
 
 
    procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef);
    procedure ttai_lowleveltypedconstbuilder.emit_tai(p: tai; def: tdef);
+     var
+       kind: ttypedconstkind;
+       info: taggregateinformation;
      begin
      begin
-       { by default, we ignore the def info since we don't care about it at the
-         the assembler level }
-       fasmlist.concat(p);
+       { these elements can be aggregates themselves, e.g. a shortstring can
+         be emitted as a series of bytes and char arrays }
+       kind:=aggregate_kind(def);
+       info:=curagginfo;
+       if (kind<>tck_simple) and
+          (not assigned(info) or
+           (info.typ<>kind)) then
+         internalerror(2014091001);
+       { if we're emitting a record, handle the padding bytes, and in case of
+         an anonymous record also add the next field }
+       if assigned(info) then
+         begin
+           if ((info.def.typ=recorddef) or
+               is_object(info.def)) and
+              { may add support for these later }
+              not is_packed_record_or_object(info.def) then
+             prepare_next_field(def);
+         end;
+       { emit the data }
+       do_emit_tai(p,def);
      end;
      end;
 
 
 
 
@@ -693,27 +908,111 @@ implementation
 
 
 
 
    procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
    procedure ttai_lowleveltypedconstbuilder.maybe_begin_aggregate(def: tdef);
+     var
+       info: taggregateinformation;
+       tck: ttypedconstkind;
      begin
      begin
-       { do nothing }
+       tck:=aggregate_kind(def);
+       if tck=tck_simple then
+         exit;
+       if not assigned(faggregateinformation) then
+         faggregateinformation:=tfpobjectlist.create
+       else
+         begin
+           { add padding if necessary, and update the current field/offset }
+           info:=curagginfo;
+           if is_record(curagginfo.def) or
+              is_object(curagginfo.def) then
+             prepare_next_field(def);
+         end;
+       info:=caggregateinformation.create(def,aggregate_kind(def));
+       faggregateinformation.add(info);
      end;
      end;
 
 
 
 
    procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef);
    procedure ttai_lowleveltypedconstbuilder.maybe_end_aggregate(def: tdef);
+     var
+       info: taggregateinformation;
+       fillbytes: asizeint;
+       tck: ttypedconstkind;
      begin
      begin
-       { do nothing }
+       tck:=aggregate_kind(def);
+       if tck=tck_simple then
+         exit;
+       info:=curagginfo;
+       if not assigned(info) then
+         internalerror(2014091002);
+       if def<>info.def then
+         internalerror(2014091205);
+       { add tail padding if necessary }
+       if (is_record(def) or
+           is_object(def)) and
+          not is_packed_record_or_object(def) then
+         begin
+           fillbytes:=def.size-info.curoffset;
+           while fillbytes>0 do
+             begin
+               do_emit_tai(Tai_const.Create_8bit(0),u8inttype);
+               dec(fillbytes)
+             end;
+         end;
+       { pop and free the information }
+       faggregateinformation.count:=faggregateinformation.count-1;
+       info.free;
      end;
      end;
 
 
 
 
-   procedure ttai_lowleveltypedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint);
+   function ttai_lowleveltypedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint): trecorddef;
+     var
+       anonrecorddef: trecorddef;
+       srsym: tsym;
+       srsymtable: tsymtable;
+       found: boolean;
      begin
      begin
-       { do nothing }
+       { if the name is specified, we create a typesym with that name in order
+         to ensure we can find it again later with that name -> reuse here as
+         well if possible (and that also avoids duplicate type name issues) }
+       if optionalname<>'' then
+         begin
+           if optionalname[1]='$' then
+             found:=searchsym_type(copy(optionalname,2,length(optionalname)),srsym,srsymtable)
+           else
+             found:=searchsym_type(optionalname,srsym,srsymtable);
+           if found then
+             begin
+               if ttypesym(srsym).typedef.typ<>recorddef then
+                 internalerror(2014091207);
+               result:=trecorddef(ttypesym(srsym).typedef);
+               maybe_begin_aggregate(result);
+               exit;
+             end;
+         end;
+       { create skeleton def }
+       anonrecorddef:=crecorddef.create_global_internal(optionalname,packrecords);
+       { generic aggregate housekeeping }
+       maybe_begin_aggregate(anonrecorddef);
+       { mark as anonymous record }
+       curagginfo.anonrecord:=true;
+       { in case a descendent wants to do something with the anonrecorddef too }
+       result:=anonrecorddef;
      end;
      end;
 
 
 
 
    function ttai_lowleveltypedconstbuilder.end_anonymous_record: trecorddef;
    function ttai_lowleveltypedconstbuilder.end_anonymous_record: trecorddef;
+     var
+       info: taggregateinformation;
      begin
      begin
-       { do nothing }
-       result:=nil;
+       info:=curagginfo;
+       if not assigned(info) or
+          (info.def.typ<>recorddef) then
+         internalerror(2014080201);
+       result:=trecorddef(info.def);
+       { finalise the record skeleton (all fields have been added already by
+         emit_tai()) -- anonrecord may not be set in case we reused an earlier
+         constructed def }
+       if info.anonrecord then
+         trecordsymtable(result.symtable).addalignmentpadding;
+       maybe_end_aggregate(result);
      end;
      end;
 
 
 
 

+ 73 - 106
compiler/llvm/nllvmtcon.pas

@@ -32,12 +32,19 @@ interface
     ngtcon;
     ngtcon;
 
 
   type
   type
+    tllvmaggregateinformation = class(taggregateinformation)
+     private
+      faggai: tai_aggregatetypedconst;
+     public
+      property aggai: tai_aggregatetypedconst read faggai write faggai;
+    end;
+
     tllvmtai_typedconstbuilder = class(ttai_lowleveltypedconstbuilder)
     tllvmtai_typedconstbuilder = class(ttai_lowleveltypedconstbuilder)
+     protected type
+      public
+       { set the default value for caggregateinformation (= tllvmaggregateinformation) }
+       class constructor classcreate;
      protected
      protected
-      { aggregates (from outer to inner nested) that have been encountered,
-        if any }
-      faggregates: tfplist;
-
       fqueued_def: tdef;
       fqueued_def: tdef;
       fqueued_tai,
       fqueued_tai,
       flast_added_tai: tai;
       flast_added_tai: tai;
@@ -51,18 +58,14 @@ interface
           newindex indicates which operand is empty and can be filled with the
           newindex indicates which operand is empty and can be filled with the
           next queued tai }
           next queued tai }
       procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
       procedure update_queued_tai(resdef: tdef; outerai, innerai: tai; newindex: longint);
-      procedure emit_tai_intern(p: tai; def: tdef);
       function wrap_with_type(p: tai; def: tdef): tai;
       function wrap_with_type(p: tai; def: tdef): tai;
-      procedure begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
+      procedure do_emit_tai(p: tai; def: tdef); override;
      public
      public
       constructor create; override;
       constructor create; override;
       destructor destroy; override;
       destructor destroy; override;
-      procedure emit_tai(p: tai; def: tdef); override;
       procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
       procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
       procedure maybe_begin_aggregate(def: tdef); override;
       procedure maybe_begin_aggregate(def: tdef); override;
       procedure maybe_end_aggregate(def: tdef); override;
       procedure maybe_end_aggregate(def: tdef); override;
-      procedure begin_anonymous_record(const optionalname: string; packrecords: shortint); override;
-      function end_anonymous_record: trecorddef; override;
       procedure queue_init(todef: tdef); override;
       procedure queue_init(todef: tdef); override;
       procedure queue_vecn(def: tdef; const index: tconstexprint); override;
       procedure queue_vecn(def: tdef; const index: tconstexprint); override;
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@@ -87,6 +90,12 @@ implementation
     cpubase,llvmbase,
     cpubase,llvmbase,
     symbase,symtable,llvmdef,defutil;
     symbase,symtable,llvmdef,defutil;
 
 
+  class constructor tllvmtai_typedconstbuilder.classcreate;
+    begin
+      caggregateinformation:=tllvmaggregateinformation;
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
   procedure tllvmtai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
     var
     var
       newasmlist: tasmlist;
       newasmlist: tasmlist;
@@ -132,11 +141,30 @@ implementation
     end;
     end;
 
 
 
 
-  procedure tllvmtai_typedconstbuilder.emit_tai_intern(p: tai; def: tdef);
+  function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
+    begin
+      result:=tai_simpletypedconst.create(tck_simple,def,p);
+    end;
+
+
+  constructor tllvmtai_typedconstbuilder.create;
+    begin
+      inherited create;
+    end;
+
+
+  destructor tllvmtai_typedconstbuilder.destroy;
+    begin
+      inherited destroy;
+    end;
+
+
+  procedure tllvmtai_typedconstbuilder.do_emit_tai(p: tai; def: tdef);
     var
     var
       ai: tai;
       ai: tai;
       stc: tai_abstracttypedconst;
       stc: tai_abstracttypedconst;
       kind: ttypedconstkind;
       kind: ttypedconstkind;
+      info: tllvmaggregateinformation;
     begin
     begin
       if assigned(fqueued_tai) then
       if assigned(fqueued_tai) then
         begin
         begin
@@ -154,64 +182,20 @@ implementation
         end
         end
       else
       else
         stc:=tai_simpletypedconst.create(tck_simple,def,p);
         stc:=tai_simpletypedconst.create(tck_simple,def,p);
+      info:=tllvmaggregateinformation(curagginfo);
       { these elements can be aggregates themselves, e.g. a shortstring can
       { these elements can be aggregates themselves, e.g. a shortstring can
         be emitted as a series of bytes and string data arrays }
         be emitted as a series of bytes and string data arrays }
       kind:=aggregate_kind(def);
       kind:=aggregate_kind(def);
-      if (kind<>tck_simple) and
-         (not assigned(faggregates) or
-          (faggregates.count=0) or
-          (tai_aggregatetypedconst(faggregates[faggregates.count-1]).adetyp<>kind)) then
-        internalerror(2014052906);
-      if assigned(faggregates) and
-         (faggregates.count>0) then
-        tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(stc)
-      else
-        inherited emit_tai(stc,def);
-    end;
-
-
-  function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
-    begin
-      result:=tai_simpletypedconst.create(tck_simple,def,p);
-    end;
-
-
-  procedure tllvmtai_typedconstbuilder.begin_aggregate_intern(tck: ttypedconstkind; def: tdef);
-    var
-      agg: tai_aggregatetypedconst;
-    begin
-      if not assigned(faggregates) then
-        faggregates:=tfplist.create;
-      agg:=tai_aggregatetypedconst.create(tck,def);
-      { nested aggregate -> add to parent }
-      if faggregates.count>0 then
-        tai_aggregatetypedconst(faggregates[faggregates.count-1]).addvalue(agg)
-      { otherwise add to asmlist }
+      if (kind<>tck_simple) then
+        begin
+          if not assigned(info) or
+             (info.aggai.adetyp<>kind) then
+           internalerror(2014052906);
+        end;
+      if assigned(info) then
+        info.aggai.addvalue(stc)
       else
       else
-        fasmlist.concat(agg);
-      { new top level aggregate, future data will be added to it }
-      faggregates.add(agg);
-    end;
-
-
-  constructor tllvmtai_typedconstbuilder.create;
-    begin
-      inherited create;
-      { constructed as needed }
-      faggregates:=nil;
-    end;
-
-
-  destructor tllvmtai_typedconstbuilder.destroy;
-    begin
-      faggregates.free;
-      inherited destroy;
-    end;
-
-
-  procedure tllvmtai_typedconstbuilder.emit_tai(p: tai; def: tdef);
-    begin
-      emit_tai_intern(p,def);
+        inherited do_emit_tai(stc,def);
     end;
     end;
 
 
 
 
@@ -219,70 +203,53 @@ implementation
     begin
     begin
       if not pvdef.is_addressonly then
       if not pvdef.is_addressonly then
         pvdef:=tprocvardef(pvdef.getcopyas(procvardef,pc_address_only));
         pvdef:=tprocvardef(pvdef.getcopyas(procvardef,pc_address_only));
-      emit_tai_intern(p,pvdef);
+      emit_tai(p,pvdef);
     end;
     end;
 
 
 
 
   procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
   procedure tllvmtai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
     var
     var
+      agg: tai_aggregatetypedconst;
       tck: ttypedconstkind;
       tck: ttypedconstkind;
+      curagg: tllvmaggregateinformation;
     begin
     begin
       tck:=aggregate_kind(def);
       tck:=aggregate_kind(def);
       if tck<>tck_simple then
       if tck<>tck_simple then
-        begin_aggregate_intern(tck,def);
-      inherited;
+        begin
+          { create new typed const aggregate }
+          agg:=tai_aggregatetypedconst.create(tck,def);
+          { either add to the current typed const aggregate (if nested), or
+            emit to the asmlist (if top level) }
+          curagg:=tllvmaggregateinformation(curagginfo);
+          if assigned(curagg) then
+            curagg.aggai.addvalue(agg)
+          else
+            fasmlist.concat(agg);
+          { create aggregate information for this new aggregate }
+          inherited;
+          { set new current typed const aggregate }
+          tllvmaggregateinformation(curagginfo).aggai:=agg
+        end
+      else
+       inherited;
     end;
     end;
 
 
 
 
   procedure tllvmtai_typedconstbuilder.maybe_end_aggregate(def: tdef);
   procedure tllvmtai_typedconstbuilder.maybe_end_aggregate(def: tdef);
+    var
+      info: tllvmaggregateinformation;
     begin
     begin
       if aggregate_kind(def)<>tck_simple then
       if aggregate_kind(def)<>tck_simple then
         begin
         begin
-          if not assigned(faggregates) or
-             (faggregates.count=0) then
+          info:=tllvmaggregateinformation(curagginfo);
+          if not assigned(info) then
             internalerror(2014060101);
             internalerror(2014060101);
-          tai_aggregatetypedconst(faggregates[faggregates.count-1]).finish;
-          { already added to the asmlist if necessary }
-          faggregates.count:=faggregates.count-1;
+          info.aggai.finish;
         end;
         end;
       inherited;
       inherited;
     end;
     end;
 
 
 
 
-  procedure tllvmtai_typedconstbuilder.begin_anonymous_record(const optionalname: string; packrecords: shortint);
-    var
-      recorddef: trecorddef;
-    begin
-      inherited;
-      recorddef:=crecorddef.create_global_internal(optionalname,packrecords);
-      begin_aggregate_intern(tck_record,recorddef);
-    end;
-
-
-  function tllvmtai_typedconstbuilder.end_anonymous_record: trecorddef;
-    var
-      agg: tai_aggregatetypedconst;
-      ele: tai_abstracttypedconst;
-      defs: tfplist;
-    begin
-      result:=inherited;
-      if assigned(result) then
-        exit;
-      if not assigned(faggregates) or
-         (faggregates.count=0) or
-         (tai_aggregatetypedconst(faggregates[faggregates.count-1]).def.typ<>recorddef) then
-        internalerror(2014080201);
-      agg:=tai_aggregatetypedconst(faggregates[faggregates.count-1]);
-      defs:=tfplist.create;
-      for ele in agg do
-        defs.add(ele.def);
-      result:=trecorddef(agg.def);
-      result.add_fields_from_deflist(defs);
-      { already added to the asmlist if necessary }
-      faggregates.count:=faggregates.count-1;
-    end;
-
-
   procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
   procedure tllvmtai_typedconstbuilder.queue_init(todef: tdef);
     begin
     begin
       inherited;
       inherited;

+ 17 - 14
compiler/ngtcon.pas

@@ -1422,9 +1422,14 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
           if string2guid(hs,tmpguid) then
           if string2guid(hs,tmpguid) then
             begin
             begin
               ftcb.maybe_begin_aggregate(rec_tguid);
               ftcb.maybe_begin_aggregate(rec_tguid);
+              { variant record -> must specify which fields get initialised }
+              ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[0]);
               ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
               ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
+              ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[1]);
               ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
               ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
+              ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[2]);
               ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
               ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
+              ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[3]);
               for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
               for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
                 ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
                 ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
               ftcb.maybe_end_aggregate(rec_tguid);
               ftcb.maybe_end_aggregate(rec_tguid);
@@ -1450,9 +1455,14 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                   begin
                   begin
                     ftcb.maybe_begin_aggregate(rec_tguid);
                     ftcb.maybe_begin_aggregate(rec_tguid);
                     tmpguid:=tguidconstnode(n).value;
                     tmpguid:=tguidconstnode(n).value;
+                    { variant record -> must specify which fields get initialised }
+                    ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[0]);
                     ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
                     ftcb.emit_tai(Tai_const.Create_32bit(longint(tmpguid.D1)),u32inttype);
+                    ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[1]);
                     ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
                     ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D2),u16inttype);
+                    ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[2]);
                     ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
                     ftcb.emit_tai(Tai_const.Create_16bit(tmpguid.D3),u16inttype);
+                    ftcb.next_field:=tfieldvarsym(rec_tguid.symtable.symlist[3]);
                     for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
                     for i:=Low(tmpguid.D4) to High(tmpguid.D4) do
                       ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
                       ftcb.emit_tai(Tai_const.Create_8bit(tmpguid.D4[i]),u8inttype);
                     ftcb.maybe_end_aggregate(rec_tguid);
                     ftcb.maybe_end_aggregate(rec_tguid);
@@ -1557,7 +1567,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                 if tfieldvarsym(srsym).fieldoffset>recoffset then
                 if tfieldvarsym(srsym).fieldoffset>recoffset then
                   begin
                   begin
                     if not(is_packed) then
                     if not(is_packed) then
-                      fillbytes:=tfieldvarsym(srsym).fieldoffset-recoffset
+                      fillbytes:=0
                     else
                     else
                       begin
                       begin
                         flush_packed_value(bp);
                         flush_packed_value(bp);
@@ -1578,6 +1588,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                    inc(recoffset,tfieldvarsym(srsym).vardef.packedbitsize);
                    inc(recoffset,tfieldvarsym(srsym).vardef.packedbitsize);
 
 
                 { read the data }
                 { read the data }
+                ftcb.next_field:=tfieldvarsym(srsym);
                 if not(is_packed) or
                 if not(is_packed) or
                    { only orddefs and enumdefs are bitpacked, as in gcc/gpc }
                    { only orddefs and enumdefs are bitpacked, as in gcc/gpc }
                    not(tfieldvarsym(srsym).vardef.typ in [orddef,enumdef]) then
                    not(tfieldvarsym(srsym).vardef.typ in [orddef,enumdef]) then
@@ -1624,7 +1635,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         if not error then
         if not error then
           begin
           begin
             if not(is_packed) then
             if not(is_packed) then
-              fillbytes:=def.size-recoffset
+              fillbytes:=0
             else
             else
               begin
               begin
                 flush_packed_value(bp);
                 flush_packed_value(bp);
@@ -1731,19 +1742,13 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                      (oo_has_vmt in def.objectoptions) and
                      (oo_has_vmt in def.objectoptions) and
                      (def.vmt_offset<fieldoffset) then
                      (def.vmt_offset<fieldoffset) then
                     begin
                     begin
-                      for i:=1 to def.vmt_offset-objoffset do
-                        ftcb.emit_tai(tai_const.create_8bit(0),u8inttype);
-                      // TODO VMT type proper tdef?
-                      ftcb.emit_tai(tai_const.createname(def.vmt_mangledname,AT_DATA,0),voidpointertype);
-                      { this is more general }
-                      objoffset:=def.vmt_offset + sizeof(pint);
+                      ftcb.next_field:=tfieldvarsym(def.vmt_field);
+                      ftcb.emit_tai(tai_const.createname(def.vmt_mangledname,AT_DATA,0),tfieldvarsym(def.vmt_field).vardef);
+                      objoffset:=def.vmt_offset+tfieldvarsym(def.vmt_field).vardef.size;
                       vmtwritten:=true;
                       vmtwritten:=true;
                     end;
                     end;
 
 
-                  { if needed fill }
-                  if fieldoffset>objoffset then
-                    for i:=1 to fieldoffset-objoffset do
-                      ftcb.emit_tai(Tai_const.Create_8bit(0),u8inttype);
+                  ftcb.next_field:=tfieldvarsym(srsym);
 
 
                   { new position }
                   { new position }
                   objoffset:=fieldoffset+vardef.size;
                   objoffset:=fieldoffset+vardef.size;
@@ -1768,8 +1773,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             { this is more general }
             { this is more general }
             objoffset:=def.vmt_offset + sizeof(pint);
             objoffset:=def.vmt_offset + sizeof(pint);
           end;
           end;
-        for i:=1 to def.size-objoffset do
-          ftcb.emit_tai(Tai_const.Create_8bit(0),u8inttype);
         ftcb.maybe_end_aggregate(def);
         ftcb.maybe_end_aggregate(def);
         consume(_RKLAMMER);
         consume(_RKLAMMER);
       end;
       end;