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