Handle initialization/finalization and copying of records.

Note 1: the Init-RTTI of a record is extended by a new field "IsWeak" to denote a field as "weak"
Note 2: the Init-RTTI of a class is extended by a new field for the reference count offset

compiler/ncgrtii.pas, TRTTIWriter:
  * fields_write_rtti_data: write out the corresponding value if the field is "weak"
  * objectdef_rtti.objectdef_rtti_fields: write the offset of the reference count field (or 0 if not reference counted) as part of the Init-RTTI of a class
rtl/inc/rtti.inc:
  * RTTISize: handle the tkClass case
  + new function "RTTIRefCountOffset" to determine the offset of the reference count field (if any) based on the Init-RTTI of the class
  * RecordRTTI: only call the rttiproc ("initialize" or "finalize") if the field is not "weak"
  * fpc_Initialize: initialize class instance fields to Nil
  * fpc_finalize: call RefCountClass_Decr_Ref for class instance fields if we have a valid reference count offset
  * fpc_addref: call RefCountClass_Incr_Ref for class instance fields if we have a valid reference count
  * fpc_copy: call RefCountClass_Assign for class instance fields if we have a valid reference count offset
  * fpc_copy: use Move instead of fpc_copy to copy a class instance field if it is "weak"

git-svn-id: branches/svenbarth/arc@28814 -

compiler/ncgrtti.pas

@@ -146,6 +146,7 @@ implementation
         fieldcnt: longint;
         lastai: TLinkedListItem;
         st: tsymtable;
+        offset : asizeint;
       begin
         fieldcnt:=0;
         { Count will be inserted at this location. It cannot be nil as we've just
@@ -178,6 +179,8 @@ implementation
               begin
                 write_rtti_reference(tfieldvarsym(sym).vardef,rt);
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(tfieldvarsym(sym).fieldoffset));
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ord(vo_is_weakref in tfieldvarsym(sym).varoptions)));
+                maybe_write_align;
                 inc(fieldcnt);
               end;
           end;
@@ -854,9 +857,24 @@ implementation
         procedure objectdef_rtti(def:tobjectdef);
 
           procedure objectdef_rtti_fields(def:tobjectdef);
+          var
+            offsetsym : tfieldvarsym;
           begin
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
             fields_write_rtti_data(def,rt);
+            if def.objecttype=odt_class then
+              begin
+                maybe_write_align;
+                if oo_is_reference_counted in def.objectoptions then
+                  begin
+                    offsetsym:=tfieldvarsym(def.refcount_field);
+                    if not assigned(offsetsym) or (offsetsym.typ<>fieldvarsym) then
+                      internalerror(2014101203);
+                    current_asmdata.asmlists[al_rtti].concat(Tai_const.Create(aitconst_ptr,offsetsym.fieldoffset));
+                  end
+                else
+                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create(aitconst_ptr,0));
+              end;
           end;
 
           procedure objectdef_rtti_interface_init(def:tobjectdef);

rtl/inc/rtti.inc

@@ -35,6 +35,7 @@ type
     Offset: Longint;
     {$else}
     Offset: SizeInt;
+    IsWeak: Boolean;
     {$endif}
   end;
 
@@ -82,7 +83,7 @@ function RTTISize(typeInfo: Pointer): SizeInt;
 begin
   case PByte(typeinfo)^ of
     tkAString,tkWString,tkUString,
-    tkInterface,tkDynarray:
+    tkInterface,tkDynarray,tkClass:
       result:=sizeof(Pointer);
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
@@ -97,6 +98,16 @@ begin
   end;
 end;
 
+function RTTIRefCountOffset(TypeInfo: Pointer): SizeInt;
+var
+  info: PRecordInfo;
+  refcount: PSizeInt;
+begin
+  info:=aligntoptr(typeInfo+2+PByte(typeInfo)[1]);
+  refcount:=PSizeInt(Pointer(info)+SizeOf(TRecordInfo)+info^.Count*SizeOf(TRecordElement));
+  Result:=refcount^;
+end;
+
 { if you modify this procedure, fpc_copy must be probably modified as well }
 procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
 var
@@ -109,7 +120,8 @@ begin
   { Process elements }
   for i:=1 to count Do
     begin
-      rttiproc(Data+PRecordElement(typeInfo)^.Offset,PRecordElement(typeInfo)^.TypeInfo);
+      if not PRecordElement(typeInfo)^.IsWeak then
+        rttiproc(Data+PRecordElement(typeInfo)^.Offset,PRecordElement(typeInfo)^.TypeInfo);
       Inc(PRecordElement(typeInfo));
     end;
 end;
@@ -148,6 +160,9 @@ end;
 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+    tkClass,
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray,
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
@@ -175,6 +190,8 @@ end;
 
 
 Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE'];  compilerproc;
+var
+  offset: SizeInt;
 begin
   case PByte(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
@@ -198,6 +215,13 @@ begin
       recordrtti(data,typeinfo,@int_finalize);
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+    tkClass: begin
+      offset:=RTTIRefCountOffset(TypeInfo);
+      if offset>0 then
+        RefCountClass_Decr_Ref(PPointer(Data)^,offset);
+    end;
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_clear(PPointer(Data)^,TypeInfo);
@@ -211,6 +235,8 @@ end;
 
 
 Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];  compilerproc;
+var
+  offset: SizeInt;
 begin
   case PByte(TypeInfo)^ of
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
@@ -238,6 +264,13 @@ begin
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
     tkInterface:
       Intf_Incr_Ref(PPointer(Data)^);
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+    tkClass: begin
+      offset:=RTTIRefCountOffset(TypeInfo);
+      if offset>0 then
+        RefCountClass_Incr_Ref(PPointer(Data)^,offset);
+    end;
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_addref(pvardata(Data)^);
@@ -258,6 +291,7 @@ var
   offset,
   i: SizeInt;
   info: pointer;
+  isweak: Boolean;
 begin
   result:=sizeof(pointer);
   case PByte(TypeInfo)^ of
@@ -265,6 +299,13 @@ begin
     tkAstring:
       fpc_AnsiStr_Assign(PPointer(Dest)^,PPointer(Src)^);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_CLASSES}
+    tkClass: begin
+      offset:=RTTIRefCountOffset(TypeInfo);
+      if offset>0 then
+        RefCountClass_Assign(PPointer(Dest)^,PPointer(Src)^,offset);
+    end;
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
   {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
     tkWstring:
@@ -314,10 +355,17 @@ begin
           begin
             Info:=PRecordElement(Temp)^.TypeInfo;
             Offset:=PRecordElement(Temp)^.Offset;
+            IsWeak:=PRecordElement(Temp)^.IsWeak;
             Inc(PRecordElement(Temp));
             if Offset>expectedoffset then
               move((Src+expectedoffset)^,(Dest+expectedoffset)^,Offset-expectedoffset);
-            copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
+            if isweak and (PByte(TypeInfo)^=tkClass) then
+              begin
+                move((Src+offset)^,(Dest+offset)^,SizeOf(Pointer));
+                copiedsize:=SizeOf(Pointer);
+              end
+            else
+              copiedsize:=fpc_Copy_internal(Src+Offset,Dest+Offset,Info);
             expectedoffset:=Offset+copiedsize;
           end;
         { elements remaining? }