Natools

Check-in [4306b2b680]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:References: new package implementing a reference counter
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4306b2b680df1de8b10d2671369e4858112393a5
User & Date: nat on 2013-09-22 15:29:04
Other Links: manifest | tags
Context
2013-09-23
18:26
reference_tests: full-coverage test suite for reference counter check-in: 681c468a7d user: nat tags: trunk
2013-09-22
15:29
References: new package implementing a reference counter check-in: 4306b2b680 user: nat tags: trunk
2013-09-15
15:28
chunked_strings-tests-memory: new test suite for memory usage check-in: b886bca8bd user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added src/natools-references.adb version [f831953142]. 



































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Unchecked_Deallocation;

package body Natools.References is

   ---------------------------------
   -- Low-level memory management --
   ---------------------------------

   overriding procedure Adjust (Object : in out Reference) is
   begin
      if Object.Count /= null then
         Object.Count.all := Object.Count.all + 1;
      end if;
   end Adjust;


   overriding procedure Finalize (Object : in out Reference) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Held_Data, Data_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Counter, Counter_Access);
   begin
      if Object.Count /= null then
         Object.Count.all := Object.Count.all - 1;

         if Object.Count.all = 0 then
            Free (Object.Count);
            Free (Object.Data);
         else
            Object.Count := null;
            Object.Data := null;
         end if;
      end if;
   end Finalize;



   -----------------------------------------
   -- Object construction and destruction --
   -----------------------------------------

   function Create
     (Constructor : not null access function return Held_Data)
      return Reference is
   begin
      return (Ada.Finalization.Controlled with
         Data => new Held_Data'(Constructor.all),
         Count => new Counter'(1));
   end Create;


   procedure Replace
     (Ref : in out Reference;
      Constructor : not null access function return Held_Data) is
   begin
      Finalize (Ref);
      Ref.Data := new Held_Data'(Constructor.all);
      Ref.Count := new Counter'(1);
   end Replace;


   procedure Reset (Ref : in out Reference) is
   begin
      Finalize (Ref);
   end Reset;


   function Is_Empty (Ref : Reference) return Boolean is
   begin
      return Ref.Count = null;
   end Is_Empty;


   function "=" (Left, Right : Reference) return Boolean is
   begin
      return Left.Data = Right.Data;
   end "=";



   ----------------------
   -- Dereferenciation --
   ----------------------

   function Query (Ref : in Reference) return Accessor is
   begin
      return Accessor'(Data => Ref.Data, Parent => Ref);
   end Query;


   function Update (Ref : in Reference) return Mutator is
   begin
      return Mutator'(Data => Ref.Data, Parent => Ref);
   end Update;


   procedure Query
     (Ref : in Reference;
      Process : not null access procedure (Object : in Held_Data)) is
   begin
      Process.all (Ref.Data.all);
   end Query;


   procedure Update
     (Ref : in Reference;
      Process : not null access procedure (Object : in out Held_Data)) is
   begin
      Process.all (Ref.Data.all);
   end Update;

end Natools.References;









Added src/natools-references.ads version [0fba189b0d].



















































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2013, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.References implements reference-counted smart pointer to any     --
-- type of objects.                                                         --
-- This is a basic implementation that does not support weak references or  --
-- concurrency. However since there is no internal state, operations on     --
-- non-overlapping objects should be thread-safe.                           --
------------------------------------------------------------------------------

with Ada.Finalization;

generic
   type Held_Data (<>) is limited private;

package Natools.References is
   pragma Preelaborate (References);

   type Reference is new Ada.Finalization.Controlled with private;

   type Accessor (Data : not null access constant Held_Data) is
     limited private;
   type Mutator (Data : not null access Held_Data) is
     limited private;


   function Create
     (Constructor : not null access function return Held_Data)
      return Reference;
      --  Create a new held object and return a reference to it

   procedure Replace
     (Ref : in out Reference;
      Constructor : not null access function return Held_Data);
      --  Replace the object held in Ref with a newly created object

   procedure Reset (Ref : in out Reference);
      --  Empty Ref

   function Is_Empty (Ref : Reference) return Boolean;
      --  Check whether Ref refers to an actual object

   function "=" (Left, Right : Reference) return Boolean;
      --  Check whether Left and Right refer to the same object


   function Query (Ref : in Reference) return Accessor;
   pragma Inline (Query);
      --  Return a derefenciable constant access to the held object

   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a derefenciable mutable access to the held object

   procedure Query
     (Ref : in Reference;
      Process : not null access procedure (Object : in Held_Data));
      --  Call Process with the held object

   procedure Update
     (Ref : in Reference;
      Process : not null access procedure (Object : in out Held_Data));
      --  Call Process with the held object

   Null_Reference : constant Reference;

private

   type Counter is new Natural;

   type Counter_Access is access Counter;

   type Data_Access is access Held_Data;

   type Reference is new Ada.Finalization.Controlled with record
      Count : Counter_Access := null;
      Data : Data_Access := null;
   end record;

   overriding procedure Adjust (Object : in out Reference);
      --  Increate reference counter

   overriding procedure Finalize (Object : in out Reference);
      --  Decrease reference counter and release memory if needed

   type Accessor (Data : not null access constant Held_Data) is limited record
      Parent : Reference;
   end record;

   type Mutator (Data : not null access Held_Data) is limited record
      Parent : Reference;
   end record;

   Null_Reference : constant Reference
     := (Ada.Finalization.Controlled with Count => null, Data => null);

end Natools.References;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47