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 | with Ada.Unchecked_Deallocation;
with Rx.Debug;
package body Rx.Tools.Shared_Data is
----------
-- Wrap --
----------
function Wrap (I : not null Item_Access) return Proxy is
(Proxy'(Ada.Finalization.Controlled with
Safe => new Safe_Item,
Item => I));
-----------
-- Apply --
-----------
procedure Apply (P : in out Proxy; CB : access procedure (I : in out Item)) is
begin
P.Safe.Apply (P.Item, CB);
end Apply;
------------
-- Forget --
------------
procedure Forget (P : in out Proxy) is
Is_Last : Boolean;
begin
P.Safe.Forget (Is_Last);
if Is_Last then
P.Finalize;
else
P.Item := null;
P.Safe := null;
end if;
end Forget;
------------
-- Tamper --
------------
function Tamper (P : Proxy) return Ref is
begin
return (Actual => P.Item,
Self => P);
end Tamper;
---------------
-- Safe_Item --
---------------
protected body Safe_Item is
-----------
-- Apply --
-----------
procedure Apply (Elem : Item_Access; CB : not null access procedure (I : in out Item)) is
begin
CB (Elem.all);
end Apply;
------------
-- Forget --
------------
procedure Forget (Is_Last : out Boolean) is
New_Count : Natural;
begin
if Count > 0 then
Finalize (New_Count);
Is_Last := New_Count = 0;
else
raise Constraint_Error;
end if;
end Forget;
------------
-- Adjust --
------------
procedure Adjust is
begin
Count := Count + 1;
Debug.Trace (Debug_Name & " shared_data [safe.adjust]:" & Count'Img);
end Adjust;
--------------
-- Finalize --
--------------
procedure Finalize (Remain : out Natural) is
begin
Count := Count - 1;
Remain := Count;
Debug.Trace (Debug_Name & " shared_data [safe.finalize]:" & Count'Img);
end Finalize;
end Safe_Item;
------------
-- Adjust --
------------
overriding procedure Adjust (P : in out Proxy) is
begin
if P.Safe /= null then
P.Safe.Adjust;
end if;
end Adjust;
--------------
-- Finalize --
--------------
overriding procedure Finalize (P : in out Proxy) is
procedure Free is new Ada.Unchecked_Deallocation (Item, Item_Access);
procedure Free is new Ada.Unchecked_Deallocation (Safe_Item, Safe_Access);
Remain : Natural;
begin
if P.Safe /= null then
P.Safe.Finalize (Remain);
if Remain = 0 then
Free (P.Item);
Free (P.Safe);
end if;
end if;
end Finalize;
end Rx.Tools.Shared_Data;
|