Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/opt.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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;