gcc/ada/a-conhel.ads

   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
  28 with Ada.Finalization;
  29 with System.Atomic_Counters;
  30
  31 package 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
 161 end Ada.Containers.Helpers;