The Important Ones:

- 39683, 39684, 39685, 39686 (rework of Interface Method RTTI)
- 39687, 39688, 39689, 39690, 39709, 39710 (change of PPU version)

git-svn-id: branches/fixes_3_2@39809 -

compiler/aasmcnst.pas

@@ -365,6 +365,9 @@ type
      { emit an ordinal constant }
      procedure emit_ord_const(value: int64; def: tdef);
 
+     { emit a reference to a pooled shortstring constant }
+     procedure emit_pooled_shortstring_const_ref(const str:shortstring);
+
      { begin a potential aggregate type. Must be called for any type
        that consists of multiple tai constant data entries, or that
        represents an aggregate at the Pascal level (a record, a non-dynamic
@@ -1846,6 +1849,56 @@ implementation
      end;
 
 
+   procedure ttai_typedconstbuilder.emit_pooled_shortstring_const_ref(const str:shortstring);
+     var
+       pool : thashset;
+       entry : phashsetitem;
+       strlab : tasmlabel;
+       l : longint;
+       pc : pansichar;
+       datadef : tdef;
+       strtcb : ttai_typedconstbuilder;
+     begin
+       pool:=current_asmdata.ConstPools[sp_shortstr];
+
+       entry:=pool.FindOrAdd(@str[1],length(str));
+
+       { :-(, we must generate a new entry }
+       if not assigned(entry^.Data) then
+         begin
+           current_asmdata.getglobaldatalabel(strlab);
+
+           { include length and terminating zero for quick conversion to pchar }
+           l:=length(str);
+           getmem(pc,l+2);
+           move(str[1],pc[1],l);
+           pc[0]:=chr(l);
+           pc[l+1]:=#0;
+
+           datadef:=carraydef.getreusable(cansichartype,l+2);
+
+           { we start a new constbuilder as we don't know whether we're called
+             from inside an internal constbuilder }
+           strtcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
+
+           strtcb.maybe_begin_aggregate(datadef);
+           strtcb.emit_tai(Tai_string.Create_pchar(pc,l+2),datadef);
+           strtcb.maybe_end_aggregate(datadef);
+
+           current_asmdata.asmlists[al_typedconsts].concatList(
+             strtcb.get_final_asmlist(strlab,datadef,sec_rodata_norel,strlab.name,const_align(sizeof(pint)))
+           );
+           strtcb.free;
+
+           entry^.Data:=strlab;
+         end
+       else
+         strlab:=tasmlabel(entry^.Data);
+
+       emit_tai(tai_const.Create_sym(strlab),charpointertype);
+     end;
+
+
    procedure ttai_typedconstbuilder.maybe_begin_aggregate(def: tdef);
      begin
        begin_aggregate_internal(def,false);

compiler/aasmdata.pas

@@ -96,7 +96,8 @@ interface
          sp_objcprotocolrefs,
          sp_varsets,
          sp_floats,
-         sp_guids
+         sp_guids,
+         sp_paraloc
       );
       
     const

compiler/ncgrtti.pas

@@ -65,7 +65,7 @@ interface
         procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
         procedure write_paralocs(tcb:ttai_typedconstbuilder;para:pcgpara);
         procedure write_param_flag(tcb:ttai_typedconstbuilder;parasym:tparavarsym);
-        procedure write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
+        procedure write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
       public
         constructor create;
         procedure write_rtti(def:tdef;rt:trttitype);
@@ -175,7 +175,6 @@ implementation
                               TRTTIWriter
 ***************************************************************************}
 
-
     procedure TRTTIWriter.write_methods(tcb:ttai_typedconstbuilder;st:tsymtable;visibilities:tvisibilities);
       var
         rtticount,
@@ -230,7 +229,7 @@ implementation
                       write_methodkind(tcb,def);
                       tcb.emit_ord_const(def.paras.count,u16inttype);
                       tcb.emit_ord_const(def.callerargareasize,ptrsinttype);
-                      tcb.emit_shortstring_const(sym.realname);
+                      tcb.emit_pooled_shortstring_const_ref(sym.realname);
 
                       for k:=0 to def.paras.count-1 do
                         begin
@@ -245,7 +244,8 @@ implementation
                           else
                             write_rtti_reference(tcb,para.vardef,fullrtti);
                           write_param_flag(tcb,para);
-                          tcb.emit_shortstring_const(para.realname);
+
+                          tcb.emit_pooled_shortstring_const_ref(para.realname);
 
                           write_paralocs(tcb,@para.paraloc[callerside]);
 
@@ -348,27 +348,64 @@ implementation
       var
         locs : trttiparalocs;
         i : longint;
+        pool : THashSet;
+        entry : PHashSetItem;
+        loclab : TAsmLabel;
+        loctcb : ttai_typedconstbuilder;
+        datadef : tdef;
       begin
         locs:=paramanager.cgparalocs_to_rttiparalocs(para^.location);
         if length(locs)>high(byte) then
           internalerror(2017010601);
-        tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
-        tcb.emit_ord_const(length(locs),u8inttype);
-        for i:=low(locs) to high(locs) do
+
+        if length(locs)=0 then
+          begin
+            { *shrugs* }
+            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+            exit;
+          end;
+
+        { do we have such a paraloc already in the pool? }
+        pool:=current_asmdata.ConstPools[sp_paraloc];
+
+        entry:=pool.FindOrAdd(@locs[0],length(locs)*sizeof(trttiparaloc));
+
+        if not assigned(entry^.Data) then
           begin
-            tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+            current_asmdata.getglobaldatalabel(loclab);
+
+            loctcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable,tcalo_apply_constalign]);
+
+            loctcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
               targetinfos[target_info.system]^.alignment.recordalignmin,
               targetinfos[target_info.system]^.alignment.maxCrecordalign);
