]>
Commit | Line | Data |
---|---|---|
2a738b34 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
b7737d1d | 5 | -- A D A . C O N T A I N E R S . H E L P E R S -- |
2a738b34 AC |
6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 2015-2020, Free Software Foundation, Inc. -- |
2a738b34 AC |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- | |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
26 | ------------------------------------------------------------------------------ | |
27 | ||
b7737d1d | 28 | package body Ada.Containers.Helpers is |
2a738b34 AC |
29 | |
30 | package body Generic_Implementation is | |
31 | ||
14f73211 | 32 | use type SAC.Atomic_Unsigned; |
36f2e3d3 | 33 | |
2a738b34 AC |
34 | ------------ |
35 | -- Adjust -- | |
36 | ------------ | |
37 | ||
38 | procedure Adjust (Control : in out Reference_Control_Type) is | |
2a738b34 AC |
39 | begin |
40 | if Control.T_Counts /= null then | |
2f26abcc | 41 | Busy (Control.T_Counts.all); |
2a738b34 AC |
42 | end if; |
43 | end Adjust; | |
44 | ||
45 | ---------- | |
46 | -- Busy -- | |
47 | ---------- | |
48 | ||
49 | procedure Busy (T_Counts : in out Tamper_Counts) is | |
50 | begin | |
51 | if T_Check then | |
14f73211 | 52 | SAC.Increment (T_Counts.Busy); |
2a738b34 AC |
53 | end if; |
54 | end Busy; | |
55 | ||
56 | -------------- | |
57 | -- Finalize -- | |
58 | -------------- | |
59 | ||
60 | procedure Finalize (Control : in out Reference_Control_Type) is | |
2a738b34 AC |
61 | begin |
62 | if Control.T_Counts /= null then | |
2f26abcc | 63 | Unbusy (Control.T_Counts.all); |
2a738b34 AC |
64 | Control.T_Counts := null; |
65 | end if; | |
66 | end Finalize; | |
67 | ||
68 | -- No need to protect against double Finalize here, because these types | |
69 | -- are limited. | |
70 | ||
71 | procedure Finalize (Busy : in out With_Busy) is | |
16e49553 | 72 | pragma Warnings (Off); |
2a738b34 | 73 | pragma Assert (T_Check); -- not called if check suppressed |
16e49553 | 74 | pragma Warnings (On); |
2a738b34 AC |
75 | begin |
76 | Unbusy (Busy.T_Counts.all); | |
77 | end Finalize; | |
78 | ||
79 | procedure Finalize (Lock : in out With_Lock) is | |
16e49553 | 80 | pragma Warnings (Off); |
2a738b34 | 81 | pragma Assert (T_Check); -- not called if check suppressed |
16e49553 | 82 | pragma Warnings (On); |
2a738b34 AC |
83 | begin |
84 | Unlock (Lock.T_Counts.all); | |
85 | end Finalize; | |
86 | ||
87 | ---------------- | |
88 | -- Initialize -- | |
89 | ---------------- | |
90 | ||
91 | procedure Initialize (Busy : in out With_Busy) is | |
16e49553 | 92 | pragma Warnings (Off); |
2a738b34 | 93 | pragma Assert (T_Check); -- not called if check suppressed |
16e49553 | 94 | pragma Warnings (On); |
2a738b34 AC |
95 | begin |
96 | Generic_Implementation.Busy (Busy.T_Counts.all); | |
97 | end Initialize; | |
98 | ||
99 | procedure Initialize (Lock : in out With_Lock) is | |
16e49553 | 100 | pragma Warnings (Off); |
2a738b34 | 101 | pragma Assert (T_Check); -- not called if check suppressed |
16e49553 | 102 | pragma Warnings (On); |
2a738b34 AC |
103 | begin |
104 | Generic_Implementation.Lock (Lock.T_Counts.all); | |
105 | end Initialize; | |
106 | ||
107 | ---------- | |
108 | -- Lock -- | |
109 | ---------- | |
110 | ||
111 | procedure Lock (T_Counts : in out Tamper_Counts) is | |
112 | begin | |
113 | if T_Check then | |
14f73211 BD |
114 | SAC.Increment (T_Counts.Lock); |
115 | SAC.Increment (T_Counts.Busy); | |
2a738b34 AC |
116 | end if; |
117 | end Lock; | |
118 | ||
119 | -------------- | |
120 | -- TC_Check -- | |
121 | -------------- | |
122 | ||
123 | procedure TC_Check (T_Counts : Tamper_Counts) is | |
124 | begin | |
125 | if T_Check and then T_Counts.Busy > 0 then | |
126 | raise Program_Error with | |
127 | "attempt to tamper with cursors"; | |
128 | end if; | |
14f73211 BD |
129 | |
130 | -- The lock status (which monitors "element tampering") always | |
131 | -- implies that the busy status (which monitors "cursor tampering") | |
132 | -- is set too; this is a representation invariant. Thus if the busy | |
133 | -- bit is not set, then the lock bit must not be set either. | |
134 | ||
135 | pragma Assert (T_Counts.Lock = 0); | |
2a738b34 AC |
136 | end TC_Check; |
137 | ||
138 | -------------- | |
139 | -- TE_Check -- | |
140 | -------------- | |
141 | ||
142 | procedure TE_Check (T_Counts : Tamper_Counts) is | |
143 | begin | |
144 | if T_Check and then T_Counts.Lock > 0 then | |
145 | raise Program_Error with | |
146 | "attempt to tamper with elements"; | |
147 | end if; | |
148 | end TE_Check; | |
149 | ||
150 | ------------ | |
151 | -- Unbusy -- | |
152 | ------------ | |
153 | ||
154 | procedure Unbusy (T_Counts : in out Tamper_Counts) is | |
155 | begin | |
156 | if T_Check then | |
14f73211 | 157 | SAC.Decrement (T_Counts.Busy); |
2a738b34 AC |
158 | end if; |
159 | end Unbusy; | |
160 | ||
161 | ------------ | |
162 | -- Unlock -- | |
163 | ------------ | |
164 | ||
165 | procedure Unlock (T_Counts : in out Tamper_Counts) is | |
166 | begin | |
167 | if T_Check then | |
14f73211 BD |
168 | SAC.Decrement (T_Counts.Lock); |
169 | SAC.Decrement (T_Counts.Busy); | |
2a738b34 AC |
170 | end if; |
171 | end Unlock; | |
172 | ||
173 | ----------------- | |
174 | -- Zero_Counts -- | |
175 | ----------------- | |
176 | ||
177 | procedure Zero_Counts (T_Counts : out Tamper_Counts) is | |
178 | begin | |
179 | if T_Check then | |
180 | T_Counts := (others => <>); | |
181 | end if; | |
182 | end Zero_Counts; | |
183 | ||
184 | end Generic_Implementation; | |
185 | ||
b7737d1d | 186 | end Ada.Containers.Helpers; |