1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, 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_Pragma_Config
:= Ada_Version_Pragma
;
49 Ada_Version_Explicit_Config
:= Ada_Version_Explicit
;
50 Assertions_Enabled_Config
:= Assertions_Enabled
;
51 Assume_No_Invalid_Values_Config
:= Assume_No_Invalid_Values
;
52 Check_Float_Overflow_Config
:= Check_Float_Overflow
;
53 Check_Policy_List_Config
:= Check_Policy_List
;
54 Default_Pool_Config
:= Default_Pool
;
55 Dynamic_Elaboration_Checks_Config
:= Dynamic_Elaboration_Checks
;
56 Exception_Locations_Suppressed_Config
:= Exception_Locations_Suppressed
;
57 Extensions_Allowed_Config
:= Extensions_Allowed
;
58 External_Name_Exp_Casing_Config
:= External_Name_Exp_Casing
;
59 External_Name_Imp_Casing_Config
:= External_Name_Imp_Casing
;
60 Fast_Math_Config
:= Fast_Math
;
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 SPARK_Mode_Config
:= SPARK_Mode
;
67 SPARK_Mode_Pragma_Config
:= SPARK_Mode_Pragma
;
68 Use_VADS_Size_Config
:= Use_VADS_Size
;
69 Warnings_As_Errors_Count_Config
:= Warnings_As_Errors_Count
;
71 -- Reset the indication that Optimize_Alignment was set locally, since
72 -- if we had a pragma in the config file, it would set this flag True,
73 -- but that's not a local setting.
75 Optimize_Alignment_Local
:= False;
76 end Register_Opt_Config_Switches
;
78 ---------------------------------
79 -- Restore_Opt_Config_Switches --
80 ---------------------------------
82 procedure Restore_Opt_Config_Switches
(Save
: Config_Switches_Type
) is
84 Ada_Version
:= Save
.Ada_Version
;
85 Ada_Version_Pragma
:= Save
.Ada_Version_Pragma
;
86 Ada_Version_Explicit
:= Save
.Ada_Version_Explicit
;
87 Assertions_Enabled
:= Save
.Assertions_Enabled
;
88 Assume_No_Invalid_Values
:= Save
.Assume_No_Invalid_Values
;
89 Check_Float_Overflow
:= Save
.Check_Float_Overflow
;
90 Check_Policy_List
:= Save
.Check_Policy_List
;
91 Default_Pool
:= Save
.Default_Pool
;
92 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
93 Exception_Locations_Suppressed
:= Save
.Exception_Locations_Suppressed
;
94 Extensions_Allowed
:= Save
.Extensions_Allowed
;
95 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
96 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
97 Fast_Math
:= Save
.Fast_Math
;
98 Initialize_Scalars
:= Save
.Initialize_Scalars
;
99 Optimize_Alignment
:= Save
.Optimize_Alignment
;
100 Optimize_Alignment_Local
:= Save
.Optimize_Alignment_Local
;
101 Persistent_BSS_Mode
:= Save
.Persistent_BSS_Mode
;
102 Polling_Required
:= Save
.Polling_Required
;
103 Short_Descriptors
:= Save
.Short_Descriptors
;
104 SPARK_Mode
:= Save
.SPARK_Mode
;
105 SPARK_Mode_Pragma
:= Save
.SPARK_Mode_Pragma
;
106 Use_VADS_Size
:= Save
.Use_VADS_Size
;
107 Warnings_As_Errors_Count
:= Save
.Warnings_As_Errors_Count
;
109 -- Update consistently the value of Init_Or_Norm_Scalars. The value of
110 -- Normalize_Scalars is not saved/restored because after set to True its
111 -- value is never changed. That is, if a compilation unit has pragma
112 -- Normalize_Scalars then it forces that value for all with'ed units.
114 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
115 end Restore_Opt_Config_Switches
;
117 ------------------------------
118 -- Save_Opt_Config_Switches --
119 ------------------------------
121 procedure Save_Opt_Config_Switches
(Save
: out Config_Switches_Type
) is
123 Save
.Ada_Version
:= Ada_Version
;
124 Save
.Ada_Version_Pragma
:= Ada_Version_Pragma
;
125 Save
.Ada_Version_Explicit
:= Ada_Version_Explicit
;
126 Save
.Assertions_Enabled
:= Assertions_Enabled
;
127 Save
.Assume_No_Invalid_Values
:= Assume_No_Invalid_Values
;
128 Save
.Check_Float_Overflow
:= Check_Float_Overflow
;
129 Save
.Check_Policy_List
:= Check_Policy_List
;
130 Save
.Default_Pool
:= Default_Pool
;
131 Save
.Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks
;
132 Save
.Exception_Locations_Suppressed
:= Exception_Locations_Suppressed
;
133 Save
.Extensions_Allowed
:= Extensions_Allowed
;
134 Save
.External_Name_Exp_Casing
:= External_Name_Exp_Casing
;
135 Save
.External_Name_Imp_Casing
:= External_Name_Imp_Casing
;
136 Save
.Fast_Math
:= Fast_Math
;
137 Save
.Initialize_Scalars
:= Initialize_Scalars
;
138 Save
.Optimize_Alignment
:= Optimize_Alignment
;
139 Save
.Optimize_Alignment_Local
:= Optimize_Alignment_Local
;
140 Save
.Persistent_BSS_Mode
:= Persistent_BSS_Mode
;
141 Save
.Polling_Required
:= Polling_Required
;
142 Save
.Short_Descriptors
:= Short_Descriptors
;
143 Save
.SPARK_Mode
:= SPARK_Mode
;
144 Save
.SPARK_Mode_Pragma
:= SPARK_Mode_Pragma
;
145 Save
.Use_VADS_Size
:= Use_VADS_Size
;
146 Save
.Warnings_As_Errors_Count
:= Warnings_As_Errors_Count
;
147 end Save_Opt_Config_Switches
;
149 -----------------------------
150 -- Set_Opt_Config_Switches --
151 -----------------------------
153 procedure Set_Opt_Config_Switches
154 (Internal_Unit
: Boolean;
158 -- Case of internal unit
160 if Internal_Unit
then
162 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
163 -- since the whole point of this is that it still properly indicates
164 -- the configuration setting even in a run time unit.
166 Ada_Version
:= Ada_Version_Runtime
;
167 Ada_Version_Pragma
:= Empty
;
168 Dynamic_Elaboration_Checks
:= False;
169 Extensions_Allowed
:= True;
170 External_Name_Exp_Casing
:= As_Is
;
171 External_Name_Imp_Casing
:= Lowercase
;
172 Optimize_Alignment
:= 'O';
173 Persistent_BSS_Mode
:= False;
174 Use_VADS_Size
:= False;
175 Optimize_Alignment_Local
:= True;
177 -- Note: we do not need to worry about Warnings_As_Errors_Count since
178 -- we do not expect to get any warnings from compiling such a unit.
180 -- For an internal unit, assertions/debug pragmas are off unless this
181 -- is the main unit and they were explicitly enabled. We also make
182 -- sure we do not assume that values are necessarily valid and that
183 -- SPARK_Mode is set to its configuration value.
186 Assertions_Enabled
:= Assertions_Enabled_Config
;
187 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
188 Check_Policy_List
:= Check_Policy_List_Config
;
189 SPARK_Mode
:= SPARK_Mode_Config
;
190 SPARK_Mode_Pragma
:= SPARK_Mode_Pragma_Config
;
192 Assertions_Enabled
:= False;
193 Assume_No_Invalid_Values
:= False;
194 Check_Policy_List
:= Empty
;
196 SPARK_Mode_Pragma
:= Empty
;
199 -- Case of non-internal unit
202 Ada_Version
:= Ada_Version_Config
;
203 Ada_Version_Pragma
:= Ada_Version_Pragma_Config
;
204 Ada_Version_Explicit
:= Ada_Version_Explicit_Config
;
205 Assertions_Enabled
:= Assertions_Enabled_Config
;
206 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
207 Check_Float_Overflow
:= Check_Float_Overflow_Config
;
208 Check_Policy_List
:= Check_Policy_List_Config
;
209 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
210 Extensions_Allowed
:= Extensions_Allowed_Config
;
211 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
212 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
213 Fast_Math
:= Fast_Math_Config
;
214 Initialize_Scalars
:= Initialize_Scalars_Config
;
215 Optimize_Alignment
:= Optimize_Alignment_Config
;
216 Optimize_Alignment_Local
:= False;
217 Persistent_BSS_Mode
:= Persistent_BSS_Mode_Config
;
218 SPARK_Mode
:= SPARK_Mode_Config
;
219 SPARK_Mode_Pragma
:= SPARK_Mode_Pragma_Config
;
220 Use_VADS_Size
:= Use_VADS_Size_Config
;
221 Warnings_As_Errors_Count
:= Warnings_As_Errors_Count_Config
;
223 -- Update consistently the value of Init_Or_Norm_Scalars. The value
224 -- of Normalize_Scalars is not saved/restored because once set to
225 -- True its value is never changed. That is, if a compilation unit
226 -- has pragma Normalize_Scalars then it forces that value for all
229 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
232 Default_Pool
:= Default_Pool_Config
;
233 Exception_Locations_Suppressed
:= Exception_Locations_Suppressed_Config
;
234 Fast_Math
:= Fast_Math_Config
;
235 Optimize_Alignment
:= Optimize_Alignment_Config
;
236 Polling_Required
:= Polling_Required_Config
;
237 Short_Descriptors
:= Short_Descriptors_Config
;
238 end Set_Opt_Config_Switches
;
244 procedure Tree_Read
is
245 Tree_Version_String_Len
: Nat
;
246 Ada_Version_Config_Val
: Nat
;
247 Ada_Version_Explicit_Config_Val
: Nat
;
248 Assertions_Enabled_Config_Val
: Nat
;
251 Tree_Read_Int
(Tree_ASIS_Version_Number
);
252 Tree_Read_Bool
(Brief_Output
);
253 Tree_Read_Bool
(GNAT_Mode
);
254 Tree_Read_Char
(Identifier_Character_Set
);
255 Tree_Read_Int
(Maximum_File_Name_Length
);
256 Tree_Read_Data
(Suppress_Options
'Address,
257 (Suppress_Options
'Size + SU
- 1) / SU
);
258 Tree_Read_Bool
(Verbose_Mode
);
259 Tree_Read_Data
(Warning_Mode
'Address,
260 (Warning_Mode
'Size + SU
- 1) / SU
);
261 Tree_Read_Int
(Ada_Version_Config_Val
);
262 Tree_Read_Int
(Ada_Version_Explicit_Config_Val
);
263 Tree_Read_Int
(Assertions_Enabled_Config_Val
);
264 Tree_Read_Bool
(All_Errors_Mode
);
265 Tree_Read_Bool
(Assertions_Enabled
);
266 Tree_Read_Bool
(Check_Float_Overflow
);
267 Tree_Read_Int
(Int
(Check_Policy_List
));
268 Tree_Read_Int
(Int
(Default_Pool
));
269 Tree_Read_Bool
(Full_List
);
271 Ada_Version_Config
:=
272 Ada_Version_Type
'Val (Ada_Version_Config_Val
);
273 Ada_Version_Explicit_Config
:=
274 Ada_Version_Type
'Val (Ada_Version_Explicit_Config_Val
);
275 Assertions_Enabled_Config
:=
276 Boolean'Val (Assertions_Enabled_Config_Val
);
278 -- Read version string: we have to get the length first
280 Tree_Read_Int
(Tree_Version_String_Len
);
283 Tmp
: String (1 .. Integer (Tree_Version_String_Len
));
286 (Tmp
'Address, Tree_Version_String_Len
);
287 System
.Strings
.Free
(Tree_Version_String
);
288 Free
(Tree_Version_String
);
289 Tree_Version_String
:= new String'(Tmp);
292 Tree_Read_Data (Distribution_Stub_Mode'Address,
293 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
294 Tree_Read_Bool (Inline_Active);
295 Tree_Read_Bool (Inline_Processing_Required);
296 Tree_Read_Bool (List_Units);
297 Tree_Read_Bool (Configurable_Run_Time_Mode);
298 Tree_Read_Data (Operating_Mode'Address,
299 (Operating_Mode'Size + SU - 1) / Storage_Unit);
300 Tree_Read_Bool (Suppress_Checks);
301 Tree_Read_Bool (Try_Semantics);
302 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
303 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
304 Tree_Read_Bool (Upper_Half_Encoding);
305 Tree_Read_Bool (Force_ALI_Tree_File);
312 procedure Tree_Write is
313 Version_String : String := Gnat_Version_String;
316 Tree_Write_Int (ASIS_Version_Number);
317 Tree_Write_Bool (Brief_Output);
318 Tree_Write_Bool (GNAT_Mode);
319 Tree_Write_Char (Identifier_Character_Set);
320 Tree_Write_Int (Maximum_File_Name_Length);
321 Tree_Write_Data (Suppress_Options'Address,
322 (Suppress_Options'Size + SU - 1) / SU);
323 Tree_Write_Bool (Verbose_Mode);
324 Tree_Write_Data (Warning_Mode'Address,
325 (Warning_Mode'Size + SU - 1) / Storage_Unit);
326 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
327 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
328 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
329 Tree_Write_Bool (All_Errors_Mode);
330 Tree_Write_Bool (Assertions_Enabled);
331 Tree_Write_Bool (Check_Float_Overflow);
332 Tree_Write_Int (Int (Check_Policy_List));
333 Tree_Write_Int (Int (Default_Pool));
334 Tree_Write_Bool (Full_List);
335 Tree_Write_Int (Int (Version_String'Length));
336 Tree_Write_Data (Version_String'Address, Version_String'Length);
337 Tree_Write_Data (Distribution_Stub_Mode'Address,
338 (Distribution_Stub_Mode'Size + SU - 1) / SU);
339 Tree_Write_Bool (Inline_Active);
340 Tree_Write_Bool (Inline_Processing_Required);
341 Tree_Write_Bool (List_Units);
342 Tree_Write_Bool (Configurable_Run_Time_Mode);
343 Tree_Write_Data (Operating_Mode'Address,
344 (Operating_Mode'Size + SU - 1) / SU);
345 Tree_Write_Bool (Suppress_Checks);
346 Tree_Write_Bool (Try_Semantics);
347 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
348 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
349 Tree_Write_Bool (Upper_Half_Encoding);
350 Tree_Write_Bool (Force_ALI_Tree_File);