Add support for new record operators (management operators): Initialize, Finalize. They working like low level auto-executed constructor/destructor for records.

rtl/objpas/typinfo.pp, TTypeData:
  + new field RecInitTable, pointer to init table

rtl/inc/rtti.inc:
  * rename TRecordInfo to TRecordInfoFull, is realated to fullrtti (rtti table)
  + new field for TRecordInfoFull: InitTable (pointer to init table)
  + new record TRecordInfoInit, related to initrtti (init table)
  + new record TRTTIRecordOpVMT to handle record management operators (has 2 reserved slots for addref and copy operators)
  + new function RTTIRecordOp to obtain init table pointer and record management operators (both are related)
  * adjust existing code to new RTTI. Affected functions: RecordRTTI, fpc_Initialize, fpc_finalize, fpc_Addref, fpc_Copy
  
rtl/inc/objpas.inc, TObject.InitInstance:
  * allow to call Initialize operator for object fields

tokens.pas:
  - temporary remove _OP_COPY token

symtable.pas:
  + trecordsymtable: new field managementoperators for storing included management operators
  + trecordsymtable: new method includemanagementoperator to include new management operator
  + new function search_management_operator
  + new const managementoperator2tok for conversion tmanagementoperator to ttoken

symdef.pas:
  * store set trecordsymtable.managementoperators into ppu file
  * add new condition into trecorddef.needs_inittable (returns true when any of management operators is used)

symconst.pas:
  + new enum tmanagementoperator and related set tmanagementoperators for storing new operators Initialize, Finalize and for future operators: addref and copy
  + new item itp_init_record_operators in tinternaltypeprefix enum for storing management operators into init table
  + new position '$init_record_operators$' in internaltypeprefixName const, related to itp_init_record_operators
  
ppu.pas:
  * increase ppu version (CurrentPPUVersion), related to new trecordsymtable.managementoperators

pdecsub.pas:
  * add new operators tokens _INITIALIZE, _FINALIZE into parse_operator_name function
  * parse_proc_dec_finish: class operator is always static so always include po_staticmethod into pd.procoptions for potype_operator
  * parse_proc_dec_finish: parse in correct way new operators (first class operators without result)

ncgrtti.pas:
  + new procedure write_record_operators for storing management operators
  * recorddef_rtti: init rtti and full rtti is different for better performance and for less memory usage (see TRecordInfoFull and TRecordInfoInit in rtl/inc/rtti.inc). Allow to save initrtti for fullrtti, guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref. Related to 

trtti10.pp test.
  * objectdef_rtti_fields: adjust rtti for objects to new rtti.

htypechk.pas:
  + new Ttok2opRec record
  + new tok2op const for conversion ttoken to tmanagementoperator
  + new function token2managementoperator

hlcgobj.pas, thlcgobj.initialize_data:
  * allow checking global variables (affects only records and classic pascal objects) for management operators. In the case of management operator, "initialize data node" is needed.

+ added tests

git-svn-id: branches/maciej/smart_pointers@33200 -

.gitattributes

@@ -12629,7 +12629,13 @@ tests/test/toperator85.pp svneol=native#text/pascal
 tests/test/toperator86.pp svneol=native#text/pascal
 tests/test/toperator87.pp svneol=native#text/pascal
 tests/test/toperator88.pp svneol=native#text/pascal
+tests/test/toperator89.pp svneol=native#text/pascal
 tests/test/toperator9.pp svneol=native#text/pascal
+tests/test/toperator90.pp svneol=native#text/pascal
+tests/test/toperator91.pp svneol=native#text/pascal
+tests/test/toperator92.pp svneol=native#text/pascal
+tests/test/toperator93.pp svneol=native#text/pascal
+tests/test/toperator94.pp svneol=native#text/pascal
 tests/test/toperatorerror.pp svneol=native#text/plain
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain
@@ -12770,6 +12776,7 @@ tests/test/trstr6.pp svneol=native#text/plain
 tests/test/trstr7.pp svneol=native#text/plain
 tests/test/trstr8.pp svneol=native#text/plain
 tests/test/trtti1.pp svneol=native#text/plain
+tests/test/trtti10.pp svneol=native#text/pascal
 tests/test/trtti2.pp svneol=native#text/plain
 tests/test/trtti3.pp svneol=native#text/plain
 tests/test/trtti4.pp svneol=native#text/plain

compiler/hlcgobj.pas

