Add RTL Helpers for increasing and decreasing reference count as well as assigning reference counted class instances to one another.

Note 1: If the offset passed to the decrement function is negative then the object won't be freed (needed for the end of the constructor)
Note 2: If the reference count is negative then reference counting is effectively disabled (needed during call of Destroy to avoid recursion if Self is passed to other functions)

rtl/inc/compproc.inc:
  + add new RTL helper "fpc_refcountclass_decr_ref" for decreasing the reference count of a class and potentially freeing it
  + add new RTL helper "fpc_refcountclass_incr_ref" for incrementing the reference count of a class
  + add new RTL helper "fpc_refcountclass_assign" to assign a reference counted class instance to another whereby the reference count is handled accordingly
rtl/inc/objpas.inc:
  + add locally visible aliases for the RTL helpers

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

rtl/inc/compproc.inc

@@ -631,6 +631,9 @@ function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Point
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
 procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
 {$endif FPC_HAS_FEATURE_VARIANTS}
+procedure fpc_refcountclass_decr_ref(var o: pointer; offset: longint); compilerproc;
+procedure fpc_refcountclass_incr_ref(o: pointer; offset: longint); compilerproc;
+procedure fpc_refcountclass_assign(var D: pointer; const S: pointer; offset: longint); compilerproc;
 {$endif FPC_HAS_FEATURE_CLASSES}
 
 

rtl/inc/objpas.inc

@@ -268,6 +268,60 @@
       end;
 
 
+    { reference counted class helpers }
+    procedure fpc_refcountclass_decr_ref(var o: pointer; offset: longint);[public,alias: 'FPC_REFCOUNTCLASS_DECR_REF']; compilerproc;
+      var
+        offsetfield: PLongInt;
+        enabledestroy: Boolean;
+      begin
+        //Writeln('fpc_refcountclass_decr_ref: ', hexstr(o), ' ', offset);
+        enabledestroy := offset >= 0;
+        if not enabledestroy then
+          offset := -offset;
+        offsetfield := PLongInt(PByte(o) + offset);
+        if assigned(o) and (offsetfield^ > 0) then
+          begin
+            //Writeln('Decrement from ', offsetfield^, ' at ', hexstr(offsetfield));
+            InterlockedDecrement(offsetfield^);
+            if (offsetfield^ = 0) and enabledestroy then
+              begin
+                //Writeln('Calling destructor');
+                { to avoid further refcount changes }
+                offsetfield^ := -1;
+                TObject(o).Destroy;
+                o:=nil;
+              end;
+          end;
+      end;
+
+    { local declaration for refcountclass_decr_ref for local access }
+    procedure refcountclass_decr_ref(var o: pointer; offset: longint); [external name 'FPC_REFCOUNTCLASS_DECR_REF'];
+
+
+    procedure fpc_refcountclass_incr_ref(o: pointer; offset: longint);[public,alias: 'FPC_REFCOUNTCLASS_INCR_REF']; compilerproc;
+      begin
+        //Writeln('fpc_refcountclass_incr_ref: ', hexstr(o), ' ', offset);
+         if assigned(o) and (PLongInt(PByte(o) + offset)^ >= 0) then
+           begin
+             //Writeln('Increment from ', PLongInt(PByte(o) + offset)^, ' at ', hexstr(PByte(o) + offset));
+             InterlockedIncrement(PLongInt(PByte(o) + offset)^);
+           end;
+      end;
+
+    { local declaration of refcountclass_incr_ref for local access }
+    procedure refcountclass_incr_ref(o: pointer; offset: longint); [external name 'FPC_REFCOUNTCLASS_INCR_REF'];
+
+    procedure fpc_refcountclass_assign(var D: pointer; const S: pointer; offset: longint);[public,alias: 'FPC_REFCOUNTCLASS_ASSIGN']; compilerproc;
+      begin
+        //Writeln('fpc_refcountclass_assign: ', hexstr(d), ' ', hexstr(s), ' ', offset);
+        refcountclass_incr_ref(S,offset);
+        refcountclass_decr_ref(D,offset);
+        D:=S;
+      end;
+
+    procedure refcountclass_assign(var D: pointer; const s: pointer; offset: longint); [external name 'FPC_REFCOUNTCLASS_ASSIGN'];
+
+
 {****************************************************************************
                                TOBJECT
 ****************************************************************************}