1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                                  O P T                                   --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2013, 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
32with Gnatvsn; use Gnatvsn;
33with System;  use System;
34with Tree_IO; use Tree_IO;
35
36package body Opt is
37
38   SU : constant := Storage_Unit;
39   --  Shorthand for System.Storage_Unit
40
41   ----------------------------------
42   -- Register_Opt_Config_Switches --
43   ----------------------------------
44
45   procedure Register_Opt_Config_Switches is
46   begin
47      Ada_Version_Config                    := Ada_Version;
48      Ada_Version_Pragma_Config             := Ada_Version_Pragma;
49      Ada_Version_Explicit_Config           := Ada_Version_Explicit;
50      Assertions_Enabled_Config             := Assertions_Enabled;
51      Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
52      Check_Float_Overflow_Config           := Check_Float_Overflow;
53      Check_Policy_List_Config              := Check_Policy_List;
54      Default_Pool_Config                   := Default_Pool;
55      Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
56      Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
57      Extensions_Allowed_Config             := Extensions_Allowed;
58      External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
59      External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
60      Fast_Math_Config                      := Fast_Math;
61      Initialize_Scalars_Config             := Initialize_Scalars;
62      Optimize_Alignment_Config             := Optimize_Alignment;
63      Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
64      Polling_Required_Config               := Polling_Required;
65      Short_Descriptors_Config              := Short_Descriptors;
66      SPARK_Mode_Config                     := SPARK_Mode;
67      SPARK_Mode_Pragma_Config              := SPARK_Mode_Pragma;
68      Use_VADS_Size_Config                  := Use_VADS_Size;
69      Warnings_As_Errors_Count_Config       := Warnings_As_Errors_Count;
70
71      --  Reset the indication that Optimize_Alignment was set locally, since
72      --  if we had a pragma in the config file, it would set this flag True,
73      --  but that's not a local setting.
74
75      Optimize_Alignment_Local := False;
76   end Register_Opt_Config_Switches;
77
78   ---------------------------------
79   -- Restore_Opt_Config_Switches --
80   ---------------------------------
81
82   procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
83   begin
84      Ada_Version                    := Save.Ada_Version;
85      Ada_Version_Pragma             := Save.Ada_Version_Pragma;
86      Ada_Version_Explicit           := Save.Ada_Version_Explicit;
87      Assertions_Enabled             := Save.Assertions_Enabled;
88      Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
89      Check_Float_Overflow           := Save.Check_Float_Overflow;
90      Check_Policy_List              := Save.Check_Policy_List;
91      Default_Pool                   := Save.Default_Pool;
92      Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
93      Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
94      Extensions_Allowed             := Save.Extensions_Allowed;
95      External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
96      External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
97      Fast_Math                      := Save.Fast_Math;
98      Initialize_Scalars             := Save.Initialize_Scalars;
99      Optimize_Alignment             := Save.Optimize_Alignment;
100      Optimize_Alignment_Local       := Save.Optimize_Alignment_Local;
101      Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
102      Polling_Required               := Save.Polling_Required;
103      Short_Descriptors              := Save.Short_Descriptors;
104      SPARK_Mode                     := Save.SPARK_Mode;
105      SPARK_Mode_Pragma              := Save.SPARK_Mode_Pragma;
106      Use_VADS_Size                  := Save.Use_VADS_Size;
107      Warnings_As_Errors_Count       := Save.Warnings_As_Errors_Count;
108
109      --  Update consistently the value of Init_Or_Norm_Scalars. The value of
110      --  Normalize_Scalars is not saved/restored because after set to True its
111      --  value is never changed. That is, if a compilation unit has pragma
112      --  Normalize_Scalars then it forces that value for all with'ed units.
113
114      Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
115   end Restore_Opt_Config_Switches;
116
117   ------------------------------
118   -- Save_Opt_Config_Switches --
119   ------------------------------
120
121   procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
122   begin
123      Save.Ada_Version                    := Ada_Version;
124      Save.Ada_Version_Pragma             := Ada_Version_Pragma;
125      Save.Ada_Version_Explicit           := Ada_Version_Explicit;
126      Save.Assertions_Enabled             := Assertions_Enabled;
127      Save.Assume_No_Invalid_Values       := Assume_No_Invalid_Values;
128      Save.Check_Float_Overflow           := Check_Float_Overflow;
129      Save.Check_Policy_List              := Check_Policy_List;
130      Save.Default_Pool                   := Default_Pool;
131      Save.Dynamic_Elaboration_Checks     := Dynamic_Elaboration_Checks;
132      Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
133      Save.Extensions_Allowed             := Extensions_Allowed;
134      Save.External_Name_Exp_Casing       := External_Name_Exp_Casing;
135      Save.External_Name_Imp_Casing       := External_Name_Imp_Casing;
136      Save.Fast_Math                      := Fast_Math;
137      Save.Initialize_Scalars             := Initialize_Scalars;
138      Save.Optimize_Alignment             := Optimize_Alignment;
139      Save.Optimize_Alignment_Local       := Optimize_Alignment_Local;
140      Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
141      Save.Polling_Required               := Polling_Required;
142      Save.Short_Descriptors              := Short_Descriptors;
143      Save.SPARK_Mode                     := SPARK_Mode;
144      Save.SPARK_Mode_Pragma              := SPARK_Mode_Pragma;
145      Save.Use_VADS_Size                  := Use_VADS_Size;
146      Save.Warnings_As_Errors_Count       := Warnings_As_Errors_Count;
147   end Save_Opt_Config_Switches;
148
149   -----------------------------
150   -- Set_Opt_Config_Switches --
151   -----------------------------
152
153   procedure Set_Opt_Config_Switches
154     (Internal_Unit : Boolean;
155      Main_Unit     : Boolean)
156   is
157   begin
158      --  Case of internal unit
159
160      if Internal_Unit then
161
162         --  Set standard switches. Note we do NOT set Ada_Version_Explicit
163         --  since the whole point of this is that it still properly indicates
164         --  the configuration setting even in a run time unit.
165
166         Ada_Version                 := Ada_Version_Runtime;
167         Ada_Version_Pragma          := Empty;
168         Dynamic_Elaboration_Checks  := False;
169         Extensions_Allowed          := True;
170         External_Name_Exp_Casing    := As_Is;
171         External_Name_Imp_Casing    := Lowercase;
172         Optimize_Alignment          := 'O';
173         Persistent_BSS_Mode         := False;
174         Use_VADS_Size               := False;
175         Optimize_Alignment_Local    := True;
176
177         --  Note: we do not need to worry about Warnings_As_Errors_Count since
178         --  we do not expect to get any warnings from compiling such a unit.
179
180         --  For an internal unit, assertions/debug pragmas are off unless this
181         --  is the main unit and they were explicitly enabled. We also make
182         --  sure we do not assume that values are necessarily valid and that
183         --  SPARK_Mode is set to its configuration value.
184
185         if Main_Unit then
186            Assertions_Enabled       := Assertions_Enabled_Config;
187            Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
188            Check_Policy_List        := Check_Policy_List_Config;
189            SPARK_Mode               := SPARK_Mode_Config;
190            SPARK_Mode_Pragma        := SPARK_Mode_Pragma_Config;
191         else
192            Assertions_Enabled       := False;
193            Assume_No_Invalid_Values := False;
194            Check_Policy_List        := Empty;
195            SPARK_Mode               := None;
196            SPARK_Mode_Pragma        := Empty;
197         end if;
198
199      --  Case of non-internal unit
200
201      else
202         Ada_Version                 := Ada_Version_Config;
203         Ada_Version_Pragma          := Ada_Version_Pragma_Config;
204         Ada_Version_Explicit        := Ada_Version_Explicit_Config;
205         Assertions_Enabled          := Assertions_Enabled_Config;
206         Assume_No_Invalid_Values    := Assume_No_Invalid_Values_Config;
207         Check_Float_Overflow        := Check_Float_Overflow_Config;
208         Check_Policy_List           := Check_Policy_List_Config;
209         Dynamic_Elaboration_Checks  := Dynamic_Elaboration_Checks_Config;
210         Extensions_Allowed          := Extensions_Allowed_Config;
211         External_Name_Exp_Casing    := External_Name_Exp_Casing_Config;
212         External_Name_Imp_Casing    := External_Name_Imp_Casing_Config;
213         Fast_Math                   := Fast_Math_Config;
214         Initialize_Scalars          := Initialize_Scalars_Config;
215         Optimize_Alignment          := Optimize_Alignment_Config;
216         Optimize_Alignment_Local    := False;
217         Persistent_BSS_Mode         := Persistent_BSS_Mode_Config;
218         SPARK_Mode                  := SPARK_Mode_Config;
219         SPARK_Mode_Pragma           := SPARK_Mode_Pragma_Config;
220         Use_VADS_Size               := Use_VADS_Size_Config;
221         Warnings_As_Errors_Count    := Warnings_As_Errors_Count_Config;
222
223         --  Update consistently the value of Init_Or_Norm_Scalars. The value
224         --  of Normalize_Scalars is not saved/restored because once set to
225         --  True its value is never changed. That is, if a compilation unit
226         --  has pragma Normalize_Scalars then it forces that value for all
227         --  with'ed units.
228
229         Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
230      end if;
231
232      Default_Pool                   := Default_Pool_Config;
233      Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
234      Fast_Math                      := Fast_Math_Config;
235      Optimize_Alignment             := Optimize_Alignment_Config;
236      Polling_Required               := Polling_Required_Config;
237      Short_Descriptors              := Short_Descriptors_Config;
238   end Set_Opt_Config_Switches;
239
240   ---------------
241   -- Tree_Read --
242   ---------------
243
244   procedure Tree_Read is
245      Tree_Version_String_Len         : Nat;
246      Ada_Version_Config_Val          : Nat;
247      Ada_Version_Explicit_Config_Val : Nat;
248      Assertions_Enabled_Config_Val   : Nat;
249
250   begin
251      Tree_Read_Int  (Tree_ASIS_Version_Number);
252      Tree_Read_Bool (Brief_Output);
253      Tree_Read_Bool (GNAT_Mode);
254      Tree_Read_Char (Identifier_Character_Set);
255      Tree_Read_Int  (Maximum_File_Name_Length);
256      Tree_Read_Data (Suppress_Options'Address,
257                      (Suppress_Options'Size + SU - 1) / SU);
258      Tree_Read_Bool (Verbose_Mode);
259      Tree_Read_Data (Warning_Mode'Address,
260                      (Warning_Mode'Size + SU - 1) / SU);
261      Tree_Read_Int  (Ada_Version_Config_Val);
262      Tree_Read_Int  (Ada_Version_Explicit_Config_Val);
263      Tree_Read_Int  (Assertions_Enabled_Config_Val);
264      Tree_Read_Bool (All_Errors_Mode);
265      Tree_Read_Bool (Assertions_Enabled);
266      Tree_Read_Bool (Check_Float_Overflow);
267      Tree_Read_Int  (Int (Check_Policy_List));
268      Tree_Read_Int  (Int (Default_Pool));
269      Tree_Read_Bool (Full_List);
270
271      Ada_Version_Config :=
272        Ada_Version_Type'Val (Ada_Version_Config_Val);
273      Ada_Version_Explicit_Config :=
274        Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
275      Assertions_Enabled_Config :=
276        Boolean'Val (Assertions_Enabled_Config_Val);
277
278      --  Read version string: we have to get the length first
279
280      Tree_Read_Int (Tree_Version_String_Len);
281
282      declare
283         Tmp : String (1 .. Integer (Tree_Version_String_Len));
284      begin
285         Tree_Read_Data
286           (Tmp'Address, Tree_Version_String_Len);
287         System.Strings.Free (Tree_Version_String);
288         Free (Tree_Version_String);
289         Tree_Version_String := new String'(Tmp);
290      end;
291
292      Tree_Read_Data (Distribution_Stub_Mode'Address,
293                      (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
294      Tree_Read_Bool (Inline_Active);
295      Tree_Read_Bool (Inline_Processing_Required);
296      Tree_Read_Bool (List_Units);
297      Tree_Read_Bool (Configurable_Run_Time_Mode);
298      Tree_Read_Data (Operating_Mode'Address,
299                      (Operating_Mode'Size + SU - 1) / Storage_Unit);
300      Tree_Read_Bool (Suppress_Checks);
301      Tree_Read_Bool (Try_Semantics);
302      Tree_Read_Data (Wide_Character_Encoding_Method'Address,
303                      (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
304      Tree_Read_Bool (Upper_Half_Encoding);
305      Tree_Read_Bool (Force_ALI_Tree_File);
306   end Tree_Read;
307
308   ----------------
309   -- Tree_Write --
310   ----------------
311
312   procedure Tree_Write is
313      Version_String : String := Gnat_Version_String;
314
315   begin
316      Tree_Write_Int  (ASIS_Version_Number);
317      Tree_Write_Bool (Brief_Output);
318      Tree_Write_Bool (GNAT_Mode);
319      Tree_Write_Char (Identifier_Character_Set);
320      Tree_Write_Int  (Maximum_File_Name_Length);
321      Tree_Write_Data (Suppress_Options'Address,
322                       (Suppress_Options'Size + SU - 1) / SU);
323      Tree_Write_Bool (Verbose_Mode);
324      Tree_Write_Data (Warning_Mode'Address,
325                       (Warning_Mode'Size + SU - 1) / Storage_Unit);
326      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Config));
327      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
328      Tree_Write_Int  (Boolean'Pos (Assertions_Enabled_Config));
329      Tree_Write_Bool (All_Errors_Mode);
330      Tree_Write_Bool (Assertions_Enabled);
331      Tree_Write_Bool (Check_Float_Overflow);
332      Tree_Write_Int  (Int (Check_Policy_List));
333      Tree_Write_Int  (Int (Default_Pool));
334      Tree_Write_Bool (Full_List);
335      Tree_Write_Int  (Int (Version_String'Length));
336      Tree_Write_Data (Version_String'Address, Version_String'Length);
337      Tree_Write_Data (Distribution_Stub_Mode'Address,
338                       (Distribution_Stub_Mode'Size + SU - 1) / SU);
339      Tree_Write_Bool (Inline_Active);
340      Tree_Write_Bool (Inline_Processing_Required);
341      Tree_Write_Bool (List_Units);
342      Tree_Write_Bool (Configurable_Run_Time_Mode);
343      Tree_Write_Data (Operating_Mode'Address,
344                       (Operating_Mode'Size + SU - 1) / SU);
345      Tree_Write_Bool (Suppress_Checks);
346      Tree_Write_Bool (Try_Semantics);
347      Tree_Write_Data (Wide_Character_Encoding_Method'Address,
348                       (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
349      Tree_Write_Bool (Upper_Half_Encoding);
350      Tree_Write_Bool (Force_ALI_Tree_File);
351   end Tree_Write;
352
353end Opt;
354