@@ -4682,7 +4682,18 @@ implementation
       OldAsmList : TAsmList;
       hp : tnode;
     begin
-      if (tsym(p).typ = localvarsym) and
+      if ((tsym(p).typ = localvarsym) or
+          { check staticvarsym for record management opeators and for objects}
+          ((tsym(p).typ = staticvarsym) and
+           (
+            (tabstractvarsym(p).vardef is trecorddef) or
+            (
+             (tabstractvarsym(p).vardef is tobjectdef) and
+             (tobjectdef(tabstractvarsym(p).vardef).objecttype = odt_object)
+            )
+           )
+          )
+         ) and
          { local (procedure or unit) variables only need initialization if
            they are used }
          ((tabstractvarsym(p).refs>0) or

compiler/htypechk.pas

@@ -39,6 +39,11 @@ interface
         op_overloading_supported : boolean;
       end;
 
+      Ttok2opRec=record
+        tok : ttoken;
+        managementoperator: tmanagementoperator;
+      end;
+
       pcandidate = ^tcandidate;
       tcandidate = record
          next         : pcandidate;
@@ -132,10 +137,17 @@ interface
         (tok:_OP_DEC     ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported }
       );
 
+      tok2ops=2;
+      tok2op: array[1..tok2ops] of ttok2oprec = (
+        (tok:_OP_INITIALIZE; managementoperator: mop_initialize),
+        (tok:_OP_FINALIZE  ; managementoperator: mop_finalize)
+      );
+
       { true, if we are parsing stuff which allows array constructors }
       allow_array_constructor : boolean = false;
 
     function node2opstr(nt:tnodetype):string;
+    function token2managementoperator(optoken : ttoken): tmanagementoperator;
 
     { check operator args and result type }
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
@@ -217,6 +229,18 @@ implementation
             end;
        end;
 
+    function token2managementoperator(optoken: ttoken): tmanagementoperator;
+    var
+      i : integer;
+    begin
+      result:=mop_none;
+      for i:=1 to tok2ops do
+        if tok2op[i].tok=optoken then
+          begin
+            result:=tok2op[i].managementoperator;
+            break;
+          end;
+     end;
 
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
 

compiler/ncgrtti.pas

@@ -840,6 +840,51 @@ implementation
         end;
 
         procedure recorddef_rtti(def:trecorddef);
+
+          procedure write_record_operators;
+          var
+            rttilab: Tasmsymbol;
+            rttidef: tdef;
+            tcb: ttai_typedconstbuilder;
+            mop: tmanagementoperator;
+            procdef: tprocdef;
+          begin
+            rttilab := current_asmdata.DefineAsmSymbol(
+                internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),
+                AB_GLOBAL,AT_DATA);
+            tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable]);
+
+            tcb.begin_anonymous_record(
+              rttilab.Name,
+              defaultpacking,reqalign,
+              targetinfos[target_info.system]^.alignment.recordalignmin,
+              targetinfos[target_info.system]^.alignment.maxCrecordalign
+            );
+
+            { use "succ" to omit first enum item "mop_none" }
+            for mop := succ(low(tmanagementoperator)) to high(tmanagementoperator) do
+            begin
+              if not (mop in trecordsymtable(def.symtable).managementoperators) then
+                tcb.emit_tai(Tai_const.Create_nil_codeptr,voidcodepointertype)
+              else
+                begin
+                  procdef := search_management_operator(mop, def);
+                  if procdef = nil then
+                    internalerror(201603021)
+                  else
+                    tcb.emit_tai(Tai_const.Createname(procdef.mangledname,AT_FUNCTION,0),
+                      cprocvardef.getreusableprocaddr(procdef));
+                end;
+            end;
+
+            rttidef := tcb.end_anonymous_record;
+
+            current_asmdata.AsmLists[al_rtti].concatList(
+              tcb.get_final_asmlist(rttilab,rttidef,sec_rodata,rttilab.name,
+              const_align(sizeof(pint))));
+            tcb.free;
+          end;
+
         begin
            write_header(tcb,def,tkRecord);
            { need extra reqalign record, because otherwise the u32 int will
@@ -849,8 +894,33 @@ implementation
              targetinfos[target_info.system]^.alignment.recordalignmin,
              targetinfos[target_info.system]^.alignment.maxCrecordalign);
            tcb.emit_ord_const(def.size,u32inttype);
