gcc/ada/libgnat/s-elaall.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --         S Y S T E M . E L A B O R A T I O N _ A L L O C A T O R S        --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2014-2017, 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 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 package body System.Elaboration_Allocators is
  33
  34    Elaboration_In_Progress : Boolean;
  35    pragma Atomic (Elaboration_In_Progress);
  36    --  Flag to show if elaboration is active. We don't attempt to initialize
  37    --  this because we want to be sure it gets reset if we are in a multiple
  38    --  elaboration situation of some kind. Make it atomic to prevent race
  39    --  conditions of any kind (not clearly necessary, but harmless!)
  40
  41    ------------------------------
  42    -- Check_Standard_Allocator --
  43    ------------------------------
  44
  45    procedure Check_Standard_Allocator is
  46    begin
  47       if not Elaboration_In_Progress then
  48          raise Program_Error with
  49            "standard allocator after elaboration is complete is not allowed "
  50            & "(No_Standard_Allocators_After_Elaboration restriction active)";
  51       end if;
  52    end Check_Standard_Allocator;
  53
  54    -----------------------------
  55    -- Mark_End_Of_Elaboration --
  56    -----------------------------
  57
  58    procedure Mark_End_Of_Elaboration is
  59    begin
  60       Elaboration_In_Progress := False;
  61    end Mark_End_Of_Elaboration;
  62
  63    -------------------------------
  64    -- Mark_Start_Of_Elaboration --
  65    -------------------------------
  66
  67    procedure Mark_Start_Of_Elaboration is
  68    begin
  69       Elaboration_In_Progress := True;
  70    end Mark_Start_Of_Elaboration;
  71
  72 end System.Elaboration_Allocators;