1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 Init_Or_Norm_Scalars_Config := Init_Or_Norm_Scalars;
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 Use_VADS_Size_Config := Use_VADS_Size;
68 -- Reset the indication that Optimize_Alignment was set locally, since
69 -- if we had a pragma in the config file, it would set this flag True,
70 -- but that's not a local setting.
72 Optimize_Alignment_Local := False;
73 end Register_Opt_Config_Switches;
75 ---------------------------------
76 -- Restore_Opt_Config_Switches --
77 ---------------------------------
79 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
81 Ada_Version := Save.Ada_Version;
82 Ada_Version_Explicit := Save.Ada_Version_Explicit;
83 Assertions_Enabled := Save.Assertions_Enabled;
84 Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values;
85 Check_Policy_List := Save.Check_Policy_List;
86 Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled;
87 Default_Pool := Save.Default_Pool;
88 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
89 Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
90 Extensions_Allowed := Save.Extensions_Allowed;
91 External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
92 External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
93 Fast_Math := Save.Fast_Math;
94 Init_Or_Norm_Scalars := Save.Init_Or_Norm_Scalars;
95 Initialize_Scalars := Save.Initialize_Scalars;
96 Optimize_Alignment := Save.Optimize_Alignment;
97 Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
98 Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
99 Polling_Required := Save.Polling_Required;
100 Short_Descriptors := Save.Short_Descriptors;
101 Use_VADS_Size := Save.Use_VADS_Size;
102 end Restore_Opt_Config_Switches;
104 ------------------------------
105 -- Save_Opt_Config_Switches --
106 ------------------------------
108 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
110 Save.Ada_Version := Ada_Version;
111 Save.Ada_Version_Explicit := Ada_Version_Explicit;
112 Save.Assertions_Enabled := Assertions_Enabled;
113 Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values;
114 Save.Check_Policy_List := Check_Policy_List;
115 Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled;
116 Save.Default_Pool := Default_Pool;
117 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
118 Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
119 Save.Extensions_Allowed := Extensions_Allowed;
120 Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
121 Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
122 Save.Fast_Math := Fast_Math;
123 Save.Init_Or_Norm_Scalars := Init_Or_Norm_Scalars;
124 Save.Initialize_Scalars := Initialize_Scalars;
125 Save.Optimize_Alignment := Optimize_Alignment;
126 Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
127 Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
128 Save.Polling_Required := Polling_Required;
129 Save.Short_Descriptors := Short_Descriptors;
130 Save.Use_VADS_Size := Use_VADS_Size;
131 end Save_Opt_Config_Switches;
133 -----------------------------
134 -- Set_Opt_Config_Switches --
135 -----------------------------
137 procedure Set_Opt_Config_Switches
138 (Internal_Unit : Boolean;
142 -- Case of internal unit
144 if Internal_Unit then
146 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
147 -- since the whole point of this is that it still properly indicates
148 -- the configuration setting even in a run time unit.
150 Ada_Version := Ada_Version_Runtime;
151 Dynamic_Elaboration_Checks := False;
152 Extensions_Allowed := True;
153 External_Name_Exp_Casing := As_Is;
154 External_Name_Imp_Casing := Lowercase;
155 Optimize_Alignment := 'O';
156 Persistent_BSS_Mode := False;
157 Use_VADS_Size := False;
158 Optimize_Alignment_Local := True;
160 -- For an internal unit, assertions/debug pragmas are off unless this
161 -- is the main unit and they were explicitly enabled. We also make
162 -- sure we do not assume that values are necessarily valid.
165 Assertions_Enabled := Assertions_Enabled_Config;
166 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
167 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
168 Check_Policy_List := Check_Policy_List_Config;
170 Assertions_Enabled := False;
171 Assume_No_Invalid_Values := False;
172 Debug_Pragmas_Enabled := False;
173 Check_Policy_List := Empty;
176 -- Case of non-internal unit
179 Ada_Version := Ada_Version_Config;
180 Ada_Version_Explicit := Ada_Version_Explicit_Config;
181 Assertions_Enabled := Assertions_Enabled_Config;
182 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
183 Check_Policy_List := Check_Policy_List_Config;
184 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
185 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
186 Extensions_Allowed := Extensions_Allowed_Config;
187 External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
188 External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
189 Fast_Math := Fast_Math_Config;
190 Init_Or_Norm_Scalars := Init_Or_Norm_Scalars_Config;
191 Initialize_Scalars := Initialize_Scalars_Config;
192 Optimize_Alignment := Optimize_Alignment_Config;
193 Optimize_Alignment_Local := False;
194 Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
195 Use_VADS_Size := Use_VADS_Size_Config;
198 Default_Pool := Default_Pool_Config;
199 Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
200 Fast_Math := Fast_Math_Config;
201 Optimize_Alignment := Optimize_Alignment_Config;
202 Polling_Required := Polling_Required_Config;
203 Short_Descriptors := Short_Descriptors_Config;
204 end Set_Opt_Config_Switches;
210 procedure Tree_Read is
211 Tree_Version_String_Len : Nat;
212 Ada_Version_Config_Val : Nat;
213 Ada_Version_Explicit_Config_Val : Nat;
214 Assertions_Enabled_Config_Val : Nat;
217 Tree_Read_Int (Tree_ASIS_Version_Number);
218 Tree_Read_Bool (Brief_Output);
219 Tree_Read_Bool (GNAT_Mode);
220 Tree_Read_Char (Identifier_Character_Set);
221 Tree_Read_Int (Maximum_File_Name_Length);
222 Tree_Read_Data (Suppress_Options'Address,
223 (Suppress_Options'Size + SU - 1) / SU);
224 Tree_Read_Bool (Verbose_Mode);
225 Tree_Read_Data (Warning_Mode'Address,
226 (Warning_Mode'Size + SU - 1) / SU);
227 Tree_Read_Int (Ada_Version_Config_Val);
228 Tree_Read_Int (Ada_Version_Explicit_Config_Val);
229 Tree_Read_Int (Assertions_Enabled_Config_Val);
230 Tree_Read_Bool (All_Errors_Mode);
231 Tree_Read_Bool (Assertions_Enabled);
232 Tree_Read_Int (Int (Check_Policy_List));
233 Tree_Read_Bool (Debug_Pragmas_Enabled);
234 Tree_Read_Int (Int (Default_Pool));
235 Tree_Read_Bool (Enable_Overflow_Checks);
236 Tree_Read_Bool (Full_List);
238 Ada_Version_Config :=
239 Ada_Version_Type'Val (Ada_Version_Config_Val);
240 Ada_Version_Explicit_Config :=
241 Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
242 Assertions_Enabled_Config :=
243 Boolean'Val (Assertions_Enabled_Config_Val);
245 -- Read version string: we have to get the length first
247 Tree_Read_Int (Tree_Version_String_Len);
250 Tmp : String (1 .. Integer (Tree_Version_String_Len));
253 (Tmp'Address, Tree_Version_String_Len);
254 System.Strings.Free (Tree_Version_String);
255 Free (Tree_Version_String);
256 Tree_Version_String := new String'(Tmp);
259 Tree_Read_Data (Distribution_Stub_Mode'Address,
260 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
261 Tree_Read_Bool (Inline_Active);
262 Tree_Read_Bool (Inline_Processing_Required);
263 Tree_Read_Bool (List_Units);
264 Tree_Read_Bool (Configurable_Run_Time_Mode);
265 Tree_Read_Data (Operating_Mode'Address,
266 (Operating_Mode'Size + SU - 1) / Storage_Unit);
267 Tree_Read_Bool (Suppress_Checks);
268 Tree_Read_Bool (Try_Semantics);
269 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
270 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
271 Tree_Read_Bool (Upper_Half_Encoding);
272 Tree_Read_Bool (Force_ALI_Tree_File);
279 procedure Tree_Write is
280 Version_String : String := Gnat_Version_String;
283 Tree_Write_Int (ASIS_Version_Number);
284 Tree_Write_Bool (Brief_Output);
285 Tree_Write_Bool (GNAT_Mode);
286 Tree_Write_Char (Identifier_Character_Set);
287 Tree_Write_Int (Maximum_File_Name_Length);
288 Tree_Write_Data (Suppress_Options'Address,
289 (Suppress_Options'Size + SU - 1) / SU);
290 Tree_Write_Bool (Verbose_Mode);
291 Tree_Write_Data (Warning_Mode'Address,
292 (Warning_Mode'Size + SU - 1) / Storage_Unit);
293 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
294 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
295 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
296 Tree_Write_Bool (All_Errors_Mode);
297 Tree_Write_Bool (Assertions_Enabled);
298 Tree_Write_Int (Int (Check_Policy_List));
299 Tree_Write_Bool (Debug_Pragmas_Enabled);
300 Tree_Write_Int (Int (Default_Pool));
301 Tree_Write_Bool (Enable_Overflow_Checks);
302 Tree_Write_Bool (Full_List);
303 Tree_Write_Int (Int (Version_String'Length));
304 Tree_Write_Data (Version_String'Address, Version_String'Length);
305 Tree_Write_Data (Distribution_Stub_Mode'Address,
306 (Distribution_Stub_Mode'Size + SU - 1) / SU);
307 Tree_Write_Bool (Inline_Active);
308 Tree_Write_Bool (Inline_Processing_Required);
309 Tree_Write_Bool (List_Units);
310 Tree_Write_Bool (Configurable_Run_Time_Mode);
311 Tree_Write_Data (Operating_Mode'Address,
312 (Operating_Mode'Size + SU - 1) / SU);
313 Tree_Write_Bool (Suppress_Checks);
314 Tree_Write_Bool (Try_Semantics);
315 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
316 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
317 Tree_Write_Bool (Upper_Half_Encoding);
318 Tree_Write_Bool (Force_ALI_Tree_File);