+
+           { store rtti management operators only for init table }
+           if (rt=initrtti) then
+           begin
+             tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+             if (trecordsymtable(def.symtable).managementoperators=[]) then
+               tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype)
+             else
+               tcb.emit_tai(Tai_const.Createname(
+                 internaltypeprefixName[itp_init_record_operators]+def.rtti_mangledname(rt),AT_DATA,0),voidpointertype);
+           end else
+           begin
+             Include(def.defstates, ds_init_table_used);
+             write_rtti_reference(tcb,def,initrtti);
+           end;
+
            fields_write_rtti_data(tcb,def,rt);
            tcb.end_anonymous_record;
+
+           { write pointers to operators if needed }
+           if (rt=initrtti) and (trecordsymtable(def.symtable).managementoperators<>[]) then
+             write_record_operators;
+
+           { guarantee initrtti for any record for fpc_initialize, fpc_finalize, fpc_copy and fpc_addref }
+           if (rt = fullrtti) and (ds_init_table_used in def.defstates) and
+              not (ds_init_table_written in def.defstates) then
+             write_rtti(def, initrtti);
         end;
 
 
@@ -1033,6 +1103,10 @@ implementation
           procedure objectdef_rtti_fields(def:tobjectdef);
           begin
             tcb.emit_ord_const(def.size, u32inttype);
+            { inittable terminator for vmt vInitTable }
+            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
+            { pointer to management operators }
+            tcb.emit_tai(Tai_const.Create_nil_codeptr,voidpointertype);
             { enclosing record takes care of alignment }
             fields_write_rtti_data(tcb,def,rt);
           end;

compiler/pdecsub.pas

@@ -593,6 +593,8 @@ implementation
                     _EXPLICIT:optoken:=_OP_EXPLICIT;
                     _INC:optoken:=_OP_INC;
                     _DEC:optoken:=_OP_DEC;
+                    _INITIALIZE:optoken:=_OP_INITIALIZE;
+                    _FINALIZE:optoken:=_OP_FINALIZE;
                     else
                     if (m_delphi in current_settings.modeswitches) then
                       case lastidtoken of
@@ -1390,7 +1392,11 @@ implementation
               if pd.parast.symtablelevel>normal_function_level then
                 Message(parser_e_no_local_operator);
               if isclassmethod then
+              begin
                 include(pd.procoptions,po_classmethod);
+                { any class operator is also static }
+                include(pd.procoptions,po_staticmethod);
+              end;
               if token<>_ID then
                 begin
                    if not(m_result in current_settings.modeswitches) then
@@ -1401,40 +1407,54 @@ implementation
                   pd.resultname:=stringdup(orgpattern);
                   consume(_ID);
                 end;
-              if not try_to_consume(_COLON) then
+
+              { operators without result }
+              if optoken in [_OP_INITIALIZE, _OP_FINALIZE] then
                 begin
-                  consume(_COLON);
-                  pd.returndef:=generrordef;
-                  consume_all_until(_SEMICOLON);
+                  if (pd.parast.SymList.Count <> 1) or
+                     (tparavarsym(pd.parast.SymList[0]).vardef<>pd.struct) or
+                     (tparavarsym(pd.parast.SymList[0]).varspez<>vs_var) then
+                    Message(parser_e_overload_impossible);
+
+                  trecordsymtable(pd.procsym.Owner).includemanagementoperator(
+                    token2managementoperator(optoken));
+                  pd.returndef:=voidtype
                 end
               else
-               begin
-                 read_returndef(pd);
-                 { check that class operators have either return type of structure or }
-                 { at least one argument of that type                                 }
-                 if (po_classmethod in pd.procoptions) and
-                    (pd.returndef <> pd.struct) then
-                   begin
-                     found:=false;
-                     for i := 0 to pd.parast.SymList.Count - 1 do
-                       if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
-                         begin
-                           found:=true;
-                           break;
-                         end;
-                     if not found then
-                       if assigned(pd.struct) then
-                         Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
-                       else
-                         MessagePos(pd.fileinfo,type_e_type_id_expected);
-                   end;
-                 if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
-                    equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
-                    (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
-                   message(parser_e_no_such_assignment)
-                 else if not isoperatoracceptable(pd,optoken) then
-                   Message(parser_e_overload_impossible);
-               end;
+                if not try_to_consume(_COLON) then
+                  begin
+                    consume(_COLON);
+                    pd.returndef:=generrordef;
+                    consume_all_until(_SEMICOLON);
+                  end
+                else
+                 begin
+                   read_returndef(pd);
+                   { check that class operators have either return type of structure or }
+                   { at least one argument of that type                                 }
+                   if (po_classmethod in pd.procoptions) and
+                      (pd.returndef <> pd.struct) then
+                     begin
+                       found:=false;
+                       for i := 0 to pd.parast.SymList.Count - 1 do
+                         if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then
+                           begin
+                             found:=true;
+                             break;
+                           end;
+                       if not found then
+                         if assigned(pd.struct) then
+                           Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName)
+                         else
+                           MessagePos(pd.fileinfo,type_e_type_id_expected);
+                     end;
+                   if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and
+                      equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and
+                      (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then
+                     message(parser_e_no_such_assignment)
+                   else if not isoperatoracceptable(pd,optoken) then
+                     Message(parser_e_overload_impossible);
+                 end;
             end;
           else
             internalerror(2015052202);

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 181;
+  CurrentPPUVersion = 182;
 
   ppubufsize   = 16384;
 

compiler/symconst.pas

@@ -572,6 +572,15 @@ type
   );
   tvaroptions=set of tvaroption;
 
