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