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