Natools

Check-in [ca01910925]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:references__intel: new intel-specific task-safe variant of Natools.References
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ca01910925228be8a759afbb53ee09e283e50c85
User & Date: nat on 2014-07-18 17:35:41
Other Links: manifest | tags
Context
2014-07-19
18:27
Add pragma Preelaborable_Initialization throughout the code check-in: 3b9912ed66 user: nat tags: trunk
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified natools.gpr from [636db3747c] to [3162d5a04a]. 

1
2
3
4
5


6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12
13





-
+
+








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

   type Task_Safety is ("None", "Portable");
   type Task_Safety is ("None", "Portable", "Intel");
      --  Task-safe, portable, efficient: choose two
   Safety : Task_Safety := external ("TASK_SAFETY", "None");

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

   case Mode is
      when "Release" =>
︙
75
76
77
78
79
80
81





82
83
84

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90








+
+
+
+
+




            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";
         when "Intel" =>
            for spec ("Natools.References")
              use "natools-references__intel.ads";
            for body ("Natools.References")
              use "natools-references__intel.adb";
      end case;
   end Naming;
end Natools;

Added src/natools-references__intel.adb version [bc469c4162]. 










































































































































































































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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

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

------------------------------------------------------------------------------
-- 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.Characters.Latin_1;
with Ada.Unchecked_Deallocation;
with System.Machine_Code;

package body Natools.References is

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

   overriding procedure Adjust (Object : in out Immutable_Reference) is
   begin
      if Object.Count /= null then
         Increment (Object.Count);
      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
         Decrement (Object.Count, 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'(1));
   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'(1);
   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'(1));
      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'(1);
      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 --
   ------------------------

--   procedure Increment (Object : in Counter_Access) is
--   begin
--      Object.all := Object.all + 1;
--   end Increment;
--
--   procedure Decrement (Object : in Counter_Access; Zero : out Boolean) is
--   begin
--      Object.all := Object.all - 1;
--      Zero := Object.all = 0;
--   end Decrement;

   procedure Increment (Object : in Counter_Access) is
   begin
      System.Machine_Code.Asm
        (Template => "lock incl %0",
         Outputs => Counter'Asm_Output ("+m", Object.all),
         Volatile => True,
         Clobber => "cc, memory");
   end Increment;


   procedure Decrement (Object : in Counter_Access; Zero : out Boolean) is
      package Latin_1 renames Ada.Characters.Latin_1;
      use type Interfaces.Unsigned_8;
      Z_Flag : Interfaces.Unsigned_8;
   begin
      System.Machine_Code.Asm
        (Template => "lock decl %0" & Latin_1.LF & Latin_1.HT
                   & "setz %1",
         Outputs => (Counter'Asm_Output ("+m", Object.all),
                     Interfaces.Unsigned_8'Asm_Output ("=q", Z_Flag)),
         Volatile => True,
         Clobber => "cc, memory");
      Zero := Z_Flag = 1;
   end Decrement;

end Natools.References;









Added src/natools-references__intel.ads version [a4b815a76e].




















































































































































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

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

------------------------------------------------------------------------------
-- 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 Intel assembly code to ensure task safety.                      --
-- 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;

private with Interfaces;

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

   type Counter is new Interfaces.Unsigned_32;

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

   procedure Increment (Object : in Counter_Access);
   pragma Inline (Increment);

   procedure Decrement (Object : in Counter_Access; Zero : out Boolean);
   pragma Inline (Decrement);

   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 [4a62dd28e9]
to [d556d3563c].




︙


13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28

13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28








-
+










   package Linker is
      for Default_Switches use Natools.Linker'Default_Switches;
   end Linker;

   package Naming is
      case Natools.Safety is
         when "None" =>
         when "None" | "Intel" =>
            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;













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