+  tmanagementoperator=(mop_none,
+    mop_initialize,
+    mop_finalize,
+    { reserved for future usage }
+    mop_addref,
+    mop_copy
+  );
+  tmanagementoperators=set of tmanagementoperator;
+
   { register variable }
   tvarregable=(vr_none,
     vr_intreg,
@@ -690,6 +699,7 @@ type
     itp_rtti_normal_array,
     itp_rtti_dyn_array,
     itp_rtti_proc_param,
+    itp_init_record_operators,
     itp_threadvar_record,
     itp_objc_method_list,
     itp_objc_proto_list,
@@ -826,6 +836,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
        '$rtti_normal_array$',
        '$rtti_dyn_array$',
        '$rtti_proc_param$',
+       '$init_record_operators$',
        '$threadvar_record$',
        '$objc_method_list$',
        '$objc_proto_list$',

compiler/symdef.pas

@@ -4385,6 +4385,7 @@ implementation
              trecordsymtable(symtable).recordalignmin:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).datasize:=ppufile.getasizeint;
              trecordsymtable(symtable).paddingsize:=ppufile.getword;
+             ppufile.getsmallset(trecordsymtable(symtable).managementoperators);
              trecordsymtable(symtable).ppuload(ppufile);
              { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                but because iso mode supports no units, there is no need to store the variantrecdesc
@@ -4423,7 +4424,8 @@ implementation
 
     function trecorddef.needs_inittable : boolean;
       begin
-        needs_inittable:=trecordsymtable(symtable).needs_init_final
+        needs_inittable:=(trecordsymtable(symtable).managementoperators<>[]) or
+          trecordsymtable(symtable).needs_init_final
       end;
 
     function trecorddef.needs_separate_initrtti : boolean;
@@ -4510,6 +4512,7 @@ implementation
              ppufile.putbyte(byte(trecordsymtable(symtable).recordalignmin));
              ppufile.putasizeint(trecordsymtable(symtable).datasize);
              ppufile.putword(trecordsymtable(symtable).paddingsize);
+             ppufile.putsmallset(trecordsymtable(symtable).managementoperators);
              { the variantrecdesc is needed only for iso-like new statements new(prec,1,2,3 ...);
                but because iso mode supports no units, there is no need to store the variantrecdesc
                in the ppu

compiler/symtable.pas

@@ -135,8 +135,15 @@ interface
 
        trecordsymtable = class(tabstractrecordsymtable)
        public
+          { maybe someday is worth to move managementoperators to              }
+          { tabstractrecordsymtable to perform management class operators for  }
+          { object/classes. In XE5 and newer is possible to use class operator }
+          { for classes (like for Delphi .NET before) only for Delphi NEXTGEN  }
+          managementoperators : tmanagementoperators;
+
           constructor create(const n:string;usealign,recordminalign,recordmaxCalign:shortint);
           procedure insertunionst(unionst : trecordsymtable;offset : longint);
+          procedure includemanagementoperator(mop:tmanagementoperator);
        end;
 
        tObjectSymtable = class(tabstractrecordsymtable)
@@ -338,6 +345,7 @@ interface
     function  search_struct_member_no_helper(pd : tabstractrecorddef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
     function  search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
+    function  search_management_operator(mop:tmanagementoperator;pd:Tdef):Tprocdef;
     { searches for the helper definition that's currently active for pd }
     function  search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
     { searches whether the symbol s is available in the currently active }
@@ -422,11 +430,18 @@ interface
     { _OP_EXPLICIT   }  'explicit',
     { _OP_ENUMERATOR }  'enumerator',
     { _OP_INITIALIZE }  'initialize',
-    { _OP_COPY       }  'copy',
     { _OP_FINALIZE   }  'finalize',    
     { _OP_INC        }  'inc',
     { _OP_DEC        }  'dec');
 
+      managementoperator2tok:array[tmanagementoperator] of ttoken = (
+    { mop_none       }  NOTOKEN,
+    { mop_initialize }  _OP_INITIALIZE,
+    { mop_finalize   }  _OP_FINALIZE,
+
+    { reserved for future usage }
+    { mop_addref     }  NOTOKEN,
+    { mop_copy       }  NOTOKEN);
 
 
 implementation
@@ -1722,6 +1737,14 @@ implementation
       end;
 
 
+    procedure trecordsymtable.includemanagementoperator(mop: tmanagementoperator);
+      begin
+        if mop in managementoperators then
+          exit;
+        include(managementoperators,mop);
+      end;
+
+
 {****************************************************************************
                               TObjectSymtable
 ****************************************************************************}
@@ -3718,6 +3741,31 @@ implementation
     end;
 
 
+    function search_management_operator(mop: tmanagementoperator; pd: Tdef): Tprocdef;
+      var
+        sym : Tprocsym;
+        hashedid : THashedIDString;
+        optoken: ttoken;
+      begin
+        optoken := managementoperator2tok[mop];
+        if (optoken<first_managment_operator) or
+           (optoken>last_managment_operator) then
+          internalerror(201602280);
+        hashedid.id:=overloaded_names[optoken];
+        if not (pd.typ in [recorddef]) then
+          internalerror(201602281);
+        sym:=Tprocsym(tabstractrecorddef(pd).symtable.FindWithHash(hashedid));
+        if sym<>nil then
+          begin
+            if sym.typ<>procsym then
+              internalerror(201602282);
+            result:=sym.find_procdef_bytype(potype_operator);
+          end
+        else
+          result:=nil;
+      end;
+
+
     function search_system_type(const s: TIDString): ttypesym;
       var
         sym : tsym;

compiler/tokens.pas

@@ -57,7 +57,6 @@ type
     _OP_EXPLICIT,
     _OP_ENUMERATOR,
     _OP_INITIALIZE,
-    _OP_COPY,
     _OP_FINALIZE,    
     _OP_INC,
     _OP_DEC,
@@ -132,7 +131,6 @@ type
     _VAR,
     _XOR,
     _CASE,
-    _COPY,
     _CVAR,
     _ELSE,
     _EXIT,
@@ -385,7 +383,6 @@ const
       (str:'explicit'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'enumerator'    ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'initialize'    ;special:true ;keyword:[m_none];op:NOTOKEN),
-      (str:'copy'          ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'finalize'      ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'inc'           ;special:true ;keyword:[m_none];op:NOTOKEN),
       (str:'dec'           ;special:true ;keyword:[m_none];op:NOTOKEN),
@@ -460,7 +457,6 @@ const
       (str:'VAR'           ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'XOR'           ;special:false;keyword:alllanguagemodes;op:_OP_XOR),
       (str:'CASE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
-      (str:'COPY'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CVAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'ELSE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'EXIT'          ;special:false;keyword:[m_none];op:NOTOKEN),

rtl/inc/objpas.inc

@@ -327,6 +327,9 @@
 
       class function TObject.InitInstance(instance : pointer) : tobject; {$ifdef SYSTEMINLINE} inline; {$ENDIF}
 
+        var
+           vmt  : PVmt;
+           temp : pointer;
         begin
            { the size is saved at offset 0 }
            fillchar(instance^, InstanceSize, 0);
@@ -335,6 +338,19 @@
            ppointer(instance)^:=pointer(self);
            if PVmt(self)^.vIntfTable <> @emptyintf then
              InitInterfacePointers(self,instance);
+
+           { for record operators like initialize/finalize call int_initialize }
+           vmt := PVmt(self);
+           while vmt<>nil do
+             begin
+               Temp:= vmt^.vInitTable;
+               { 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. }
+               if Assigned(Temp) then
+                 RecordRTTI(Instance,Temp,@int_initialize);
+               vmt:= vmt^.vParent;
+             end;
+
            InitInstance:=TObject(Instance);
         end;
 

rtl/inc/rtti.inc

@@ -38,13 +38,41 @@ type
     {$endif}
   end;
 
-  PRecordInfo=^TRecordInfo;
-  TRecordInfo=
+  PRecordInfoFull=^TRecordInfoFull;
+  TRecordInfoFull=
 {$ifdef USE_PACKED}
   packed
 {$endif USE_PACKED}
   record
     Size: Longint;
+    InitTable: Pointer;
+    Count: Longint;
+    { Elements: array[count] of TRecordElement }
+  end;
+
+  TRTTIRecInitFiniOp=procedure(ARec: Pointer);
+
+  PRTTIRecordOpVMT=^TRTTIRecordOpVMT;
+  TRTTIRecordOpVMT=
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Initialize: TRTTIRecInitFiniOp;
+    Finalize: TRTTIRecInitFiniOp;
+    Reserved1: CodePointer;
+    Reserved2: CodePointer;
+  end;
+
+  PRecordInfoInit=^TRecordInfoInit;
+  TRecordInfoInit=
+{$ifdef USE_PACKED}
+  packed
+{$endif USE_PACKED}
+  record
+    Size: Longint;
+    Terminator: Pointer;
+    RecordOp: PRTTIRecordOpVMT;
     Count: Longint;
     { Elements: array[count] of TRecordElement }
   end;
@@ -75,7 +103,23 @@ end;
 function RTTIRecordSize(typeInfo: Pointer): SizeInt;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  result:=PRecordInfo(typeInfo)^.Size;
+  result:=PRecordInfoFull(typeInfo)^.Size;
+end;
+
+function RTTIRecordOp(typeInfo: Pointer; var initrtti: Pointer): PRecordInfoInit; inline;
+begin
+  { find init table and management operators }
+  typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  result:=typeInfo;
+
+  { check terminator, maybe we are already in init table }
+  if Assigned(result^.Terminator) then
+  begin
+    { point to more optimal initrtti }
+    initrtti:=PRecordInfoFull(result)^.InitTable;
+    { and point to management operators in our init table }
+    result:=aligntoptr(initrtti+2+PByte(initrtti)[1]);
+  end
 end;
 
 function RTTISize(typeInfo: Pointer): SizeInt;
@@ -104,8 +148,8 @@ var
   i : longint;
 begin
   typeInfo:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
-  Count:=PRecordInfo(typeInfo)^.Count;
-  Inc(PRecordInfo(typeInfo));
+  Count:=PRecordInfoInit(typeInfo)^.Count;
+  Inc(PRecordInfoInit(typeInfo));
   { Process elements }
   for i:=1 to count Do
     begin
@@ -165,7 +209,13 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_initialize);
+      { if possible try to use more optimal initrtti }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
+      begin
+        recordrtti(data,typeinfo,@int_initialize);
+        if Assigned(recordop) and Assigned(recordop^.Initialize) then
+          recordop^.Initialize(data);
+      end;
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_init(PVarData(Data)^);
@@ -195,7 +245,13 @@ begin
     tkObject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkRecord:
-      recordrtti(data,typeinfo,@int_finalize);
+      { if possible try to use more optimal initrtti }
+      with RTTIRecordOp(typeinfo, typeinfo)^ do
+      begin
+        if Assigned(recordop) and Assigned(recordop^.Finalize) then
+          recordop^.Finalize(data);
+        recordrtti(data,typeinfo,@int_finalize);
+      end;
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
@@ -231,7 +287,11 @@ begin
     tkobject,
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord :
-      recordrtti(data,typeinfo,@int_addref);
+      begin
+        { find init table }
+        RTTIRecordOp(typeinfo, typeinfo);
+        recordrtti(data,typeinfo,@int_addref);
+      end;
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_incr_ref(PPointer(Data)^);
@@ -303,11 +363,13 @@ begin
 {$endif FPC_HAS_FEATURE_OBJECTS}
     tkrecord:
       begin
+        { find init table }
+        RTTIRecordOp(typeinfo, typeinfo);
         Temp:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
 
-        Result:=PRecordInfo(Temp)^.Size;
-        Count:=PRecordInfo(Temp)^.Count;
-        Inc(PRecordInfo(Temp));
+        Result:=PRecordInfoInit(Temp)^.Size;
+        Count:=PRecordInfoInit(Temp)^.Count;
+        Inc(PRecordInfoInit(Temp));
         expectedoffset:=0;
         { Process elements with rtti }
         for i:=1 to count Do

rtl/objpas/typinfo.pp

@@ -203,6 +203,7 @@ unit typinfo;
             tkRecord:
               (
                 RecSize: Integer;
+                RecInitTable: Pointer;
                 ManagedFldCount: Integer;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
               );

tests/test/toperator89.pp

@@ -0,0 +1,29 @@
+{ %NORUN }
+
+program toperator89;
+
+{$MODE OBJFPC}
+{$modeswitch advancedrecords}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+end;
+
+begin
+end. 

tests/test/toperator90.pp

@@ -0,0 +1,129 @@
+program toperator90;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+    S: string;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  if aFoo.S <> '' then
+    Halt(1);
+  aFoo.F := 1;
+  aFoo.S := 'A';
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  if aFoo.S <> 'B' then
+    Halt(3);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(4);
+  if F.S <> 'A' then
+    Halt(5);
+  F.F := 2;
+  F.S := 'B';
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(6);
+
+  if F.S <> 'A' then
+    Halt(7);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(8);
+  if B.F.S <> 'A' then
+    Halt(9);
+  B.F.F := 2;
+  B.F.S := 'B';
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF^.F <> 1 then
+    Halt(10);
+  if PF^.S <> 'A' then
+    Halt(11);
+  PF^.F := 2;
+  PF^.S := 'B';
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 1 then
+    Halt(12);
+  if PF^.S <> 'A' then
+    Halt(13);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(14);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF^.F <> 1 then
+    Halt(15);
+  if PF^.S <> 'A' then
+    Halt(16);
+  PF^.F := 2;  
+  PF^.S := 'B';  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(17);
+  FreeMem(PF);
+    
+  WriteLn('=== Global variable [end] ===');
+  F.F := 2;
+  F.S := 'B';
+end. 

tests/test/toperator91.pp

@@ -0,0 +1,104 @@
+program toperator91;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  PFoo = ^TFoo;
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo);
+    class operator Finalize(var aFoo: TFoo);
+  public
+    F: Integer;
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo);
+begin
+  WriteLn;
+  WriteLn('TFoo.Initialize');
+  aFoo.F := 1;
+end;
+
+class operator TFoo.Finalize(var aFoo: TFoo);
+begin
+  if aFoo.F <> 2 then
+    Halt(2);
+  aFoo.F := 3;
+  WriteLn('TFoo.Finalize');
+  WriteLn;
+end;
+
+{ TBar }
+type 
+  TBar = class
+  private 
+    F: TFoo;
+  end;
+
+procedure Foo();
+var
+  F: TFoo;
+begin
+  if F.F <> 1 then
+    Halt(3);
+  F.F := 2;
+end;
+
+var
+  F: TFoo;
+  B: TBar;
+  PF: PFoo;
+begin
+  WriteLn('=== Global variable [begin] ===');
+  WriteLn;
+  
+  if F.F <> 1 then
+    Halt(4);
+    
+  WriteLn('=== Local variable ===');
+  Foo();  
+    
+  WriteLn('=== Field in class ===');
+  B := TBar.Create();
+  if B.F.F <> 1 then
+    Halt(5);
+  B.F.F := 2;
+  B.Free; 
+    
+  WriteLn('=== New and Dispose ===');
+  New(PF);
+  if PF.F <> 1 then
+    Halt(6);
+  PF^.F := 2;
+  Dispose(PF); 
+  
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(PF, SizeOf(TFoo));
+  InitializeArray(PF, TypeInfo(TFoo), 1);
+  if PF.F <> 1 then
+    Halt(7);
+  PF^.F := 2;  
+  FinalizeArray(PF, TypeInfo(TFoo), 1);
+  if PF^.F <> 3 then
+    Halt(8);
+  FreeMem(PF);
+
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(PF, SizeOf(TFoo));
+  Initialize(PF^);
+  if PF.F <> 1 then
+    Halt(9);
+  PF^.F := 2;  
+  Finalize(PF^);
+  if PF^.F <> 3 then
+    Halt(10);
+  FreeMem(PF);
+    
+  F.F := 2;
+  WriteLn('=== Global variable [end] ===');
+end. 

tests/test/toperator92.pp

@@ -0,0 +1,81 @@
+program toperator92;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = class
+  public 
+    F1: TR1;
+  end;
+
+  TB = class(TA)
+  public
+    F2: TR2;
+  end;
+
+var
+  O: TB;
+begin
+  O := TB.Create;
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+  
+  O.Free;
+  
+  WriteLn('end');
+end. 

tests/test/toperator93.pp

@@ -0,0 +1,138 @@
+program toperator93;
+
+{$MODE DELPHI}
+
+type
+  TR1 = record
+  private
+    class operator Initialize(var aR1: TR1);
+    class operator Finalize(var aR1: TR1);
+  public
+    I: Integer;
+  end;
+
+  TR2 = record
+  private
+    class operator Initialize(var aR2: TR2);
+    class operator Finalize(var aR2: TR2);
+  public
+    S: string;
+  end;
+
+{ TR1 }
+
+class operator TR1.Initialize(var aR1: TR1);
+begin
+  WriteLn('TR1.Initialize');
+  aR1.I := 1;
+end;
+
+class operator TR1.Finalize(var aR1: TR1);
+begin
+  if aR1.I <> 2 then
+    Halt(1);
+  aR1.I := 3;
+  WriteLn('TR1.Finalize');
+end;
+
+{ TR2 }
+
+class operator TR2.Initialize(var aR2: TR2);
+begin
+  WriteLn('TR2.Initialize');
+  aR2.S := 'A';
+end;
+
+class operator TR2.Finalize(var aR2: TR2);
+begin
+  if aR2.S <> 'B' then
+    Halt(2);
+  WriteLn('TR2.Finalize');
+end;
+
+{ TA }
+
+type 
+  TA = object
+  public 
+    F1: TR1;
+  end;
+
+  TB = object(TA)
+  public
+    F2: TR2;
+  end;
+  
+procedure Foo();
+var
+  LO: TB;
+begin
+  if LO.F1.I <> 1 then
+    Halt(4);
+  if LO.F2.S <> 'A' then
+    Halt(5);
+  LO.F1.I := 2;
+  LO.F2.S := 'B';
+end;
+
+var
+  O: TB;
+  P: ^TB;
+begin
+  WriteLn('=== Global object variable [begin] ===');
+  
+  if O.F1.I <> 1 then
+    Halt(3);
+  if O.F2.S <> 'A' then
+    Halt(4);
+    
+  WriteLn;
+  WriteLn('=== Local variable ===');
+  Foo();      
+    
+  WriteLn;
+  WriteLn('=== New and Dispose ===');
+  New(P);
+  if P^.F1.I <> 1 then
+    Halt(10);
+  if P^.F2.S <> 'A' then
+    Halt(11);
+  P^.F1.I := 2;
+  P^.F2.S := 'B';
+  Dispose(P); 
+  
+  WriteLn;
+  WriteLn('=== InitializeArray and FinalizeArray ===');
+  GetMem(P, SizeOf(TB));
+  InitializeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 1 then
+    Halt(12);
+  if P^.F2.S <> 'A' then
+    Halt(13);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  FinalizeArray(P, TypeInfo(TB), 1);
+  if P^.F1.I <> 3 then
+    Halt(14);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Initialize and Finalize ===');
+  GetMem(P, SizeOf(TB));
+  Initialize(P^);
+  if P^.F1.I <> 1 then
+    Halt(15);
+  if P^.F2.S <> 'A' then
+    Halt(16);
+  P^.F1.I := 2;  
+  P^.F2.S := 'B';  
+  Finalize(P^);
+  if P^.F1.I <> 3 then
+    Halt(17);
+  FreeMem(P);
+
+  WriteLn;
+  WriteLn('=== Global variable [end] ===');
+  O.F1.I := 2;
+  O.F2.S := 'B'; 
+end. 

tests/test/toperator94.pp

@@ -0,0 +1,28 @@
+{ %FAIL }
+
+program t5;
+
+{$MODE DELPHI}
+
+type
+
+  { TFoo }
+
+  TFoo = record
+  private
+    class operator Initialize(var aFoo: TFoo): Boolean;
+    class operator Finalize(var aFoo: Pointer);
+  end;
+
+{ TFoo }
+
+class operator TFoo.Initialize(var aFoo: TFoo): Boolean;
+begin
+end;
+
+class operator TFoo.Finalize(var aFoo: Pointer);
+begin
+end;
+
+begin
+end. 

tests/test/trtti10.pp

@@ -0,0 +1,15 @@
+program trtti10;
+
+{$MODE DELPHI}
+
+uses
+  TypInfo;
+
+type
+  TFoo = record
+  end;
+
+begin
+  if GetTypeData(TypeInfo(TFoo)).RecInitTable = nil then
+    Halt(1);
+end.