Natools

Check-in [66369eba6c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:references__protected: task-safe portable variant of Natools.References, based on protected counters
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 66369eba6cff69dff45bf1ba165e2fa5e94aedf1
User & Date: nat on 2014-07-17 19:37:28
Other Links: manifest | tags
Context
2014-07-18
17:35
references__intel: new intel-specific task-safe variant of Natools.References check-in: ca01910925 user: nat tags: trunk
2014-07-17
19:37
references__protected: task-safe portable variant of Natools.References, based on protected counters check-in: 66369eba6c user: nat tags: trunk
2014-07-16
17:44
references: prepare variants, calling "unsafe" the existing one check-in: ed32c25b9b user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified natools.gpr from [bffb90d568] to [636db3747c]. 

1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12





-
+








project Natools is
   type Build_Type is ("Release", "Coverage");
   Mode : Build_Type := external ("MODE", "Release");

   type Task_Safety is ("None");
   type Task_Safety is ("None", "Portable");
   Safety : Task_Safety := external ("TASK_SAFETY", "None");

   Prefix := "";
   Extra_Switches := ();

   case Mode is
      when "Release" =>
︙
70
71
72
73
74
75
76





77
78
79

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84








+
+
+
+
+




   package Naming is
      case Safety is
         when "None" =>
            for spec ("Natools.References")
              use "natools-references__unsafe.ads";
            for body ("Natools.References")
              use "natools-references__unsafe.adb";
         when "Portable" =>
            for spec ("Natools.References")
              use "natools-references__protected.ads";
            for body ("Natools.References")
              use "natools-references__protected.adb";
      end case;
   end Naming;
end Natools;

Added src/natools-references__protected.adb version [3bfa20ca4b]. 






















































































































































































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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

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

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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 Immutable_Reference) is
   begin
      if Object.Count /= null then
         Object.Count.Increment;
      end if;
   end Adjust;


   overriding procedure Finalize (Object : in out Immutable_Reference) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Held_Data, Data_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Counter, Counter_Access);

      Deallocate : Boolean;
   begin
      if Object.Count /= null then
         Object.Count.Decrement (Deallocate);

         if Deallocate 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 Immutable_Reference is
   begin
      return (Ada.Finalization.Controlled with
         Data => new Held_Data'(Constructor.all),
         Count => new Counter);
   end Create;


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


   function Create (Data : in Data_Access) return Immutable_Reference is
   begin
      if Data = null then
         return Null_Immutable_Reference;
      else
         return (Ada.Finalization.Controlled with
            Data => Data,
            Count => new Counter);
      end if;
   end Create;


   procedure Replace
     (Ref : in out Immutable_Reference;
      Data : in Data_Access) is
   begin
      Finalize (Ref);

      if Data /= null then
         Ref.Data := Data;
         Ref.Count := new Counter;
      end if;
   end Replace;


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


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


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



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

   function Query (Ref : in Immutable_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 Immutable_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;



   ------------------------
   -- Counter Management --
   ------------------------

   protected body Counter is
      procedure Increment is
      begin
         Value := Value + 1;
      end Increment;

      procedure Decrement (Zero : out Boolean) is
      begin
         Value := Value - 1;
         Zero := Value = 0;
      end Decrement;

      function Get_Value return Natural is
      begin
         return Value;
      end Get_Value;
   end Counter;

end Natools.References;









Added src/natools-references__protected.ads version [46a97aca04].


















































































































































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
130
131
132
133
134
135
136
137
138
139
140
141
142

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

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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,    --
-- but uses protected counters to ensure task safe operations.              --
-- Beware though that there is still no guarantee on the task-safety of the --
-- operations performed on the referred objects.                            --
------------------------------------------------------------------------------

with Ada.Finalization;
with System.Storage_Pools;

generic
   type Held_Data (<>) is limited private;
   Counter_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;
   Data_Pool : in out System.Storage_Pools.Root_Storage_Pool'Class;

package Natools.References is
   pragma Preelaborate (References);

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

   type Data_Access is access Held_Data;
   for Data_Access'Storage_Pool use Data_Pool;


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

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

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

   function Create (Data : in Data_Access) return Immutable_Reference;
      --  Create a new reference from Data.
      --  From this point the referred object is owned by this
      --  package and must NOT be freed or changed or accessed.

   procedure Replace (Ref : in out Immutable_Reference; Data : in Data_Access);
      --  Integrate Data into Ref.
      --  From this point the referred object is owned by this
      --  package and must NOT be freed or changed or accessed.

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

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

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

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

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

   Null_Immutable_Reference : constant Immutable_Reference;


   type Reference is new Immutable_Reference with private;

   function Update (Ref : in Reference) return Mutator;
   pragma Inline (Update);
      --  Return a ereferenciable mutable access to 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

   protected type Counter is
      procedure Increment;
      procedure Decrement (Zero : out Boolean);
      function Get_Value return Natural;
   private
      Value : Natural := 1;
   end Counter;

   type Counter_Access is access Counter;
   for Counter_Access'Storage_Pool use Counter_Pool;

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

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

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

   type Reference is new Immutable_Reference with null record;

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

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

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

   Null_Reference : constant Reference
     := (Null_Immutable_Reference with null record);

end Natools.References;








Modified tests.gpr
from [df94e40d79]
to [4a62dd28e9].




︙


16
17
18
19
20
21
22



23
24
25

16
17
18
19
20
21
22
23
24
25
26
27
28








+
+
+




   end Linker;

   package Naming is
      case Natools.Safety is
         when "None" =>
            for body ("Natools.References.Tools")
              use "natools-references-tools__unsafe.adb";
         when "Portable" =>
            for body ("Natools.References.Tools")
              use "natools-references-tools__protected.adb";
      end case;
   end Naming;
end Tests;








Added tests/natools-references-tools__protected.adb version [3843101e4f].












































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

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

------------------------------------------------------------------------------
-- Copyright (c) 2013-2014, 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.           --
------------------------------------------------------------------------------

package body Natools.References.Tools is

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


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


   function Count (Ref : Reference) return Natural is
   begin
      if Ref.Count /= null then
         return Ref.Count.Get_Value;
      else
         return 0;
      end if;
   end Count;

end Natools.References.Tools;













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