-            tcb.emit_ord_const(locs[i].loctype,u8inttype);
-            tcb.emit_ord_const(locs[i].regsub,u8inttype);
-            tcb.emit_ord_const(locs[i].regindex,u16inttype);
-            { the corresponding type for aint is alusinttype }
-            tcb.emit_ord_const(locs[i].offset,alusinttype);
-            tcb.end_anonymous_record;
-          end;
-        tcb.end_anonymous_record;
+            loctcb.emit_ord_const(length(locs),u8inttype);
+            for i:=low(locs) to high(locs) do
+              begin
+                loctcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+                  targetinfos[target_info.system]^.alignment.recordalignmin,
+                  targetinfos[target_info.system]^.alignment.maxCrecordalign);
+                loctcb.emit_ord_const(locs[i].loctype,u8inttype);
+                loctcb.emit_ord_const(locs[i].regsub,u8inttype);
+                loctcb.emit_ord_const(locs[i].regindex,u16inttype);
+                { the corresponding type for aint is alusinttype }
+                loctcb.emit_ord_const(locs[i].offset,alusinttype);
+                loctcb.end_anonymous_record;
+              end;
+            datadef:=loctcb.end_anonymous_record;
+
+            current_asmdata.asmlists[al_typedconsts].concatList(
+              loctcb.get_final_asmlist(loclab,datadef,sec_rodata_norel,loclab.name,const_align(sizeof(pint)))
+            );
+
+            loctcb.free;
+
+            entry^.data:=loclab;
+          end
+        else
+          loclab:=TAsmLabel(entry^.Data);
+
+        tcb.emit_tai(Tai_const.Create_sym(loclab),voidpointertype);
       end;
 
 
@@ -416,13 +453,79 @@ implementation
       end;
 
 
-    procedure TRTTIWriter.write_record_init_flag(tcb:ttai_typedconstbuilder;value:longword);
+    function compare_mop_offset_entry(item1,item2:pointer):longint;
+      var
+        entry1: pmanagementoperator_offset_entry absolute item1;
+        entry2: pmanagementoperator_offset_entry absolute item2;
+      begin
+        if entry1^.offset<entry2^.offset then
+          result:=-1
+        else if entry1^.offset>entry2^.offset then
+          result:=1
+        else
+          result:=0;
+      end;
+
+
+    procedure TRTTIWriter.write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
+      var
+        list : tfplist;
+        datatcb : ttai_typedconstbuilder;
+        tbllbl : TAsmLabel;
+        entry : pmanagementoperator_offset_entry;
+        datadef,entrydef : tdef;
+        i : longint;
+        pdef : tobjectdef;
       begin
-        { keep this in sync with the type declaration of TRecordInfoInitFlag(s)
-          in both rttidecl.inc and typinfo.pp }
-        if target_info.endian=endian_big then
-          value:=reverse_longword(value);
-        tcb.emit_ord_const(value,u32inttype);
+        list:=tfplist.create;
+        tabstractrecordsymtable(def.symtable).get_managementoperator_offset_list(mop,list);
+        if (def.typ=objectdef) then
+          begin
+            pdef:=tobjectdef(def).childof;
+            while assigned(pdef) do
+              begin
+                tabstractrecordsymtable(pdef.symtable).get_managementoperator_offset_list(mop,list);
+                pdef:=pdef.childof;
+              end;
+            list.sort(@compare_mop_offset_entry);
+          end;
+        if list.count=0 then
+          tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype)
+        else
+          begin
+            tcb.start_internal_data_builder(current_asmdata.AsmLists[al_rtti],sec_rodata,'',datatcb,tbllbl);
+
+            datatcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
+              targetinfos[target_info.system]^.alignment.recordalignmin,
+              targetinfos[target_info.system]^.alignment.maxCrecordalign);
+            datatcb.emit_ord_const(list.count,u32inttype);
+
+            entrydef:=get_recorddef(itp_init_mop_offset_entry,[voidcodepointertype,sizeuinttype],defaultpacking);
+
+            for i:=0 to list.count-1 do
+              begin
+                entry:=pmanagementoperator_offset_entry(list[i]);
+
+                datatcb.maybe_begin_aggregate(entrydef);
+
+                datatcb.queue_init(voidcodepointertype);
+                datatcb.queue_emit_proc(entry^.pd);
+
+                datatcb.queue_init(sizeuinttype);
+                datatcb.queue_emit_ordconst(entry^.offset,sizeuinttype);
+
+                datatcb.maybe_end_aggregate(entrydef);
+
+                dispose(entry);
+              end;
+
+            datadef:=datatcb.end_anonymous_record;
+
+            tcb.finish_internal_data_builder(datatcb,tbllbl,datadef,sizeof(pint));
+
+            tcb.emit_tai(tai_const.Create_sym(tbllbl),voidpointertype);
+          end;
+        list.free;
       end;
 
 
@@ -1213,10 +1316,8 @@ implementation
            { store rtti management operators only for init table }
            if (rt=initrtti) then
              begin
