1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Gnatvsn; use Gnatvsn;
33 with System; use System;
34 with Tree_IO; use Tree_IO;
38 SU : constant := Storage_Unit;
39 -- Shorthand for System.Storage_Unit
41 ----------------------------------
42 -- Register_Opt_Config_Switches --
43 ----------------------------------
45 procedure Register_Opt_Config_Switches is
47 Ada_Version_Config := Ada_Version;
48 Ada_Version_Explicit_Config := Ada_Version_Explicit;
49 Assertions_Enabled_Config := Assertions_Enabled;
50 Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values;
51 Check_Policy_List_Config := Check_Policy_List;
52 Debug_Pragmas_Enabled_Config := Debug_Pragmas_Enabled;
53 Default_Pool_Config := Default_Pool;
54 Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
55 Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
56 Extensions_Allowed_Config := Extensions_Allowed;
57 External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
58 External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
59 Fast_Math_Config := Fast_Math;
60 Initialize_Scalars_Config := Initialize_Scalars;
61 Optimize_Alignment_Config := Optimize_Alignment;
62 Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
63 Polling_Required_Config := Polling_Required;
64 Short_Descriptors_Config := Short_Descriptors;
65 Use_VADS_Size_Config := Use_VADS_Size;
67 -- Reset the indication that Optimize_Alignment was set locally, since
68 -- if we had a pragma in the config file, it would set this flag True,
69 -- but that's not a local setting.
71 Optimize_Alignment_Local := False;
72 end Register_Opt_Config_Switches;
74 ---------------------------------
75 -- Restore_Opt_Config_Switches --
76 ---------------------------------
78 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
80 Ada_Version := Save.Ada_Version;
81 Ada_Version_Explicit := Save.Ada_Version_Explicit;
82 Assertions_Enabled := Save.Assertions_Enabled;
83 Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values;
84 Check_Policy_List := Save.Check_Policy_List;
85 Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled;
86 Default_Pool := Save.Default_Pool;
87 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
88 Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
89 Extensions_Allowed := Save.Extensions_Allowed;
90 External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
91 External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
92 Fast_Math := Save.Fast_Math;
93 Initialize_Scalars := Save.Initialize_Scalars;
94 Optimize_Alignment := Save.Optimize_Alignment;
95 Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
96 Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
97 Polling_Required := Save.Polling_Required;
98 Short_Descriptors := Save.Short_Descriptors;
99 Use_VADS_Size := Save.Use_VADS_Size;
101 -- Update consistently the value of Init_Or_Norm_Scalars. The value of
102 -- Normalize_Scalars is not saved/restored because after set to True its
103 -- value is never changed. That is, if a compilation unit has pragma
104 -- Normalize_Scalars then it forces that value for all with'ed units.
106 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
107 end Restore_Opt_Config_Switches;
109 ------------------------------
110 -- Save_Opt_Config_Switches --
111 ------------------------------
113 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
115 Save.Ada_Version := Ada_Version;
116 Save.Ada_Version_Explicit := Ada_Version_Explicit;
117 Save.Assertions_Enabled := Assertions_Enabled;
118 Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values;
119 Save.Check_Policy_List := Check_Policy_List;
120 Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled;
121 Save.Default_Pool := Default_Pool;
122 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
123 Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
124 Save.Extensions_Allowed := Extensions_Allowed;
125 Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
126 Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
127 Save.Fast_Math := Fast_Math;
128 Save.Initialize_Scalars := Initialize_Scalars;
129 Save.Optimize_Alignment := Optimize_Alignment;
130 Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
131 Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
132 Save.Polling_Required := Polling_Required;
133 Save.Short_Descriptors := Short_Descriptors;
134 Save.Use_VADS_Size := Use_VADS_Size;
135 end Save_Opt_Config_Switches;
137 -----------------------------
138 -- Set_Opt_Config_Switches --
139 -----------------------------
141 procedure Set_Opt_Config_Switches
142 (Internal_Unit : Boolean;
146 -- Case of internal unit
148 if Internal_Unit then
150 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
151 -- since the whole point of this is that it still properly indicates
152 -- the configuration setting even in a run time unit.
154 Ada_Version := Ada_Version_Runtime;
155 Dynamic_Elaboration_Checks := False;
156 Extensions_Allowed := True;
157 External_Name_Exp_Casing := As_Is;
158 External_Name_Imp_Casing := Lowercase;
159 Optimize_Alignment := 'O';
160 Persistent_BSS_Mode := False;
161 Use_VADS_Size := False;
162 Optimize_Alignment_Local := True;
164 -- For an internal unit, assertions/debug pragmas are off unless this
165 -- is the main unit and they were explicitly enabled. We also make
166 -- sure we do not assume that values are necessarily valid.
169 Assertions_Enabled := Assertions_Enabled_Config;
170 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
171 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
172 Check_Policy_List := Check_Policy_List_Config;
174 Assertions_Enabled := False;
175 Assume_No_Invalid_Values := False;
176 Debug_Pragmas_Enabled := False;
177 Check_Policy_List := Empty;
180 -- Case of non-internal unit
183 Ada_Version := Ada_Version_Config;
184 Ada_Version_Explicit := Ada_Version_Explicit_Config;
185 Assertions_Enabled := Assertions_Enabled_Config;
186 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
187 Check_Policy_List := Check_Policy_List_Config;
188 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
189 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
190 Extensions_Allowed := Extensions_Allowed_Config;
191 External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
192 External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
193 Fast_Math := Fast_Math_Config;
194 Initialize_Scalars := Initialize_Scalars_Config;
195 Optimize_Alignment := Optimize_Alignment_Config;
196 Optimize_Alignment_Local := False;
197 Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
198 Use_VADS_Size := Use_VADS_Size_Config;
200 -- Update consistently the value of Init_Or_Norm_Scalars. The value
201 -- of Normalize_Scalars is not saved/restored because once set to
202 -- True its value is never changed. That is, if a compilation unit
203 -- has pragma Normalize_Scalars then it forces that value for all
206 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
209 Default_Pool := Default_Pool_Config;
210 Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
211 Fast_Math := Fast_Math_Config;
212 Optimize_Alignment := Optimize_Alignment_Config;
213 Polling_Required := Polling_Required_Config;
214 Short_Descriptors := Short_Descriptors_Config;
215 end Set_Opt_Config_Switches;
221 procedure Tree_Read is
222 Tree_Version_String_Len : Nat;
223 Ada_Version_Config_Val : Nat;
224 Ada_Version_Explicit_Config_Val : Nat;
225 Assertions_Enabled_Config_Val : Nat;
228 Tree_Read_Int (Tree_ASIS_Version_Number);
229 Tree_Read_Bool (Brief_Output);
230 Tree_Read_Bool (GNAT_Mode);
231 Tree_Read_Char (Identifier_Character_Set);
232 Tree_Read_Int (Maximum_File_Name_Length);
233 Tree_Read_Data (Suppress_Options'Address,
234 (Suppress_Options'Size + SU - 1) / SU);
235 Tree_Read_Bool (Verbose_Mode);
236 Tree_Read_Data (Warning_Mode'Address,
237 (Warning_Mode'Size + SU - 1) / SU);
238 Tree_Read_Int (Ada_Version_Config_Val);
239 Tree_Read_Int (Ada_Version_Explicit_Config_Val);
240 Tree_Read_Int (Assertions_Enabled_Config_Val);
241 Tree_Read_Bool (All_Errors_Mode);
242 Tree_Read_Bool (Assertions_Enabled);
243 Tree_Read_Int (Int (Check_Policy_List));
244 Tree_Read_Bool (Debug_Pragmas_Enabled);
245 Tree_Read_Int (Int (Default_Pool));
246 Tree_Read_Bool (Enable_Overflow_Checks);
247 Tree_Read_Bool (Full_List);
249 Ada_Version_Config :=
250 Ada_Version_Type'Val (Ada_Version_Config_Val);
251 Ada_Version_Explicit_Config :=
252 Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
253 Assertions_Enabled_Config :=
254 Boolean'Val (Assertions_Enabled_Config_Val);
256 -- Read version string: we have to get the length first
258 Tree_Read_Int (Tree_Version_String_Len);
261 Tmp : String (1 .. Integer (Tree_Version_String_Len));
264 (Tmp'Address, Tree_Version_String_Len);
265 System.Strings.Free (Tree_Version_String);
266 Free (Tree_Version_String);
267 Tree_Version_String := new String'(Tmp);
270 Tree_Read_Data (Distribution_Stub_Mode'Address,
271 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
272 Tree_Read_Bool (Inline_Active);
273 Tree_Read_Bool (Inline_Processing_Required);
274 Tree_Read_Bool (List_Units);
275 Tree_Read_Bool (Configurable_Run_Time_Mode);
276 Tree_Read_Data (Operating_Mode'Address,
277 (Operating_Mode'Size + SU - 1) / Storage_Unit);
278 Tree_Read_Bool (Suppress_Checks);
279 Tree_Read_Bool (Try_Semantics);
280 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
281 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
282 Tree_Read_Bool (Upper_Half_Encoding);
283 Tree_Read_Bool (Force_ALI_Tree_File);
290 procedure Tree_Write is
291 Version_String : String := Gnat_Version_String;
294 Tree_Write_Int (ASIS_Version_Number);
295 Tree_Write_Bool (Brief_Output);
296 Tree_Write_Bool (GNAT_Mode);
297 Tree_Write_Char (Identifier_Character_Set);
298 Tree_Write_Int (Maximum_File_Name_Length);
299 Tree_Write_Data (Suppress_Options'Address,
300 (Suppress_Options'Size + SU - 1) / SU);
301 Tree_Write_Bool (Verbose_Mode);
302 Tree_Write_Data (Warning_Mode'Address,
303 (Warning_Mode'Size + SU - 1) / Storage_Unit);
304 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
305 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
306 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
307 Tree_Write_Bool (All_Errors_Mode);
308 Tree_Write_Bool (Assertions_Enabled);
309 Tree_Write_Int (Int (Check_Policy_List));
310 Tree_Write_Bool (Debug_Pragmas_Enabled);
311 Tree_Write_Int (Int (Default_Pool));
312 Tree_Write_Bool (Enable_Overflow_Checks);
313 Tree_Write_Bool (Full_List);
314 Tree_Write_Int (Int (Version_String'Length));
315 Tree_Write_Data (Version_String'Address, Version_String'Length);
316 Tree_Write_Data (Distribution_Stub_Mode'Address,
317 (Distribution_Stub_Mode'Size + SU - 1) / SU);
318 Tree_Write_Bool (Inline_Active);
319 Tree_Write_Bool (Inline_Processing_Required);
320 Tree_Write_Bool (List_Units);
321 Tree_Write_Bool (Configurable_Run_Time_Mode);
322 Tree_Write_Data (Operating_Mode'Address,
323 (Operating_Mode'Size + SU - 1) / SU);
324 Tree_Write_Bool (Suppress_Checks);
325 Tree_Write_Bool (Try_Semantics);
326 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
327 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
328 Tree_Write_Bool (Upper_Half_Encoding);
329 Tree_Write_Bool (Force_ALI_Tree_File);