1. -- 
  2. -- Copyright (c) 2012-2013 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Ada.Finalization;                  use Ada.Finalization; 
  10. with Interfaces;                        use Interfaces; 
  11.  
  12. package Reference_Counting is 
  13.  
  14.     type Reference_Counted is abstract tagged private; 
  15.  
  16.     type A_Reference_Counted is access all Reference_Counted'Class; 
  17.  
  18.     procedure Delete( this : in out Reference_Counted ) is null; 
  19.  
  20.     ---------------------------------------------------------------------------- 
  21.  
  22.     generic 
  23.         type Encapsulated is abstract new Reference_Counted with private; 
  24.     package Smart_Pointers is 
  25.  
  26.         type A_Encapsulated is access all Encapsulated'Class; 
  27.  
  28.         type Ref is tagged private; 
  29.  
  30.         function Get( this : Ref ) return A_Encapsulated; 
  31.         pragma Inline( Get ); 
  32.  
  33.         function Get_Refcount( this : Ref ) return Natural; 
  34.  
  35.         procedure Set( this : in out Ref; target : Encapsulated'Class ); 
  36.         procedure Set( this : in out Ref; target : access Encapsulated'Class ); 
  37.  
  38.         -- Returns True if l and r point to equivalent objects. This is the same 
  39.         -- as calling l.Get.all = r.Get.all, but it handles null references 
  40.         -- safely. 
  41.         overriding 
  42.         function "="( l, r : Ref ) return Boolean; 
  43.  
  44.         Nul      : constant Ref; 
  45.         Null_Ref : constant Ref; 
  46.  
  47.     private 
  48.  
  49.         type Ref is new Ada.Finalization.Controlled with 
  50.             record 
  51.                 target : A_Reference_Counted := null; 
  52.             end record; 
  53.  
  54.         overriding 
  55.         procedure Adjust( this : in out Ref ); 
  56.  
  57.         overriding 
  58.         procedure Finalize( this : in out Ref ); 
  59.  
  60.         Nul      : constant Ref := (Controlled with target => null); 
  61.         Null_Ref : constant Ref := (Controlled with target => null); 
  62.  
  63.     end Smart_Pointers; 
  64.  
  65.     ---------------------------------------------------------------------------- 
  66.  
  67.     package Atomic is 
  68.  
  69.         function Add( ptr : access Integer_32; 
  70.                       val : Integer_32 ) return Integer_32; 
  71.  
  72.     end Atomic; 
  73.  
  74. private 
  75.  
  76.       type Reference_Counted is abstract tagged 
  77.           record 
  78.               refs : aliased Integer_32 := 0; 
  79.           end record; 
  80.  
  81. end Reference_Counting;