-               riif:=0;
-               if def.has_non_trivial_init_child(false) then
-                 riif:=riif or riifNonTrivialChild;
-               write_record_init_flag(tcb,riif);
+               { for now records don't have the initializer table }
+               tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
                if (trecordsymtable(def.symtable).managementoperators=[]) then
                  tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype)
                else
@@ -1369,12 +1470,11 @@ implementation
             { pointer to management operators available only for initrtti }
             if (rt=initrtti) then
               begin
-                riif:=0;
-                if def.has_non_trivial_init_child(false) then
-                  riif:=riif or riifNonTrivialChild;
-                if assigned(def.childof) and def.childof.has_non_trivial_init_child(true) then
-                  riif:=riif or riifParentHasNonTrivialChild;
-                write_record_init_flag(tcb,riif);
+                { initializer table only available for classes currently }
+                if def.objecttype=odt_class then
+                  write_mop_offset_table(tcb,def,mop_initialize)
+                else
+                  tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
                 tcb.emit_tai(Tai_const.Create_nil_dataptr,voidpointertype);
               end;
             { enclosing record takes care of alignment }
@@ -1905,7 +2005,6 @@ implementation
           current_module.add_extern_asmsym(s,AB_EXTERNAL,AT_DATA);
       end;
 
-
     procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype);
       var
         tcb: ttai_typedconstbuilder;

compiler/ncgvmt.pas

@@ -69,15 +69,6 @@ interface
         procedure intf_create_vtbl(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint);
         procedure intf_gen_intf_ref(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint; interfaceentrydef, interfaceentrytypedef: tdef);
         procedure intf_write_table(tcb: ttai_typedconstbuilder; out lab: TAsmLabel; out intftabledef: trecorddef);
-        { get a table def of the form
-            record
-              count: countdef;
-              elements: array[0..count-1] of elementdef
-            end;
-          Returns both the outer record and the inner arraydef
-        }
-        procedure gettabledef(prefix: tinternaltypeprefix; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
-        function getrecorddef(prefix: tinternaltypeprefix; const fields: array of tdef; packrecords: shortint): trecorddef;
         { generates the message tables for a class }
         procedure genstrmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msgstrtabledef: trecorddef);
         procedure genintmsgtab(tcb: ttai_typedconstbuilder; out lab: tasmlabel; out msginttabledef: trecorddef);
@@ -302,7 +293,7 @@ implementation
            Instead of 0 as the upper bound, use the actual upper bound
          }
          msgstrentry:=search_system_type('TMSGSTRTABLE').typedef;
-         gettabledef(itp_vmt_tstringmesssagetable,s32inttype,msgstrentry,count,0,msgstrtabledef,msgarraydef);
+         get_tabledef(itp_vmt_tstringmesssagetable,s32inttype,msgstrentry,count,0,msgstrtabledef,msgarraydef);
          { outer record (TStringMessageTable) }
          datatcb.maybe_begin_aggregate(msgstrtabledef);
          datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
@@ -356,7 +347,7 @@ implementation
                 method : codepointer;
              end;
          }
-         msginttabledef:=getrecorddef(itp_vmt_intern_msgint_table,[u32inttype,voidcodepointertype],0);
+         msginttabledef:=get_recorddef(itp_vmt_intern_msgint_table,[u32inttype,voidcodepointertype],0);
          { from objpas.inc:
              TMsgInt = record
                 count : longint;
@@ -364,7 +355,7 @@ implementation
              end;
          }
          tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,datatcb,lab);
-         gettabledef(itp_vmt_msgint_table_entries,s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
+         get_tabledef(itp_vmt_msgint_table_entries,s32inttype,msginttabledef,count,0,msgintdef,msgintarrdef);
          datatcb.maybe_begin_aggregate(msgintdef);
          datatcb.emit_tai(Tai_const.Create_32bit(count),s32inttype);
          if assigned(root) then
@@ -549,7 +540,7 @@ implementation
                      addr : codepointer;
                   end;
               }
-              lists.methodnamerec:=getrecorddef(itp_vmt_intern_tmethodnamerec,[cpointerdef.getreusable(cshortstringtype),voidcodepointertype],1);
+              lists.methodnamerec:=get_recorddef(itp_vmt_intern_tmethodnamerec,[cpointerdef.getreusable(cshortstringtype),voidcodepointertype],1);
               { from objpas.inc:
                   tmethodnametable = packed record
                     count : dword;
@@ -557,7 +548,7 @@ implementation
                   end;
                }
               tcb.start_internal_data_builder(current_asmdata.AsmLists[al_const],sec_rodata,_class.vmt_mangledname,lists.pubmethodstcb,lab);
-              gettabledef(itp_vmt_intern_tmethodnametable,u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef);
+              get_tabledef(itp_vmt_intern_tmethodnametable,u32inttype,lists.methodnamerec,count,1,pubmethodsdef,pubmethodsarraydef);
               { begin tmethodnametable }
               lists.pubmethodstcb.maybe_begin_aggregate(pubmethodsdef);
               { emit count field }
@@ -881,63 +872,6 @@ implementation
       end;
 
 
