1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
28 -------------------------
29 -- Back_End_Exceptions --
30 -------------------------
32 function Back_End_Exceptions
return Boolean is
35 Exception_Mechanism
= Back_End_SJLJ
37 Exception_Mechanism
= Back_End_ZCX
;
38 end Back_End_Exceptions
;
40 -------------------------
41 -- Front_End_Exceptions --
42 -------------------------
44 function Front_End_Exceptions
return Boolean is
46 return Exception_Mechanism
= Front_End_SJLJ
;
47 end Front_End_Exceptions
;
53 function SJLJ_Exceptions
return Boolean is
56 Exception_Mechanism
= Back_End_SJLJ
58 Exception_Mechanism
= Front_End_SJLJ
;
65 function ZCX_Exceptions
return Boolean is
67 return Exception_Mechanism
= Back_End_ZCX
;
70 ------------------------------
71 -- Register_Config_Switches --
72 ------------------------------
74 procedure Register_Config_Switches
is
76 Ada_Version_Config
:= Ada_Version
;
77 Ada_Version_Pragma_Config
:= Ada_Version_Pragma
;
78 Ada_Version_Explicit_Config
:= Ada_Version_Explicit
;
79 Assertions_Enabled_Config
:= Assertions_Enabled
;
80 Assume_No_Invalid_Values_Config
:= Assume_No_Invalid_Values
;
81 Check_Float_Overflow_Config
:= Check_Float_Overflow
;
82 Check_Policy_List_Config
:= Check_Policy_List
;
83 Default_Pool_Config
:= Default_Pool
;
84 Default_SSO_Config
:= Default_SSO
;
85 Dynamic_Elaboration_Checks_Config
:= Dynamic_Elaboration_Checks
;
86 Exception_Locations_Suppressed_Config
:= Exception_Locations_Suppressed
;
87 Extensions_Allowed_Config
:= Extensions_Allowed
;
88 External_Name_Exp_Casing_Config
:= External_Name_Exp_Casing
;
89 External_Name_Imp_Casing_Config
:= External_Name_Imp_Casing
;
90 Fast_Math_Config
:= Fast_Math
;
91 Initialize_Scalars_Config
:= Initialize_Scalars
;
92 No_Component_Reordering_Config
:= No_Component_Reordering
;
93 Optimize_Alignment_Config
:= Optimize_Alignment
;
94 Persistent_BSS_Mode_Config
:= Persistent_BSS_Mode
;
95 Prefix_Exception_Messages_Config
:= Prefix_Exception_Messages
;
96 SPARK_Mode_Config
:= SPARK_Mode
;
97 SPARK_Mode_Pragma_Config
:= SPARK_Mode_Pragma
;
98 Uneval_Old_Config
:= Uneval_Old
;
99 Use_VADS_Size_Config
:= Use_VADS_Size
;
100 Warnings_As_Errors_Count_Config
:= Warnings_As_Errors_Count
;
102 -- Reset the indication that Optimize_Alignment was set locally, since
103 -- if we had a pragma in the config file, it would set this flag True,
104 -- but that's not a local setting.
106 Optimize_Alignment_Local
:= False;
107 end Register_Config_Switches
;
109 -----------------------------
110 -- Restore_Config_Switches --
111 -----------------------------
113 procedure Restore_Config_Switches
(Save
: Config_Switches_Type
) is
115 Ada_Version
:= Save
.Ada_Version
;
116 Ada_Version_Pragma
:= Save
.Ada_Version_Pragma
;
117 Ada_Version_Explicit
:= Save
.Ada_Version_Explicit
;
118 Assertions_Enabled
:= Save
.Assertions_Enabled
;
119 Assume_No_Invalid_Values
:= Save
.Assume_No_Invalid_Values
;
120 Check_Float_Overflow
:= Save
.Check_Float_Overflow
;
121 Check_Policy_List
:= Save
.Check_Policy_List
;
122 Default_Pool
:= Save
.Default_Pool
;
123 Default_SSO
:= Save
.Default_SSO
;
124 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
125 Exception_Locations_Suppressed
:= Save
.Exception_Locations_Suppressed
;
126 Extensions_Allowed
:= Save
.Extensions_Allowed
;
127 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
128 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
129 Fast_Math
:= Save
.Fast_Math
;
130 Initialize_Scalars
:= Save
.Initialize_Scalars
;
131 No_Component_Reordering
:= Save
.No_Component_Reordering
;
132 Optimize_Alignment
:= Save
.Optimize_Alignment
;
133 Optimize_Alignment_Local
:= Save
.Optimize_Alignment_Local
;
134 Persistent_BSS_Mode
:= Save
.Persistent_BSS_Mode
;
135 Prefix_Exception_Messages
:= Save
.Prefix_Exception_Messages
;
136 SPARK_Mode
:= Save
.SPARK_Mode
;
137 SPARK_Mode_Pragma
:= Save
.SPARK_Mode_Pragma
;
138 Uneval_Old
:= Save
.Uneval_Old
;
139 Use_VADS_Size
:= Save
.Use_VADS_Size
;
140 Warnings_As_Errors_Count
:= Save
.Warnings_As_Errors_Count
;
142 -- Update consistently the value of Init_Or_Norm_Scalars. The value of
143 -- Normalize_Scalars is not saved/restored because after set to True its
144 -- value is never changed. That is, if a compilation unit has pragma
145 -- Normalize_Scalars then it forces that value for all with'ed units.
147 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
148 end Restore_Config_Switches
;
150 --------------------------
151 -- Save_Config_Switches --
152 --------------------------
154 function Save_Config_Switches
return Config_Switches_Type
is
157 (Ada_Version
=> Ada_Version
,
158 Ada_Version_Pragma
=> Ada_Version_Pragma
,
159 Ada_Version_Explicit
=> Ada_Version_Explicit
,
160 Assertions_Enabled
=> Assertions_Enabled
,
161 Assume_No_Invalid_Values
=> Assume_No_Invalid_Values
,
162 Check_Float_Overflow
=> Check_Float_Overflow
,
163 Check_Policy_List
=> Check_Policy_List
,
164 Default_Pool
=> Default_Pool
,
165 Default_SSO
=> Default_SSO
,
166 Dynamic_Elaboration_Checks
=> Dynamic_Elaboration_Checks
,
167 Exception_Locations_Suppressed
=> Exception_Locations_Suppressed
,
168 Extensions_Allowed
=> Extensions_Allowed
,
169 External_Name_Exp_Casing
=> External_Name_Exp_Casing
,
170 External_Name_Imp_Casing
=> External_Name_Imp_Casing
,
171 Fast_Math
=> Fast_Math
,
172 Initialize_Scalars
=> Initialize_Scalars
,
173 No_Component_Reordering
=> No_Component_Reordering
,
174 Normalize_Scalars
=> Normalize_Scalars
,
175 Optimize_Alignment
=> Optimize_Alignment
,
176 Optimize_Alignment_Local
=> Optimize_Alignment_Local
,
177 Persistent_BSS_Mode
=> Persistent_BSS_Mode
,
178 Prefix_Exception_Messages
=> Prefix_Exception_Messages
,
179 SPARK_Mode
=> SPARK_Mode
,
180 SPARK_Mode_Pragma
=> SPARK_Mode_Pragma
,
181 Uneval_Old
=> Uneval_Old
,
182 Use_VADS_Size
=> Use_VADS_Size
,
183 Warnings_As_Errors_Count
=> Warnings_As_Errors_Count
);
184 end Save_Config_Switches
;
186 -------------------------
187 -- Set_Config_Switches --
188 -------------------------
190 procedure Set_Config_Switches
191 (Internal_Unit
: Boolean;
195 -- Case of internal unit
197 if Internal_Unit
then
199 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
200 -- since the whole point of this is that it still properly indicates
201 -- the configuration setting even in a run time unit.
203 Ada_Version
:= Ada_Version_Runtime
;
204 Ada_Version_Pragma
:= Empty
;
206 Dynamic_Elaboration_Checks
:= False;
207 Extensions_Allowed
:= True;
208 External_Name_Exp_Casing
:= As_Is
;
209 External_Name_Imp_Casing
:= Lowercase
;
210 No_Component_Reordering
:= False;
211 Optimize_Alignment
:= 'O';
212 Optimize_Alignment_Local
:= True;
213 Persistent_BSS_Mode
:= False;
214 Prefix_Exception_Messages
:= True;
216 Use_VADS_Size
:= False;
218 -- Note: we do not need to worry about Warnings_As_Errors_Count since
219 -- we do not expect to get any warnings from compiling such a unit.
221 -- For an internal unit, assertions/debug pragmas are off unless this
222 -- is the main unit and they were explicitly enabled, or unless the
223 -- main unit was compiled in GNAT mode. We also make sure we do not
224 -- assume that values are necessarily valid and that SPARK_Mode is
225 -- set to its configuration value.
228 Assertions_Enabled
:= Assertions_Enabled_Config
;
229 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
230 Check_Policy_List
:= Check_Policy_List_Config
;
231 SPARK_Mode
:= SPARK_Mode_Config
;
232 SPARK_Mode_Pragma
:= SPARK_Mode_Pragma_Config
;
235 -- In GNATprove mode assertions should be always enabled, even
236 -- when analysing internal units.
238 if GNATprove_Mode
then
239 pragma Assert
(Assertions_Enabled
);
242 elsif GNAT_Mode_Config
then
243 Assertions_Enabled
:= Assertions_Enabled_Config
;
245 Assertions_Enabled
:= False;
248 Assume_No_Invalid_Values
:= False;
249 Check_Policy_List
:= Empty
;
251 SPARK_Mode_Pragma
:= Empty
;
254 -- Case of non-internal unit
257 Ada_Version
:= Ada_Version_Config
;
258 Ada_Version_Pragma
:= Ada_Version_Pragma_Config
;
259 Ada_Version_Explicit
:= Ada_Version_Explicit_Config
;
260 Assertions_Enabled
:= Assertions_Enabled_Config
;
261 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
262 Check_Float_Overflow
:= Check_Float_Overflow_Config
;
263 Check_Policy_List
:= Check_Policy_List_Config
;
264 Default_SSO
:= Default_SSO_Config
;
265 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
266 Extensions_Allowed
:= Extensions_Allowed_Config
;
267 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
268 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
269 Fast_Math
:= Fast_Math_Config
;
270 Initialize_Scalars
:= Initialize_Scalars_Config
;
271 No_Component_Reordering
:= No_Component_Reordering_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
;
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
288 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
291 -- Values set for all units
293 Default_Pool
:= Default_Pool_Config
;
294 Exception_Locations_Suppressed
:= Exception_Locations_Suppressed_Config
;
295 Fast_Math
:= Fast_Math_Config
;
296 end Set_Config_Switches
;