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