-    procedure TVMTWriter.gettabledef(prefix: tinternaltypeprefix; countdef, elementdef: tdef; count: longint; packrecords: shortint; out recdef: trecorddef; out arrdef: tarraydef);
-      var
-        fields: tfplist;
-        name: TIDString;
-        srsym: tsym;
-        srsymtable: tsymtable;
-      begin
-        { already created a message string table with this number of elements
-          in this unit -> reuse the def }
-        name:=internaltypeprefixName[prefix]+tostr(count);
-        if searchsym_type(copy(name,2,length(name)),srsym,srsymtable) then
-          begin
-            recdef:=trecorddef(ttypesym(srsym).typedef);
-            arrdef:=tarraydef(trecordsymtable(recdef.symtable).findfieldbyoffset(countdef.size).vardef);
-            exit
-          end;
-        recdef:=crecorddef.create_global_internal(name,packrecords,
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
-        fields:=tfplist.create;
-        fields.add(countdef);
-        if count>0 then
-          begin
-            arrdef:=carraydef.create(0,count-1,sizeuinttype);
-            arrdef.elementdef:=elementdef;
-            fields.add(arrdef);
-          end
-        else
-          arrdef:=nil;
-        recdef.add_fields_from_deflist(fields);
-        fields.free;
-      end;
-
-
-    function TVMTWriter.getrecorddef(prefix: tinternaltypeprefix; const fields: array of tdef; packrecords: shortint): trecorddef;
-      var
-        fieldlist: tfplist;
-        srsym: tsym;
-        srsymtable: tsymtable;
-        i: longint;
-      begin
-        if searchsym_type(copy(internaltypeprefixName[prefix],2,length(internaltypeprefixName[prefix])),srsym,srsymtable) then
-          begin
-            result:=trecorddef(ttypesym(srsym).typedef);
-            exit
-          end;
-        fieldlist:=tfplist.create;
-        for i:=low(fields) to high(fields) do
-          fieldlist.add(fields[i]);
-        result:=crecorddef.create_global_internal(internaltypeprefixName[prefix],packrecords,
-          targetinfos[target_info.system]^.alignment.recordalignmin,
-          targetinfos[target_info.system]^.alignment.maxCrecordalign);
-        result.add_fields_from_deflist(fieldlist);
-        fieldlist.free;
-      end;
-
-
   { Write interface identifiers to the data section }
   procedure TVMTWriter.writeinterfaceids(list: TAsmList);
     var

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 201;
+  CurrentPPUVersion = 202;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }

compiler/symconst.pas

@@ -734,6 +734,7 @@ type
     itp_rtti_set_outer,
     itp_rtti_set_inner,
     itp_init_record_operators,
+    itp_init_mop_offset_entry,
     itp_threadvar_record,
     itp_objc_method_list,
     itp_objc_proto_list,
@@ -873,6 +874,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_set_outer$',
        '$rtti_set_inner$',
        '$init_record_operators$',
+       '$init_mop_offset_entry$',
        '$threadvar_record$',
        '$objc_method_list$',
        '$objc_proto_list$',

compiler/symdef.pas

@@ -1206,6 +1206,15 @@ interface
     function getparaencoding(def:tdef):tstringencoding; inline;
 
     function get_threadvar_record(def: tdef; out index_field, non_mt_data_field: tsym): trecorddef;
+    function get_recorddef(prefix:tinternaltypeprefix;const fields:array of tdef; packrecords:shortint): trecorddef;
+    { get a table def of the form
+        record
+          count: countdef;
+          elements: array[0..count-1] of elementdef
+        end;
+      Returns both the outer record and the inner arraydef
+    }
+    procedure get_tabledef(prefix:tinternaltypeprefix;countdef,elementdef:tdef;count:longint;packrecords:shortint;out recdef:trecorddef;out arrdef:tarraydef);
 
 implementation
 
@@ -1320,6 +1329,79 @@ implementation
       end;
 
 
