1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--               A D A . C O N T A I N E R S . H E L P E R S                --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--             Copyright (C) 2015, Free Software Foundation, Inc.           --
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
28with Ada.Finalization;
29with System.Atomic_Counters;
30
31package Ada.Containers.Helpers is
32   pragma Annotate (CodePeer, Skip_Analysis);
33   pragma Pure;
34
35   --  Miscellaneous helpers shared among various containers
36
37   package SAC renames System.Atomic_Counters;
38
39   Count_Type_Last : constant := Count_Type'Last;
40   --  Count_Type'Last as a universal_integer, so we can compare Index_Type
41   --  values against this without type conversions that might overflow.
42
43   type Tamper_Counts is record
44      Busy : aliased SAC.Atomic_Unsigned := 0;
45      Lock : aliased SAC.Atomic_Unsigned := 0;
46   end record;
47
48   --  Busy is positive when tampering with cursors is prohibited. Busy and
49   --  Lock are both positive when tampering with elements is prohibited.
50
51   type Tamper_Counts_Access is access all Tamper_Counts;
52   for Tamper_Counts_Access'Storage_Size use 0;
53
54   generic
55   package Generic_Implementation is
56
57      --  Generic package used in the implementation of containers.
58      --  ???????????????????Currently used by Vectors; not yet by all other
59      --  containers.
60
61      --  This needs to be generic so that the 'Enabled attribute will return
62      --  the value that is relevant at the point where a container generic is
63      --  instantiated. For example:
64      --
65      --     pragma Suppress (Container_Checks);
66      --     package My_Vectors is new Ada.Containers.Vectors (...);
67      --
68      --  should suppress all container-related checks within the instance
69      --  My_Vectors.
70
71      --  Shorthands for "checks enabled" and "tampering checks enabled". Note
72      --  that suppressing either Container_Checks or Tampering_Check disables
73      --  tampering checks. Note that this code needs to be in a generic
74      --  package, because we want to take account of check suppressions at the
75      --  instance. We use these flags, along with pragma Inline, to ensure
76      --  that the compiler can optimize away the checks, as well as the
77      --  tampering check machinery, when checks are suppressed.
78
79      Checks : constant Boolean := Container_Checks'Enabled;
80      T_Check : constant Boolean :=
81        Container_Checks'Enabled and Tampering_Check'Enabled;
82
83      --  Reference_Control_Type is used as a component of reference types, to
84      --  prohibit tampering with elements so long as references exist.
85
86      type Reference_Control_Type is
87         new Finalization.Controlled with record
88            T_Counts : Tamper_Counts_Access;
89         end record
90           with Disable_Controlled => not T_Check;
91
92      overriding procedure Adjust (Control : in out Reference_Control_Type);
93      pragma Inline (Adjust);
94
95      overriding procedure Finalize (Control : in out Reference_Control_Type);
96      pragma Inline (Finalize);
97
98      procedure Zero_Counts (T_Counts : out Tamper_Counts);
99      pragma Inline (Zero_Counts);
100      --  Set Busy and Lock to zero
101
102      procedure Busy (T_Counts : in out Tamper_Counts);
103      pragma Inline (Busy);
104      --  Prohibit tampering with cursors
105
106      procedure Unbusy (T_Counts : in out Tamper_Counts);
107      pragma Inline (Unbusy);
108      --  Allow tampering with cursors
109
110      procedure Lock (T_Counts : in out Tamper_Counts);
111      pragma Inline (Lock);
112      --  Prohibit tampering with elements
113
114      procedure Unlock (T_Counts : in out Tamper_Counts);
115      pragma Inline (Unlock);
116      --  Allow tampering with elements
117
118      procedure TC_Check (T_Counts : Tamper_Counts);
119      pragma Inline (TC_Check);
120      --  Tampering-with-cursors check
121
122      procedure TE_Check (T_Counts : Tamper_Counts);
123      pragma Inline (TE_Check);
124      --  Tampering-with-elements check
125
126      -----------------
127      --  RAII Types --
128      -----------------
129
130      --  Initialize of With_Busy increments the Busy count, and Finalize
131      --  decrements it. Thus, to prohibit tampering with elements within a
132      --  given scope, declare an object of type With_Busy. The Busy count
133      --  will be correctly decremented in case of exception or abort.
134
135      --  With_Lock is the same as With_Busy, except it increments/decrements
136      --  BOTH Busy and Lock, thus prohibiting tampering with cursors.
137
138      type With_Busy (T_Counts : not null access Tamper_Counts) is
139        new Finalization.Limited_Controlled with null record
140          with Disable_Controlled => not T_Check;
141      overriding procedure Initialize (Busy : in out With_Busy);
142      overriding procedure Finalize (Busy : in out With_Busy);
143
144      type With_Lock (T_Counts : not null access Tamper_Counts) is
145        new Finalization.Limited_Controlled with null record
146          with Disable_Controlled => not T_Check;
147      overriding procedure Initialize (Lock : in out With_Lock);
148      overriding procedure Finalize (Lock : in out With_Lock);
149
150      --  Variables of type With_Busy and With_Lock are declared only for the
151      --  effects of Initialize and Finalize, so they are not referenced;
152      --  disable warnings about that. Note that all variables of these types
153      --  have names starting with "Busy" or "Lock". These pragmas need to be
154      --  present wherever these types are used.
155
156      pragma Warnings (Off, "variable ""Busy*"" is not referenced");
157      pragma Warnings (Off, "variable ""Lock*"" is not referenced");
158
159   end Generic_Implementation;
160
161end Ada.Containers.Helpers;
162