[gcc.git] / gcc / ada / opt.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                  O P T                                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Gnatvsn; use Gnatvsn;
with System;  use System;
with Tree_IO; use Tree_IO;

package body Opt is

   SU : constant := Storage_Unit;
   --  Shorthand for System.Storage_Unit

   -------------------------
   -- Back_End_Exceptions --
   -------------------------

   function Back_End_Exceptions return Boolean is
   begin
      return
        Exception_Mechanism = Back_End_SJLJ
          or else
        Exception_Mechanism = Back_End_ZCX;
   end Back_End_Exceptions;

   -------------------------
   -- Front_End_Exceptions --
   -------------------------

   function Front_End_Exceptions return Boolean is
   begin
      return Exception_Mechanism = Front_End_SJLJ;
   end Front_End_Exceptions;

   --------------------
   -- SJLJ_Exceptions --
   --------------------

   function SJLJ_Exceptions return Boolean is
   begin
      return
        Exception_Mechanism = Back_End_SJLJ
          or else
        Exception_Mechanism = Front_End_SJLJ;
   end SJLJ_Exceptions;

   --------------------
   -- ZCX_Exceptions --
   --------------------

   function ZCX_Exceptions return Boolean is
   begin
      return Exception_Mechanism = Back_End_ZCX;
   end ZCX_Exceptions;

   ------------------------------
   -- Register_Config_Switches --
   ------------------------------

   procedure Register_Config_Switches is
   begin
      Ada_Version_Config                    := Ada_Version;
      Ada_Version_Pragma_Config             := Ada_Version_Pragma;
      Ada_Version_Explicit_Config           := Ada_Version_Explicit;
      Assertions_Enabled_Config             := Assertions_Enabled;
      Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
      Check_Float_Overflow_Config           := Check_Float_Overflow;
      Check_Policy_List_Config              := Check_Policy_List;
      Default_Pool_Config                   := Default_Pool;
      Default_SSO_Config                    := Default_SSO;
      Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
      Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
      Extensions_Allowed_Config             := Extensions_Allowed;
      External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
      External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
      Fast_Math_Config                      := Fast_Math;
      Initialize_Scalars_Config             := Initialize_Scalars;
      No_Component_Reordering_Config        := No_Component_Reordering;
      Optimize_Alignment_Config             := Optimize_Alignment;
      Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
      Polling_Required_Config               := Polling_Required;
      Prefix_Exception_Messages_Config      := Prefix_Exception_Messages;
      SPARK_Mode_Config                     := SPARK_Mode;
      SPARK_Mode_Pragma_Config              := SPARK_Mode_Pragma;
      Uneval_Old_Config                     := Uneval_Old;
      Use_VADS_Size_Config                  := Use_VADS_Size;
      Warnings_As_Errors_Count_Config       := Warnings_As_Errors_Count;

      --  Reset the indication that Optimize_Alignment was set locally, since
      --  if we had a pragma in the config file, it would set this flag True,
      --  but that's not a local setting.

      Optimize_Alignment_Local := False;
   end Register_Config_Switches;

   -----------------------------
   -- Restore_Config_Switches --
   -----------------------------

   procedure Restore_Config_Switches (Save : Config_Switches_Type) is
   begin
      Ada_Version                    := Save.Ada_Version;
      Ada_Version_Pragma             := Save.Ada_Version_Pragma;
      Ada_Version_Explicit           := Save.Ada_Version_Explicit;
      Assertions_Enabled             := Save.Assertions_Enabled;
      Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
      Check_Float_Overflow           := Save.Check_Float_Overflow;
      Check_Policy_List              := Save.Check_Policy_List;
      Default_Pool                   := Save.Default_Pool;
      Default_SSO                    := Save.Default_SSO;
      Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
      Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
      Extensions_Allowed             := Save.Extensions_Allowed;
      External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
      External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
      Fast_Math                      := Save.Fast_Math;
      Initialize_Scalars             := Save.Initialize_Scalars;
      No_Component_Reordering        := Save.No_Component_Reordering;
      Optimize_Alignment             := Save.Optimize_Alignment;
      Optimize_Alignment_Local       := Save.Optimize_Alignment_Local;
      Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
      Polling_Required               := Save.Polling_Required;
      Prefix_Exception_Messages      := Save.Prefix_Exception_Messages;
      SPARK_Mode                     := Save.SPARK_Mode;
      SPARK_Mode_Pragma              := Save.SPARK_Mode_Pragma;
      Uneval_Old                     := Save.Uneval_Old;
      Use_VADS_Size                  := Save.Use_VADS_Size;
      Warnings_As_Errors_Count       := Save.Warnings_As_Errors_Count;

      --  Update consistently the value of Init_Or_Norm_Scalars. The value of
      --  Normalize_Scalars is not saved/restored because after set to True its
      --  value is never changed. That is, if a compilation unit has pragma
      --  Normalize_Scalars then it forces that value for all with'ed units.

      Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
   end Restore_Config_Switches;

   --------------------------
   -- Save_Config_Switches --
   --------------------------

   function Save_Config_Switches return Config_Switches_Type is
   begin
      return
        (Ada_Version                    => Ada_Version,
         Ada_Version_Pragma             => Ada_Version_Pragma,
         Ada_Version_Explicit           => Ada_Version_Explicit,
         Assertions_Enabled             => Assertions_Enabled,
         Assume_No_Invalid_Values       => Assume_No_Invalid_Values,
         Check_Float_Overflow           => Check_Float_Overflow,
         Check_Policy_List              => Check_Policy_List,
         Default_Pool                   => Default_Pool,
         Default_SSO                    => Default_SSO,
         Dynamic_Elaboration_Checks     => Dynamic_Elaboration_Checks,
         Exception_Locations_Suppressed => Exception_Locations_Suppressed,
         Extensions_Allowed             => Extensions_Allowed,
         External_Name_Exp_Casing       => External_Name_Exp_Casing,
         External_Name_Imp_Casing       => External_Name_Imp_Casing,
         Fast_Math                      => Fast_Math,
         Initialize_Scalars             => Initialize_Scalars,
         No_Component_Reordering        => No_Component_Reordering,
         Normalize_Scalars              => Normalize_Scalars,
         Optimize_Alignment             => Optimize_Alignment,
         Optimize_Alignment_Local       => Optimize_Alignment_Local,
         Persistent_BSS_Mode            => Persistent_BSS_Mode,
         Polling_Required               => Polling_Required,
         Prefix_Exception_Messages      => Prefix_Exception_Messages,
         SPARK_Mode                     => SPARK_Mode,
         SPARK_Mode_Pragma              => SPARK_Mode_Pragma,
         Uneval_Old                     => Uneval_Old,
         Use_VADS_Size                  => Use_VADS_Size,
         Warnings_As_Errors_Count       => Warnings_As_Errors_Count);
   end Save_Config_Switches;

   -------------------------
   -- Set_Config_Switches --
   -------------------------

   procedure Set_Config_Switches
     (Internal_Unit : Boolean;
      Main_Unit     : Boolean)
   is
   begin
      --  Case of internal unit

      if Internal_Unit then

         --  Set standard switches. Note we do NOT set Ada_Version_Explicit
         --  since the whole point of this is that it still properly indicates
         --  the configuration setting even in a run time unit.

         Ada_Version                 := Ada_Version_Runtime;
         Ada_Version_Pragma          := Empty;
         Default_SSO                 := ' ';
         Dynamic_Elaboration_Checks  := False;
         Extensions_Allowed          := True;
         External_Name_Exp_Casing    := As_Is;
         External_Name_Imp_Casing    := Lowercase;
         No_Component_Reordering     := False;
         Optimize_Alignment          := 'O';
         Optimize_Alignment_Local    := True;
         Persistent_BSS_Mode         := False;
         Prefix_Exception_Messages   := True;
         Uneval_Old                  := 'E';
         Use_VADS_Size               := False;

         --  Note: we do not need to worry about Warnings_As_Errors_Count since
         --  we do not expect to get any warnings from compiling such a unit.

         --  For an internal unit, assertions/debug pragmas are off unless this
         --  is the main unit and they were explicitly enabled, or unless the
         --  main unit was compiled in GNAT mode. We also make sure we do not
         --  assume that values are necessarily valid and that SPARK_Mode is
         --  set to its configuration value.

         if Main_Unit then
            Assertions_Enabled       := Assertions_Enabled_Config;
            Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
            Check_Policy_List        := Check_Policy_List_Config;
            SPARK_Mode               := SPARK_Mode_Config;
            SPARK_Mode_Pragma        := SPARK_Mode_Pragma_Config;

         else
            if GNAT_Mode_Config then
               Assertions_Enabled    := Assertions_Enabled_Config;
            else
               Assertions_Enabled    := False;
            end if;

            Assume_No_Invalid_Values := False;
            Check_Policy_List        := Empty;
            SPARK_Mode               := None;
            SPARK_Mode_Pragma        := Empty;
         end if;

      --  Case of non-internal unit

      else
         Ada_Version                 := Ada_Version_Config;
         Ada_Version_Pragma          := Ada_Version_Pragma_Config;
         Ada_Version_Explicit        := Ada_Version_Explicit_Config;
         Assertions_Enabled          := Assertions_Enabled_Config;
         Assume_No_Invalid_Values    := Assume_No_Invalid_Values_Config;
         Check_Float_Overflow        := Check_Float_Overflow_Config;
         Check_Policy_List           := Check_Policy_List_Config;
         Default_SSO                 := Default_SSO_Config;
         Dynamic_Elaboration_Checks  := Dynamic_Elaboration_Checks_Config;
         Extensions_Allowed          := Extensions_Allowed_Config;
         External_Name_Exp_Casing    := External_Name_Exp_Casing_Config;
         External_Name_Imp_Casing    := External_Name_Imp_Casing_Config;
         Fast_Math                   := Fast_Math_Config;
         Initialize_Scalars          := Initialize_Scalars_Config;
         No_Component_Reordering     := No_Component_Reordering_Config;
         Optimize_Alignment          := Optimize_Alignment_Config;
         Optimize_Alignment_Local    := False;
         Persistent_BSS_Mode         := Persistent_BSS_Mode_Config;
         Prefix_Exception_Messages   := Prefix_Exception_Messages_Config;
         SPARK_Mode                  := SPARK_Mode_Config;
         SPARK_Mode_Pragma           := SPARK_Mode_Pragma_Config;
         Uneval_Old                  := Uneval_Old_Config;
         Use_VADS_Size               := Use_VADS_Size_Config;
         Warnings_As_Errors_Count    := Warnings_As_Errors_Count_Config;

         --  Update consistently the value of Init_Or_Norm_Scalars. The value
         --  of Normalize_Scalars is not saved/restored because once set to
         --  True its value is never changed. That is, if a compilation unit
         --  has pragma Normalize_Scalars then it forces that value for all
         --  with'ed units.

         Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
      end if;

      --  Values set for all units

      Default_Pool                   := Default_Pool_Config;
      Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
      Fast_Math                      := Fast_Math_Config;
      Polling_Required               := Polling_Required_Config;
   end Set_Config_Switches;

   ---------------
   -- Tree_Read --
   ---------------

   procedure Tree_Read is
      Tree_Version_String_Len         : Nat;
      Ada_Version_Config_Val          : Nat;
      Ada_Version_Explicit_Config_Val : Nat;
      Assertions_Enabled_Config_Val   : Nat;

   begin
      Tree_Read_Int  (Tree_ASIS_Version_Number);

      Tree_Read_Bool (Address_Is_Private);
      Tree_Read_Bool (Brief_Output);
      Tree_Read_Bool (GNAT_Mode);
      Tree_Read_Char (Identifier_Character_Set);
      Tree_Read_Bool (Ignore_Rep_Clauses);
      Tree_Read_Bool (Ignore_Style_Checks_Pragmas);
      Tree_Read_Int  (Maximum_File_Name_Length);
      Tree_Read_Data (Suppress_Options'Address,
                      (Suppress_Options'Size + SU - 1) / SU);
      Tree_Read_Bool (Verbose_Mode);
      Tree_Read_Data (Warning_Mode'Address,
                      (Warning_Mode'Size + SU - 1) / SU);
      Tree_Read_Int  (Ada_Version_Config_Val);
      Tree_Read_Int  (Ada_Version_Explicit_Config_Val);
      Tree_Read_Int  (Assertions_Enabled_Config_Val);
      Tree_Read_Bool (All_Errors_Mode);
      Tree_Read_Bool (Assertions_Enabled);
      Tree_Read_Bool (Check_Float_Overflow);
      Tree_Read_Int  (Int (Check_Policy_List));
      Tree_Read_Int  (Int (Default_Pool));
      Tree_Read_Bool (Full_List);

      Ada_Version_Config :=
        Ada_Version_Type'Val (Ada_Version_Config_Val);
      Ada_Version_Explicit_Config :=
        Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
      Assertions_Enabled_Config :=
        Boolean'Val (Assertions_Enabled_Config_Val);

      --  Read version string: we have to get the length first

      Tree_Read_Int (Tree_Version_String_Len);

      declare
         Tmp : String (1 .. Integer (Tree_Version_String_Len));
      begin
         Tree_Read_Data
           (Tmp'Address, Tree_Version_String_Len);
         System.Strings.Free (Tree_Version_String);
         Free (Tree_Version_String);
         Tree_Version_String := new String'(Tmp);
      end;

      Tree_Read_Data (Distribution_Stub_Mode'Address,
                      (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
      Tree_Read_Bool (Inline_Active);
      Tree_Read_Bool (Inline_Processing_Required);
      Tree_Read_Bool (List_Units);
      Tree_Read_Int  (Multiple_Unit_Index);
      Tree_Read_Bool (Configurable_Run_Time_Mode);
      Tree_Read_Data (Operating_Mode'Address,
                      (Operating_Mode'Size + SU - 1) / Storage_Unit);
      Tree_Read_Bool (Suppress_Checks);
      Tree_Read_Bool (Try_Semantics);
      Tree_Read_Data (Wide_Character_Encoding_Method'Address,
                      (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
      Tree_Read_Bool (Upper_Half_Encoding);
      Tree_Read_Bool (Force_ALI_Tree_File);
   end Tree_Read;

   ----------------
   -- Tree_Write --
   ----------------

   procedure Tree_Write is
      Version_String : String := Gnat_Version_String;

   begin
      Tree_Write_Int  (ASIS_Version_Number);

      Tree_Write_Bool (Address_Is_Private);
      Tree_Write_Bool (Brief_Output);
      Tree_Write_Bool (GNAT_Mode);
      Tree_Write_Char (Identifier_Character_Set);
      Tree_Write_Bool (Ignore_Rep_Clauses);
      Tree_Write_Bool (Ignore_Style_Checks_Pragmas);
      Tree_Write_Int  (Maximum_File_Name_Length);
      Tree_Write_Data (Suppress_Options'Address,
                       (Suppress_Options'Size + SU - 1) / SU);
      Tree_Write_Bool (Verbose_Mode);
      Tree_Write_Data (Warning_Mode'Address,
                       (Warning_Mode'Size + SU - 1) / Storage_Unit);
      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Config));
      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
      Tree_Write_Int  (Boolean'Pos (Assertions_Enabled_Config));
      Tree_Write_Bool (All_Errors_Mode);
      Tree_Write_Bool (Assertions_Enabled);
      Tree_Write_Bool (Check_Float_Overflow);
      Tree_Write_Int  (Int (Check_Policy_List));
      Tree_Write_Int  (Int (Default_Pool));
      Tree_Write_Bool (Full_List);
      Tree_Write_Int  (Int (Version_String'Length));
      Tree_Write_Data (Version_String'Address, Version_String'Length);
      Tree_Write_Data (Distribution_Stub_Mode'Address,
                       (Distribution_Stub_Mode'Size + SU - 1) / SU);
      Tree_Write_Bool (Inline_Active);
      Tree_Write_Bool (Inline_Processing_Required);
      Tree_Write_Bool (List_Units);
      Tree_Write_Int  (Multiple_Unit_Index);
      Tree_Write_Bool (Configurable_Run_Time_Mode);
      Tree_Write_Data (Operating_Mode'Address,
                       (Operating_Mode'Size + SU - 1) / SU);
      Tree_Write_Bool (Suppress_Checks);
      Tree_Write_Bool (Try_Semantics);
      Tree_Write_Data (Wide_Character_Encoding_Method'Address,
                       (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
      Tree_Write_Bool (Upper_Half_Encoding);
      Tree_Write_Bool (Force_ALI_Tree_File);
   end Tree_Write;

end Opt;
Commit	Line	Data
38cbfe40 RK	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
	5	-- O P T --
	6	-- --
	7	-- B o d y --
	8	-- --
1d005acc	9	-- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
38cbfe40 RK	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- --
748086b7	13	-- ware Foundation; either version 3, or (at your option) any later ver- --
38cbfe40 RK	14	-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
38cbfe40 RK	15	-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
748086b7 JJ	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/>. --
38cbfe40 RK	26	-- --
38cbfe40 RK	27	-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc	28	-- Extensive contributions were provided by Ada Core Technologies Inc. --
38cbfe40 RK	29	-- --
	30	------------------------------------------------------------------------------
	31
1f6a2b51	32	with Gnatvsn; use Gnatvsn;
38cbfe40 RK	33	with System; use System;
	34	with Tree_IO; use Tree_IO;
	35
	36	package body Opt is
	37
fbe627af RD	38	SU : constant := Storage_Unit;
	39	-- Shorthand for System.Storage_Unit
	40
0ab0bf95 OH	41	-------------------------
	42	-- Back_End_Exceptions --
	43	-------------------------
	44
	45	function Back_End_Exceptions return Boolean is
	46	begin
3429710e AC	47	return
	48	Exception_Mechanism = Back_End_SJLJ
	49	or else
	50	Exception_Mechanism = Back_End_ZCX;
0ab0bf95 OH	51	end Back_End_Exceptions;
	52
	53	-------------------------
	54	-- Front_End_Exceptions --
	55	-------------------------
	56
	57	function Front_End_Exceptions return Boolean is
	58	begin
	59	return Exception_Mechanism = Front_End_SJLJ;
	60	end Front_End_Exceptions;
	61
	62	--------------------
	63	-- SJLJ_Exceptions --
	64	--------------------
	65
	66	function SJLJ_Exceptions return Boolean is
	67	begin
3429710e AC	68	return
	69	Exception_Mechanism = Back_End_SJLJ
	70	or else
	71	Exception_Mechanism = Front_End_SJLJ;
0ab0bf95 OH	72	end SJLJ_Exceptions;
	73
	74	--------------------
	75	-- ZCX_Exceptions --
	76	--------------------
	77
	78	function ZCX_Exceptions return Boolean is
	79	begin
	80	return Exception_Mechanism = Back_End_ZCX;
	81	end ZCX_Exceptions;
	82
9cc97ad5 HK	83	------------------------------
	84	-- Register_Config_Switches --
	85	------------------------------
38cbfe40	86
9cc97ad5	87	procedure Register_Config_Switches is
38cbfe40	88	begin
0ab80019	89	Ada_Version_Config := Ada_Version;
fb620b37	90	Ada_Version_Pragma_Config := Ada_Version_Pragma;
f81e6250 RD	91	Ada_Version_Explicit_Config := Ada_Version_Explicit;
f81e6250 RD	92	Assertions_Enabled_Config := Assertions_Enabled;
4351c21b	93	Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values;
347c766a	94	Check_Float_Overflow_Config := Check_Float_Overflow;
ce4a6e84	95	Check_Policy_List_Config := Check_Policy_List;
fab2daeb	96	Default_Pool_Config := Default_Pool;
220d1fd9	97	Default_SSO_Config := Default_SSO;
fbf5a39b AC	98	Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
	99	Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
	100	Extensions_Allowed_Config := Extensions_Allowed;
	101	External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
	102	External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
470cd9e9	103	Fast_Math_Config := Fast_Math;
82878151	104	Initialize_Scalars_Config := Initialize_Scalars;
8489c295	105	No_Component_Reordering_Config := No_Component_Reordering;
1b24ada5	106	Optimize_Alignment_Config := Optimize_Alignment;
f81e6250	107	Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
fbf5a39b	108	Polling_Required_Config := Polling_Required;
8f819471	109	Prefix_Exception_Messages_Config := Prefix_Exception_Messages;
43417b90	110	SPARK_Mode_Config := SPARK_Mode;
ea0f1fc8	111	SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma;
96e90ac1	112	Uneval_Old_Config := Uneval_Old;
fbf5a39b	113	Use_VADS_Size_Config := Use_VADS_Size;
0c3985a9	114	Warnings_As_Errors_Count_Config := Warnings_As_Errors_Count;
ce4a6e84 RD	115
	116	-- Reset the indication that Optimize_Alignment was set locally, since
	117	-- if we had a pragma in the config file, it would set this flag True,
	118	-- but that's not a local setting.
	119
	120	Optimize_Alignment_Local := False;
9cc97ad5	121	end Register_Config_Switches;
38cbfe40	122
9cc97ad5 HK	123	-----------------------------
	124	-- Restore_Config_Switches --
	125	-----------------------------
38cbfe40	126
9cc97ad5	127	procedure Restore_Config_Switches (Save : Config_Switches_Type) is
38cbfe40	128	begin
0ab80019	129	Ada_Version := Save.Ada_Version;
fb620b37	130	Ada_Version_Pragma := Save.Ada_Version_Pragma;
f81e6250 RD	131	Ada_Version_Explicit := Save.Ada_Version_Explicit;
f81e6250 RD	132	Assertions_Enabled := Save.Assertions_Enabled;
4351c21b	133	Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values;
347c766a	134	Check_Float_Overflow := Save.Check_Float_Overflow;
ce4a6e84	135	Check_Policy_List := Save.Check_Policy_List;
fab2daeb	136	Default_Pool := Save.Default_Pool;
220d1fd9	137	Default_SSO := Save.Default_SSO;
fbf5a39b AC	138	Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
	139	Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
	140	Extensions_Allowed := Save.Extensions_Allowed;
	141	External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
	142	External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
470cd9e9	143	Fast_Math := Save.Fast_Math;
82878151	144	Initialize_Scalars := Save.Initialize_Scalars;
8489c295	145	No_Component_Reordering := Save.No_Component_Reordering;
1b24ada5	146	Optimize_Alignment := Save.Optimize_Alignment;
ce4a6e84	147	Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
f81e6250	148	Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
fbf5a39b	149	Polling_Required := Save.Polling_Required;
8f819471	150	Prefix_Exception_Messages := Save.Prefix_Exception_Messages;
43417b90	151	SPARK_Mode := Save.SPARK_Mode;
19992053	152	SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma;
96e90ac1	153	Uneval_Old := Save.Uneval_Old;
fbf5a39b	154	Use_VADS_Size := Save.Use_VADS_Size;
0c3985a9	155	Warnings_As_Errors_Count := Save.Warnings_As_Errors_Count;
6a2e5d0f AC	156
	157	-- Update consistently the value of Init_Or_Norm_Scalars. The value of
	158	-- Normalize_Scalars is not saved/restored because after set to True its
	159	-- value is never changed. That is, if a compilation unit has pragma
	160	-- Normalize_Scalars then it forces that value for all with'ed units.
	161
	162	Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
9cc97ad5	163	end Restore_Config_Switches;
38cbfe40	164
9cc97ad5 HK	165	--------------------------
	166	-- Save_Config_Switches --
	167	--------------------------
38cbfe40	168
9cc97ad5	169	function Save_Config_Switches return Config_Switches_Type is
38cbfe40	170	begin
9cc97ad5 HK	171	return
	172	(Ada_Version => Ada_Version,
	173	Ada_Version_Pragma => Ada_Version_Pragma,
	174	Ada_Version_Explicit => Ada_Version_Explicit,
	175	Assertions_Enabled => Assertions_Enabled,
	176	Assume_No_Invalid_Values => Assume_No_Invalid_Values,
	177	Check_Float_Overflow => Check_Float_Overflow,
	178	Check_Policy_List => Check_Policy_List,
	179	Default_Pool => Default_Pool,
	180	Default_SSO => Default_SSO,
	181	Dynamic_Elaboration_Checks => Dynamic_Elaboration_Checks,
	182	Exception_Locations_Suppressed => Exception_Locations_Suppressed,
	183	Extensions_Allowed => Extensions_Allowed,
	184	External_Name_Exp_Casing => External_Name_Exp_Casing,
	185	External_Name_Imp_Casing => External_Name_Imp_Casing,
	186	Fast_Math => Fast_Math,
	187	Initialize_Scalars => Initialize_Scalars,
	188	No_Component_Reordering => No_Component_Reordering,
	189	Normalize_Scalars => Normalize_Scalars,
	190	Optimize_Alignment => Optimize_Alignment,
	191	Optimize_Alignment_Local => Optimize_Alignment_Local,
	192	Persistent_BSS_Mode => Persistent_BSS_Mode,
	193	Polling_Required => Polling_Required,
	194	Prefix_Exception_Messages => Prefix_Exception_Messages,
	195	SPARK_Mode => SPARK_Mode,
	196	SPARK_Mode_Pragma => SPARK_Mode_Pragma,
	197	Uneval_Old => Uneval_Old,
	198	Use_VADS_Size => Use_VADS_Size,
	199	Warnings_As_Errors_Count => Warnings_As_Errors_Count);
	200	end Save_Config_Switches;
38cbfe40	201
9cc97ad5 HK	202	-------------------------
	203	-- Set_Config_Switches --
	204	-------------------------
38cbfe40	205
9cc97ad5	206	procedure Set_Config_Switches
6e18b0e5 RD	207	(Internal_Unit : Boolean;
	208	Main_Unit : Boolean)
	209	is
38cbfe40	210	begin
6e18b0e5 RD	211	-- Case of internal unit
6e18b0e5 RD	212
38cbfe40	213	if Internal_Unit then
1f6a2b51 RD	214
	215	-- Set standard switches. Note we do NOT set Ada_Version_Explicit
	216	-- since the whole point of this is that it still properly indicates
	217	-- the configuration setting even in a run time unit.
	218
4351c21b	219	Ada_Version := Ada_Version_Runtime;
fb620b37	220	Ada_Version_Pragma := Empty;
35fdafcd	221	Default_SSO := ' ';
4351c21b AC	222	Dynamic_Elaboration_Checks := False;
	223	Extensions_Allowed := True;
	224	External_Name_Exp_Casing := As_Is;
	225	External_Name_Imp_Casing := Lowercase;
8489c295	226	No_Component_Reordering := False;
4351c21b	227	Optimize_Alignment := 'O';
99bba92c	228	Optimize_Alignment_Local := True;
4351c21b	229	Persistent_BSS_Mode := False;
8f819471	230	Prefix_Exception_Messages := True;
96e90ac1	231	Uneval_Old := 'E';
4351c21b	232	Use_VADS_Size := False;
38cbfe40	233
0c3985a9 AC	234	-- Note: we do not need to worry about Warnings_As_Errors_Count since
	235	-- we do not expect to get any warnings from compiling such a unit.
	236
6e18b0e5	237	-- For an internal unit, assertions/debug pragmas are off unless this
9ec98e13 AC	238	-- is the main unit and they were explicitly enabled, or unless the
	239	-- main unit was compiled in GNAT mode. We also make sure we do not
	240	-- assume that values are necessarily valid and that SPARK_Mode is
	241	-- set to its configuration value.
6e18b0e5 RD	242
6e18b0e5 RD	243	if Main_Unit then
4351c21b AC	244	Assertions_Enabled := Assertions_Enabled_Config;
4351c21b AC	245	Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
4351c21b	246	Check_Policy_List := Check_Policy_List_Config;
c733429f AC	247	SPARK_Mode := SPARK_Mode_Config;
c733429f AC	248	SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
9cc97ad5	249
6e18b0e5	250	else
9ec98e13 AC	251	if GNAT_Mode_Config then
	252	Assertions_Enabled := Assertions_Enabled_Config;
	253	else
	254	Assertions_Enabled := False;
	255	end if;
9cc97ad5	256
4351c21b	257	Assume_No_Invalid_Values := False;
4351c21b	258	Check_Policy_List := Empty;
8fdafe44	259	SPARK_Mode := None;
c733429f	260	SPARK_Mode_Pragma := Empty;
6e18b0e5 RD	261	end if;
	262
	263	-- Case of non-internal unit
	264
38cbfe40	265	else
ce4a6e84	266	Ada_Version := Ada_Version_Config;
fb620b37	267	Ada_Version_Pragma := Ada_Version_Pragma_Config;
ce4a6e84 RD	268	Ada_Version_Explicit := Ada_Version_Explicit_Config;
ce4a6e84 RD	269	Assertions_Enabled := Assertions_Enabled_Config;
4351c21b	270	Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
347c766a	271	Check_Float_Overflow := Check_Float_Overflow_Config;
ce4a6e84	272	Check_Policy_List := Check_Policy_List_Config;
220d1fd9	273	Default_SSO := Default_SSO_Config;
ce4a6e84 RD	274	Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
	275	Extensions_Allowed := Extensions_Allowed_Config;
	276	External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
	277	External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
	278	Fast_Math := Fast_Math_Config;
82878151	279	Initialize_Scalars := Initialize_Scalars_Config;
8489c295	280	No_Component_Reordering := No_Component_Reordering_Config;
ce4a6e84 RD	281	Optimize_Alignment := Optimize_Alignment_Config;
	282	Optimize_Alignment_Local := False;
	283	Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
8f819471	284	Prefix_Exception_Messages := Prefix_Exception_Messages_Config;
43417b90	285	SPARK_Mode := SPARK_Mode_Config;
c733429f	286	SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config;
96e90ac1	287	Uneval_Old := Uneval_Old_Config;
ce4a6e84	288	Use_VADS_Size := Use_VADS_Size_Config;
0c3985a9	289	Warnings_As_Errors_Count := Warnings_As_Errors_Count_Config;
6a2e5d0f AC	290
	291	-- Update consistently the value of Init_Or_Norm_Scalars. The value
	292	-- of Normalize_Scalars is not saved/restored because once set to
	293	-- True its value is never changed. That is, if a compilation unit
	294	-- has pragma Normalize_Scalars then it forces that value for all
	295	-- with'ed units.
	296
	297	Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
38cbfe40 RK	298	end if;
38cbfe40 RK	299
8f819471 RD	300	-- Values set for all units
8f819471 RD	301
fab2daeb	302	Default_Pool := Default_Pool_Config;
fbf5a39b	303	Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
470cd9e9	304	Fast_Math := Fast_Math_Config;
fbf5a39b	305	Polling_Required := Polling_Required_Config;
9cc97ad5	306	end Set_Config_Switches;
38cbfe40 RK	307
	308	---------------
	309	-- Tree_Read --
	310	---------------
	311
	312	procedure Tree_Read is
f81e6250 RD	313	Tree_Version_String_Len : Nat;
	314	Ada_Version_Config_Val : Nat;
	315	Ada_Version_Explicit_Config_Val : Nat;
	316	Assertions_Enabled_Config_Val : Nat;
38cbfe40 RK	317
38cbfe40 RK	318	begin
fbf5a39b	319	Tree_Read_Int (Tree_ASIS_Version_Number);
39678b1c AC	320
39678b1c AC	321	Tree_Read_Bool (Address_Is_Private);
38cbfe40 RK	322	Tree_Read_Bool (Brief_Output);
	323	Tree_Read_Bool (GNAT_Mode);
	324	Tree_Read_Char (Identifier_Character_Set);
39678b1c AC	325	Tree_Read_Bool (Ignore_Rep_Clauses);
39678b1c AC	326	Tree_Read_Bool (Ignore_Style_Checks_Pragmas);
38cbfe40 RK	327	Tree_Read_Int (Maximum_File_Name_Length);
38cbfe40 RK	328	Tree_Read_Data (Suppress_Options'Address,
fbe627af	329	(Suppress_Options'Size + SU - 1) / SU);
38cbfe40 RK	330	Tree_Read_Bool (Verbose_Mode);
38cbfe40 RK	331	Tree_Read_Data (Warning_Mode'Address,
fbe627af	332	(Warning_Mode'Size + SU - 1) / SU);
0ab80019	333	Tree_Read_Int (Ada_Version_Config_Val);
f81e6250 RD	334	Tree_Read_Int (Ada_Version_Explicit_Config_Val);
f81e6250 RD	335	Tree_Read_Int (Assertions_Enabled_Config_Val);
38cbfe40 RK	336	Tree_Read_Bool (All_Errors_Mode);
38cbfe40 RK	337	Tree_Read_Bool (Assertions_Enabled);
347c766a	338	Tree_Read_Bool (Check_Float_Overflow);
ce4a6e84	339	Tree_Read_Int (Int (Check_Policy_List));
fab2daeb	340	Tree_Read_Int (Int (Default_Pool));
38cbfe40 RK	341	Tree_Read_Bool (Full_List);
38cbfe40 RK	342
f81e6250 RD	343	Ada_Version_Config :=
	344	Ada_Version_Type'Val (Ada_Version_Config_Val);
	345	Ada_Version_Explicit_Config :=
	346	Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
	347	Assertions_Enabled_Config :=
	348	Boolean'Val (Assertions_Enabled_Config_Val);
0ab80019	349
1f6a2b51	350	-- Read version string: we have to get the length first
38cbfe40 RK	351
	352	Tree_Read_Int (Tree_Version_String_Len);
	353
1f6a2b51 RD	354	declare
	355	Tmp : String (1 .. Integer (Tree_Version_String_Len));
	356	begin
38cbfe40	357	Tree_Read_Data
1f6a2b51	358	(Tmp'Address, Tree_Version_String_Len);
fbe627af	359	System.Strings.Free (Tree_Version_String);
1f6a2b51 RD	360	Free (Tree_Version_String);
	361	Tree_Version_String := new String'(Tmp);
	362	end;
38cbfe40 RK	363
38cbfe40 RK	364	Tree_Read_Data (Distribution_Stub_Mode'Address,
fbe627af	365	(Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
38cbfe40 RK	366	Tree_Read_Bool (Inline_Active);
	367	Tree_Read_Bool (Inline_Processing_Required);
	368	Tree_Read_Bool (List_Units);
39678b1c	369	Tree_Read_Int (Multiple_Unit_Index);
fbf5a39b	370	Tree_Read_Bool (Configurable_Run_Time_Mode);
38cbfe40	371	Tree_Read_Data (Operating_Mode'Address,
fbe627af	372	(Operating_Mode'Size + SU - 1) / Storage_Unit);
07fc65c4	373	Tree_Read_Bool (Suppress_Checks);
38cbfe40 RK	374	Tree_Read_Bool (Try_Semantics);
38cbfe40 RK	375	Tree_Read_Data (Wide_Character_Encoding_Method'Address,
fbe627af	376	(Wide_Character_Encoding_Method'Size + SU - 1) / SU);
38cbfe40 RK	377	Tree_Read_Bool (Upper_Half_Encoding);
	378	Tree_Read_Bool (Force_ALI_Tree_File);
	379	end Tree_Read;
	380
	381	----------------
	382	-- Tree_Write --
	383	----------------
	384
	385	procedure Tree_Write is
6c1e24d3	386	Version_String : String := Gnat_Version_String;
1f6a2b51	387
38cbfe40	388	begin
fbf5a39b	389	Tree_Write_Int (ASIS_Version_Number);
39678b1c AC	390
39678b1c AC	391	Tree_Write_Bool (Address_Is_Private);
38cbfe40 RK	392	Tree_Write_Bool (Brief_Output);
	393	Tree_Write_Bool (GNAT_Mode);
	394	Tree_Write_Char (Identifier_Character_Set);
39678b1c AC	395	Tree_Write_Bool (Ignore_Rep_Clauses);
39678b1c AC	396	Tree_Write_Bool (Ignore_Style_Checks_Pragmas);
38cbfe40 RK	397	Tree_Write_Int (Maximum_File_Name_Length);
38cbfe40 RK	398	Tree_Write_Data (Suppress_Options'Address,
fbe627af	399	(Suppress_Options'Size + SU - 1) / SU);
38cbfe40 RK	400	Tree_Write_Bool (Verbose_Mode);
38cbfe40 RK	401	Tree_Write_Data (Warning_Mode'Address,
fbe627af	402	(Warning_Mode'Size + SU - 1) / Storage_Unit);
0ab80019	403	Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
f81e6250 RD	404	Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
f81e6250 RD	405	Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
38cbfe40 RK	406	Tree_Write_Bool (All_Errors_Mode);
38cbfe40 RK	407	Tree_Write_Bool (Assertions_Enabled);
347c766a	408	Tree_Write_Bool (Check_Float_Overflow);
ce4a6e84	409	Tree_Write_Int (Int (Check_Policy_List));
fab2daeb	410	Tree_Write_Int (Int (Default_Pool));
38cbfe40	411	Tree_Write_Bool (Full_List);
6c1e24d3	412	Tree_Write_Int (Int (Version_String'Length));
fbe627af	413	Tree_Write_Data (Version_String'Address, Version_String'Length);
38cbfe40	414	Tree_Write_Data (Distribution_Stub_Mode'Address,
fbe627af	415	(Distribution_Stub_Mode'Size + SU - 1) / SU);
38cbfe40 RK	416	Tree_Write_Bool (Inline_Active);
	417	Tree_Write_Bool (Inline_Processing_Required);
	418	Tree_Write_Bool (List_Units);
39678b1c	419	Tree_Write_Int (Multiple_Unit_Index);
fbf5a39b	420	Tree_Write_Bool (Configurable_Run_Time_Mode);
38cbfe40	421	Tree_Write_Data (Operating_Mode'Address,
fbe627af	422	(Operating_Mode'Size + SU - 1) / SU);
07fc65c4	423	Tree_Write_Bool (Suppress_Checks);
38cbfe40 RK	424	Tree_Write_Bool (Try_Semantics);
38cbfe40 RK	425	Tree_Write_Data (Wide_Character_Encoding_Method'Address,
fbe627af	426	(Wide_Character_Encoding_Method'Size + SU - 1) / SU);
38cbfe40 RK	427	Tree_Write_Bool (Upper_Half_Encoding);
	428	Tree_Write_Bool (Force_ALI_Tree_File);
	429	end Tree_Write;
	430
	431	end Opt;