+    function get_recorddef(prefix:tinternaltypeprefix; const fields:array of tdef; packrecords:shortint): trecorddef;
+      var
+        fieldlist: tfplist;
+        srsym: tsym;
+        srsymtable: tsymtable;
+        i: longint;
+        name : TIDString;
+      begin
+        name:=copy(internaltypeprefixName[prefix],2,length(internaltypeprefixName[prefix]));
+        if searchsym_type(name,srsym,srsymtable) then
+          begin
+            result:=trecorddef(ttypesym(srsym).typedef);
+            exit
+          end;
+        { also always search in the current module (symtables are popped for
+          RTTI related code already) }
+        if searchsym_in_module(pointer(current_module),name,srsym,srsymtable) then
+          begin
+            result:=trecorddef(ttypesym(srsym).typedef);
+            exit;
+          end;
+        fieldlist:=tfplist.create;
+        for i:=low(fields) to high(fields) do
+          fieldlist.add(fields[i]);
+        result:=crecorddef.create_global_internal(internaltypeprefixName[prefix],packrecords,
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+        result.add_fields_from_deflist(fieldlist);
+        fieldlist.free;
+      end;
+
+
+    procedure get_tabledef(prefix:tinternaltypeprefix;countdef,elementdef:tdef;count:longint;packrecords:shortint;out recdef:trecorddef;out arrdef:tarraydef);
+      var
+        fields: tfplist;
+        name: TIDString;
+        srsym: tsym;
+        srsymtable: tsymtable;
+      begin
+        { already created a message string table with this number of elements
+          in this unit -> reuse the def }
+        name:=internaltypeprefixName[prefix]+tostr(count);
+        if searchsym_type(copy(name,2,length(name)),srsym,srsymtable) then
+          begin
+            recdef:=trecorddef(ttypesym(srsym).typedef);
+            arrdef:=tarraydef(trecordsymtable(recdef.symtable).findfieldbyoffset(countdef.size).vardef);
+            exit
+          end;
+        { also always search in the current module (symtables are popped for
+          RTTI related code already) }
+        if searchsym_in_module(pointer(current_module),copy(name,2,length(name)),srsym,srsymtable) then
+          begin
+            recdef:=trecorddef(ttypesym(srsym).typedef);
+            arrdef:=tarraydef(trecordsymtable(recdef.symtable).findfieldbyoffset(countdef.size).vardef);
+            exit;
+          end;
+        recdef:=crecorddef.create_global_internal(name,packrecords,
+          targetinfos[target_info.system]^.alignment.recordalignmin,
+          targetinfos[target_info.system]^.alignment.maxCrecordalign);
+        fields:=tfplist.create;
+        fields.add(countdef);
+        if count>0 then
+          begin
+            arrdef:=carraydef.create(0,count-1,sizeuinttype);
+            arrdef.elementdef:=elementdef;
+            fields.add(arrdef);
+          end
+        else
+          arrdef:=nil;
+        recdef.add_fields_from_deflist(fields);
+        fields.free;
+      end;
+
     function make_mangledname(const typeprefix:TSymStr;st:TSymtable;const suffix:TSymStr):TSymStr;
       var
         s,

compiler/symtable.pas

@@ -91,6 +91,12 @@ interface
        tllvmshadowsymtable = class;
 {$endif llvm}
 
+       tmanagementoperator_offset_entry = record
+         pd : tprocdef;
+         offset : asizeint;
+       end;
+       pmanagementoperator_offset_entry = ^tmanagementoperator_offset_entry;
+
        tabstractrecordsymtable = class(tstoredsymtable)
 {$ifdef llvm}
        private
@@ -104,6 +110,7 @@ interface
           padalignment : shortint;   { size to a multiple of which the symtable has to be rounded up }
           recordalignmin,            { local equivalents of global settings, so that records can }
           maxCrecordalign: shortint; { be created with custom settings internally }
+          has_fields_with_mop : tmanagementoperators; { whether any of the fields has the need for a management operator (or one of the field's fields) }
           constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
           destructor destroy;override;
           procedure ppuload(ppufile:tcompilerppufile);override;
@@ -120,6 +127,10 @@ interface
           function is_packed: boolean;
           function has_single_field(out def:tdef): boolean;
           function get_unit_symtable: tsymtable;
+          { collects all management operators of the specified type in list (which
+            is not cleared); the entries are copies and thus must be freed by the
+            caller }
+          procedure get_managementoperator_offset_list(mop:tmanagementoperator;list:tfplist);
         protected
           { size in bytes including padding }
           _datasize      : asizeint;
@@ -128,8 +139,12 @@ interface
           databitsize    : asizeint;
           { size in bytes of padding }
           _paddingsize   : word;
+          { array of tmanagementoperator_offset_entry lists; only assigned if
+            they had been queried once by get_management_operator_list }
+          mop_list : array[tmanagementoperator] of tfplist;
           procedure setdatasize(val: asizeint);
           function getfieldoffset(sym: tfieldvarsym; base: asizeint; var globalfieldalignment: shortint): asizeint;
+          procedure do_get_managementoperator_offset_list(data:tobject;arg:pointer);
         public
           function iscurrentunit: boolean; override;
           property datasize : asizeint read _datasize write setdatasize;
@@ -479,7 +494,6 @@ implementation
                              TStoredSymtable
 *****************************************************************************}
 
-
     constructor tstoredsymtable.create(const s:string);
       begin
         inherited create(s);
@@ -1161,11 +1175,22 @@ implementation
 
 
     destructor tabstractrecordsymtable.destroy;
+      var
+        mop : tmanagementoperator;
+        mopofs : pmanagementoperator_offset_entry;
+        i : longint;
       begin
 {$ifdef llvm}
         if refcount=1 then
           fllvmst.free;
 {$endif llvm}
+        for mop in tmanagementoperator do
+          begin
+            if assigned(mop_list[mop]) then
+              for i:=0 to mop_list[mop].count-1 do
+                dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
+            mop_list[mop].free;
+          end;
         inherited destroy;
       end;
 
@@ -1179,6 +1204,7 @@ implementation
         recordalignmin:=shortint(ppufile.getbyte);
         if (usefieldalignment=C_alignment) then
           fieldalignment:=shortint(ppufile.getbyte);
+        ppufile.getsmallset(has_fields_with_mop);
         inherited ppuload(ppufile);
       end;
 
@@ -1196,6 +1222,10 @@ implementation
          ppufile.putbyte(byte(recordalignmin));
          if (usefieldalignment=C_alignment) then
            ppufile.putbyte(byte(fieldalignment));
+         { it's not really a "symtableoption", but loading this from the record
+           def requires storing the set in the recorddef at least between
+           ppuload and deref/derefimpl }
+         ppufile.putsmallset(has_fields_with_mop);
          ppufile.writeentry(ibrecsymtableoptions);
 
          inherited ppuwrite(ppufile);
@@ -1259,6 +1289,11 @@ implementation
         sym.visibility:=vis;
         { this symbol can't be loaded to a register }
         sym.varregable:=vr_none;
+        { management operators }
+        if sym.vardef.typ in [recorddef,objectdef] then
+          has_fields_with_mop:=has_fields_with_mop + tabstractrecordsymtable(tabstractrecorddef(sym.vardef).symtable).has_fields_with_mop;
+        if sym.vardef.typ=recorddef then
+          has_fields_with_mop:=has_fields_with_mop + trecordsymtable(trecorddef(sym.vardef).symtable).managementoperators;
         { Calculate field offset }
         l:=sym.getsize;
         vardef:=sym.vardef;
@@ -1608,6 +1643,74 @@ implementation
           result:=result.defowner.owner;
       end;
 
+
+    procedure tabstractrecordsymtable.do_get_managementoperator_offset_list(data:tobject;arg:pointer);
+      var
+        sym : tsym absolute data;
+        fsym : tfieldvarsym absolute data;
+        mop : tmanagementoperator absolute arg;
+        entry : pmanagementoperator_offset_entry;
+        sublist : tfplist;
+        i : longint;
+      begin
+        if sym.typ<>fieldvarsym then
+          exit;
+        if not is_record(fsym.vardef) and not is_object(fsym.vardef) and not is_cppclass(fsym.vardef) then
+          exit;
+        if not assigned(mop_list[mop]) then
+          internalerror(2018082303);
+
+        if is_record(fsym.vardef) then
+          begin
+            if mop in trecordsymtable(trecorddef(fsym.vardef).symtable).managementoperators then
+              begin
+                new(entry);
+                entry^.pd:=search_management_operator(mop,fsym.vardef);
+                if not assigned(entry^.pd) then
+                  internalerror(2018082302);
+                entry^.offset:=fsym.fieldoffset;
+                mop_list[mop].add(entry);
+              end;
+          end;
+
+        sublist:=tfplist.create;
+        tabstractrecordsymtable(tabstractrecorddef(fsym.vardef).symtable).get_managementoperator_offset_list(mop,sublist);
+        for i:=0 to sublist.count-1 do
+          begin
+            entry:=pmanagementoperator_offset_entry(sublist[i]);
+            entry^.offset:=entry^.offset+fsym.fieldoffset;
+            mop_list[mop].add(entry);
+          end;
+        { we don't need to remove the entries as they become part of list }
+        sublist.free;
+      end;
+
+    procedure tabstractrecordsymtable.get_managementoperator_offset_list(mop:tmanagementoperator;list:tfplist);
+      var
+        i : longint;
+        entry,entrycopy : pmanagementoperator_offset_entry;
+      begin
+        if not assigned(list) then
+          internalerror(2018082301);
+        if mop=mop_none then
+          exit;
+        if not (mop in has_fields_with_mop) then
+          { none of the fields or one of the field's fields has the requested operator }
+          exit;
+        if not assigned(mop_list[mop]) then
+          begin
+            mop_list[mop]:=tfplist.create;
+            SymList.ForEachCall(@do_get_managementoperator_offset_list,pointer(ptruint(mop)));
+          end;
+        for i:=0 to mop_list[mop].count-1 do
+          begin
+            entry:=pmanagementoperator_offset_entry(mop_list[mop][i]);
+            New(entrycopy);
+            entrycopy^:=entry^;
+            list.add(entrycopy);
+          end;
+      end;
+
     procedure tabstractrecordsymtable.setdatasize(val: asizeint);
       begin
         _datasize:=val;

compiler/utils/ppuutils/ppudump.pp

@@ -654,6 +654,8 @@ end;
                              Read Routines
 ****************************************************************************}
 
+function readmanagementoperatoroptions(const space : string;const name : string):tmanagementoperators;forward;
+
 procedure readrecsymtableoptions;
 var
   usefieldalignment : shortint;
@@ -669,6 +671,7 @@ begin
   writeln([space,' recordalignmin: ',shortint(ppufile.getbyte)]);
   if (usefieldalignment=C_alignment) then
     writeln([space,' fieldalignment: ',shortint(ppufile.getbyte)]);
+  readmanagementoperatoroptions(space,'Fields have MOPs');
 end;
 
 procedure readsymtableoptions(const s: string);
@@ -2330,7 +2333,7 @@ end;
 
 
 
-function readmanagementoperatoroptions(const space : string):tmanagementoperators;
+function readmanagementoperatoroptions(const space : string;const name : string):tmanagementoperators;
 { type is in unit symconst }
 { Management operator options
   tmanagementoperator=(
@@ -2366,7 +2369,8 @@ begin
          if first then
            begin
              write(space);
-             write('Management operators: ');
+             write(name);
+             write(': ');
              first:=false;
            end
          else
@@ -3360,7 +3364,7 @@ begin
                  objdef.Size:=getasizeint;
                  writeln([space,'         DataSize : ',objdef.Size]);
                  writeln([space,'      PaddingSize : ',getword]);
-                 readmanagementoperatoroptions(space);
+                 readmanagementoperatoroptions(space,'Management operators');
                end;
              {read the record definitions and symbols}
              if not(df_copied_def in current_defoptions) then

rtl/inc/objpas.inc

@@ -382,8 +382,9 @@
 {$ifndef VER3_0}
         var
            vmt  : PVmt;
-           temp : pointer;
-           flags : TRecordInfoInitFlags;
+           inittable : pointer;
+           mopinittable : PRTTIRecordOpOffsetTable;
+           i : longint;
 {$endif VER3_0}
         begin
            { the size is saved at offset 0 }
@@ -397,23 +398,22 @@
 {$ifndef VER3_0}
            { for management operators like initialize call int_initialize }
            vmt := PVmt(self);
-           while vmt<>nil do
+           if assigned(vmt) then
              begin
-               Temp:= vmt^.vInitTable;
-               if assigned(Temp) then
+               inittable:=vmt^.vInitTable;
+               if assigned(inittable) then
                  begin
-                   flags:=RecordRTTIInitFlags(Temp);
-                   if riifNonTrivialChild in flags then
-                     { The RTTI format matches one for records, except the type
-                       is tkClass. Since RecordRTTI does not check the type,
-                       calling it yields the desired result. }
-                     RecordRTTI(Instance,Temp,@int_initialize);
-                   { no need to continue complex initializing up the inheritance
-                     tree if none of the parents require it anyway }
-                   if not (riifParentHasNonTrivialChild in flags) then
-                     break;
+                   mopinittable:=RTTIRecordMopInitTable(inittable);
+                   if assigned(mopinittable) then
+                     begin
+                       {$push}
+                       { ensure that no range check errors pop up with the [0..0] array }
+                       {$R-}
+                       for i:=0 to mopinittable^.Count-1 do
+                         TRTTIRecVarOp(mopinittable^.Entries[i].ManagmentOperator)(PByte(Instance)+mopinittable^.Entries[i].FieldOffset);
+                       {$pop}
+                     end;
                  end;
-               vmt:= vmt^.vParent;
              end;
 {$endif VER3_0}
 

rtl/inc/rtti.inc

@@ -138,10 +138,10 @@ end;
 
 
 {$ifndef VER3_0}
-function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags;
+function RTTIRecordMopInitTable(ti: Pointer): PRTTIRecordOpOffsetTable;
 begin
   ti:=aligntoqword(ti+2+PByte(ti)[1]);
-  Result:=PRecordInfoInit(ti)^.Flags;
+  Result:=PRecordInfoInit(ti)^.InitRecordOpTable;
 end;
 {$endif VER3_0}
 

rtl/inc/rttidecl.inc

@@ -92,24 +92,24 @@ type
     Copy: TRTTIRecCopyOp;
   end;
 
-{$ifndef VER3_0}
-{$push}
-
-{ better alignment for TRecordInfoInit }
-{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and typinfo.pp }
-{ ToDo: different values for 8/16-bit platforms? }
-{$minenumsize 4}
-{$packset 4}
-
-  TRecordInfoInitFlag = (
-    riifNonTrivialChild,
-    { only relevant for classes }
-    riifParentHasNonTrivialChild
-  );
-  TRecordInfoInitFlags = set of TRecordInfoInitFlag;
+  TRTTIRecordOpOffsetEntry =
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    ManagmentOperator: CodePointer;
+    FieldOffset: SizeUInt;
+  end;
 
-{$pop}
-{$endif}
+  TRTTIRecordOpOffsetTable =
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Count: LongWord;
+    Entries: array[0..0] of TRTTIRecordOpOffsetEntry;
+  end;
+  PRTTIRecordOpOffsetTable = ^TRTTIRecordOpOffsetTable;
 
   TRecordInfoInit=
 {$ifdef USE_PACKED}
@@ -119,7 +119,7 @@ type
     Terminator: Pointer;
     Size: Longint;
 {$ifndef VER3_0}
-    Flags: TRecordInfoInitFlags;
+    InitRecordOpTable: PRTTIRecordOpOffsetTable;
     RecordOp: PRTTIRecordOpVMT;
 {$endif VER3_0}
     Count: Longint;
@@ -148,7 +148,7 @@ type
 
 
 {$ifndef VER3_0}
-function RecordRTTIInitFlags(ti: Pointer): TRecordInfoInitFlags; forward;
+function RTTIRecordMopInitTable(ti: Pointer): PRTTIRecordOpOffsetTable; forward;
 {$endif VER3_0}
 
 {$ifdef VER3_0}

rtl/objpas/typinfo.pp

@@ -328,15 +328,15 @@ unit TypInfo;
       {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
       private
-        function GetParaLocs: PParameterLocations; inline;
         function GetTail: Pointer; inline;
         function GetNext: PVmtMethodParam; inline;
+        function GetName: ShortString; inline;
       public
         ParamType: PPTypeInfo;
         Flags: TParamFlags;
-        Name: ShortString;
-        { ParaLocs: TParameterLocations; }
-        property ParaLocs: PParameterLocations read GetParaLocs;
+        NamePtr: PShortString;
+        ParaLocs: PParameterLocations;
+        property Name: ShortString read GetName;
         property Tail: Pointer read GetTail;
         property Next: PVmtMethodParam read GetNext;
       end;
@@ -352,15 +352,17 @@ unit TypInfo;
         function GetResultLocs: PParameterLocations; inline;
         function GetTail: Pointer; inline;
         function GetNext: PIntfMethodEntry; inline;
+        function GetName: ShortString; inline;
       public
         ResultType: PPTypeInfo;
         CC: TCallConv;
         Kind: TMethodKind;
         ParamCount: Word;
         StackSize: SizeInt;
-        Name: ShortString;
+        NamePtr: PShortString;
         { Params: array[0..ParamCount - 1] of TVmtMethodParam }
-        { ResultLocs: TParameterLocations (if ResultType != Nil) }
+        { ResultLocs: PParameterLocations (if ResultType != Nil) }
+        property Name: ShortString read GetName;
         property Param[Index: Word]: PVmtMethodParam read GetParam;
         property ResultLocs: PParameterLocations read GetResultLocs;
         property Tail: Pointer read GetTail;
@@ -408,25 +410,24 @@ unit TypInfo;
         Entries: array[0..0] of TVmtMethodEntry;
       end;
 
+      TRecOpOffsetEntry =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        ManagementOperator: CodePointer;
+        FieldOffset: SizeUInt;
+      end;
 
-{$ifndef VER3_0}
-{$push}
-
-{ better alignment for TRecordInfoInit }
-{ keep in sync with ncgrtti.TRTTIWriter.write_record_init_flag() and rttidecl.inc }
-{ ToDo: different values for 8/16-bit platforms? }
-{$minenumsize 4}
-{$packset 4}
-
-      TRecordInfoInitFlag = (
-        riifNonTrivialChild,
-        { only relevant for classes }
-        riifParentHasNonTrivialChild
-      );
-      TRecordInfoInitFlags = set of TRecordInfoInitFlag;
-
-{$pop}
-{$endif}
+      TRecOpOffsetTable =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+        Count: LongWord;
+        Entries: array[0..0] of TRecOpOffsetEntry;
+      end;
+      PRecOpOffsetTable = ^TRecOpOffsetTable;
 
       PRecInitData = ^TRecInitData;
       TRecInitData =
@@ -437,7 +438,7 @@ unit TypInfo;
         Terminator: Pointer;
         Size: Integer;
 {$ifndef VER3_0}
-        Flags: TRecordInfoInitFlags;
+        InitOffsetOp: PRecOpOffsetTable;
         ManagementOp: Pointer;
 {$endif}
         ManagedFieldCount: Integer;
@@ -2960,14 +2961,9 @@ end;
 
 { TVmtMethodParam }
 
-function TVmtMethodParam.GetParaLocs: PParameterLocations;
-begin
-  Result := PParameterLocations(aligntoptr(PByte(@Name[0]) + Length(Name) + Sizeof(Name[0])));
-end;
-
 function TVmtMethodParam.GetTail: Pointer;
 begin
-  Result := ParaLocs^.Tail;
+  Result := PByte(@ParaLocs) + SizeOf(ParaLocs);
 end;
 
 function TVmtMethodParam.GetNext: PVmtMethodParam;
@@ -2975,6 +2971,11 @@ begin
   Result := PVmtMethodParam(aligntoptr(Tail));
 end;
 
+function TVmtMethodParam.GetName: ShortString;
+begin
+  Result := NamePtr^;
+end;
+
 { TIntfMethodEntry }
 
 function TIntfMethodEntry.GetParam(Index: Word): PVmtMethodParam;
@@ -2982,39 +2983,24 @@ begin
   if Index >= ParamCount then
     Result := Nil
   else
-    begin
-      Result := PVmtMethodParam(aligntoptr(PByte(@Name[0]) + SizeOf(Name[0]) + Length(Name)));
-      while Index > 0 do
-        begin
-          Result := Result^.Next;
-          Dec(Index);
-        end;
-    end;
+    Result := PVmtMethodParam(PByte(aligntoptr(PByte(@NamePtr) + SizeOf(NamePtr))) + Index * PtrUInt(aligntoptr(Pointer(SizeOf(TVmtMethodParam)))));
 end;
 
 function TIntfMethodEntry.GetResultLocs: PParameterLocations;
 begin
   if not Assigned(ResultType) then
     Result := Nil
-  else if ParamCount = 0 then
-    Result := PParameterLocations(aligntoptr(PByte(@Name[0]) + SizeOf(Name[0]) + Length(Name)))
   else
-    Result := PParameterLocations(aligntoptr(Param[ParamCount - 1]^.Tail));
+    Result := PParameterLocations(PByte(aligntoptr(PByte(@NamePtr) + SizeOf(NamePtr))) + ParamCount * PtrUInt(aligntoptr(Pointer(SizeOf(TVmtMethodParam)))));
 end;
 
 function TIntfMethodEntry.GetTail: Pointer;
-var
-  retloc: PParameterLocations;
 begin
+  Result := PByte(@NamePtr) + SizeOf(NamePtr);
+  if ParamCount > 0 then
+    Result := PByte(aligntoptr(Result)) + ParamCount * PtrUInt(aligntoptr(Pointer(SizeOf(TVmtMethodParam))));
   if Assigned(ResultType) then
-    begin
-      retloc := ResultLocs;
-      Result := PByte(@retloc^.Count) + SizeOf(retloc^.Count) + SizeOf(TParameterLocation) * retloc^.Count;
-    end
-  else if ParamCount = 0 then
-    Result := PByte(@Name[0]) + Length(Name) + SizeOf(Byte)
-  else
-    Result := Param[ParamCount - 1]^.Tail;
+    Result := PByte(aligntoptr(Result)) + SizeOf(PParameterLocations);
 end;
 
 function TIntfMethodEntry.GetNext: PIntfMethodEntry;
@@ -3022,6 +3008,11 @@ begin
   Result := PIntfMethodEntry(aligntoptr(Tail));
 end;
 
+function TIntfMethodEntry.GetName: ShortString;
+begin
+  Result := NamePtr^;
+end;
+
 { TIntfMethodTable }
 
 function TIntfMethodTable.GetMethod(Index: Word): PIntfMethodEntry;