zfp_genesis 1 ------------------------------------------------------------------------------
zfp_genesis 2 ------------------------------------------------------------------------------
zfp_genesis 3 -- You do not have, nor can you ever acquire the right to use, copy or --
zfp_genesis 4 -- distribute this software ; Should you use this software for any purpose, --
zfp_genesis 5 -- or copy and distribute it to anyone or in any manner, you are breaking --
zfp_genesis 6 -- the laws of whatever soi-disant jurisdiction, and you promise to --
zfp_genesis 7 -- continue doing so for the indefinite future. In any case, please --
zfp_genesis 8 -- always : read and understand any software ; verify any PGP signatures --
zfp_genesis 9 -- that you use - for any purpose. --
zfp_genesis 10 -- --
zfp_genesis 11 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
zfp_genesis 12 ------------------------------------------------------------------------------
zfp_genesis 13 ------------------------------------------------------------------------------
zfp_genesis 14
zfp_genesis 15 package body System.Elaboration_Allocators is
zfp_genesis 16
zfp_genesis 17 Elaboration_In_Progress : Boolean;
zfp_genesis 18 pragma Atomic (Elaboration_In_Progress);
zfp_genesis 19 -- Flag to show if elaboration is active. We don't attempt to initialize
zfp_genesis 20 -- this because we want to be sure it gets reset if we are in a multiple
zfp_genesis 21 -- elaboration situation of some kind. Make it atomic to prevent race
zfp_genesis 22 -- conditions of any kind (not clearly necessary, but harmless!)
zfp_genesis 23
zfp_genesis 24 ------------------------------
zfp_genesis 25 -- Check_Standard_Allocator --
zfp_genesis 26 ------------------------------
zfp_genesis 27
zfp_genesis 28 procedure Check_Standard_Allocator is
zfp_genesis 29 begin
zfp_genesis 30 if not Elaboration_In_Progress then
zfp_genesis 31 raise Program_Error with
zfp_genesis 32 "standard allocator after elaboration is complete is not allowed "
zfp_genesis 33 & "(No_Standard_Allocators_After_Elaboration restriction active)";
zfp_genesis 34 end if;
zfp_genesis 35 end Check_Standard_Allocator;
zfp_genesis 36
zfp_genesis 37 -----------------------------
zfp_genesis 38 -- Mark_End_Of_Elaboration --
zfp_genesis 39 -----------------------------
zfp_genesis 40
zfp_genesis 41 procedure Mark_End_Of_Elaboration is
zfp_genesis 42 begin
zfp_genesis 43 Elaboration_In_Progress := False;
zfp_genesis 44 end Mark_End_Of_Elaboration;
zfp_genesis 45
zfp_genesis 46 -------------------------------
zfp_genesis 47 -- Mark_Start_Of_Elaboration --
zfp_genesis 48 -------------------------------
zfp_genesis 49
zfp_genesis 50 procedure Mark_Start_Of_Elaboration is
zfp_genesis 51 begin
zfp_genesis 52 Elaboration_In_Progress := True;
zfp_genesis 53 end Mark_Start_Of_Elaboration;
zfp_genesis 54
zfp_genesis 55 end System.Elaboration_Allocators;