1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, 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 External_Name_Exp_Casing_Config
:= External_Name_Exp_Casing
;
88 External_Name_Imp_Casing_Config
:= External_Name_Imp_Casing
;
89 Fast_Math_Config
:= Fast_Math
;
90 Initialize_Scalars_Config
:= Initialize_Scalars
;
91 No_Component_Reordering_Config
:= No_Component_Reordering
;
92 Optimize_Alignment_Config
:= Optimize_Alignment
;
93 Persistent_BSS_Mode_Config
:= Persistent_BSS_Mode
;
94 Prefix_Exception_Messages_Config
:= Prefix_Exception_Messages
;
95 SPARK_Mode_Config
:= SPARK_Mode
;
96 SPARK_Mode_Pragma_Config
:= SPARK_Mode_Pragma
;
97 Uneval_Old_Config
:= Uneval_Old
;
98 Use_VADS_Size_Config
:= Use_VADS_Size
;
99 Warnings_As_Errors_Count_Config
:= Warnings_As_Errors_Count
;
101 -- Reset the indication that Optimize_Alignment was set locally, since
102 -- if we had a pragma in the config file, it would set this flag True,
103 -- but that's not a local setting.
105 Optimize_Alignment_Local
:= False;
106 end Register_Config_Switches
;
108 -----------------------------
109 -- Restore_Config_Switches --
110 -----------------------------
112 procedure Restore_Config_Switches
(Save
: Config_Switches_Type
) is
114 Ada_Version
:= Save
.Ada_Version
;
115 Ada_Version_Pragma
:= Save
.Ada_Version_Pragma
;
116 Ada_Version_Explicit
:= Save
.Ada_Version_Explicit
;
117 Assertions_Enabled
:= Save
.Assertions_Enabled
;
118 Assume_No_Invalid_Values
:= Save
.Assume_No_Invalid_Values
;
119 Check_Float_Overflow
:= Save
.Check_Float_Overflow
;
120 Check_Policy_List
:= Save
.Check_Policy_List
;
121 Default_Pool
:= Save
.Default_Pool
;
122 Default_SSO
:= Save
.Default_SSO
;
123 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
124 Exception_Locations_Suppressed
:= Save
.Exception_Locations_Suppressed
;
125 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
126 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
127 Fast_Math
:= Save
.Fast_Math
;
128 Initialize_Scalars
:= Save
.Initialize_Scalars
;
129 No_Component_Reordering
:= Save
.No_Component_Reordering
;
130 Optimize_Alignment
:= Save
.Optimize_Alignment
;
131 Optimize_Alignment_Local
:= Save
.Optimize_Alignment_Local
;
132 Persistent_BSS_Mode
:= Save
.Persistent_BSS_Mode
;
133 Prefix_Exception_Messages
:= Save
.Prefix_Exception_Messages
;
134 SPARK_Mode
:= Save
.SPARK_Mode
;
135 SPARK_Mode_Pragma
:= Save
.SPARK_Mode_Pragma
;
136 Uneval_Old
:= Save
.Uneval_Old
;
137 Use_VADS_Size
:= Save
.Use_VADS_Size
;
138 Warnings_As_Errors_Count
:= Save
.Warnings_As_Errors_Count
;
140 -- Update consistently the value of Init_Or_Norm_Scalars. The value of
141 -- Normalize_Scalars is not saved/restored because after set to True its
142 -- value is never changed. That is, if a compilation unit has pragma
143 -- Normalize_Scalars then it forces that value for all with'ed units.
145 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
146 end Restore_Config_Switches
;
148 --------------------------
149 -- Save_Config_Switches --
150 --------------------------
152 function Save_Config_Switches
return Config_Switches_Type
is
155 (Ada_Version
=> Ada_Version
,
156 Ada_Version_Pragma
=> Ada_Version_Pragma
,
157 Ada_Version_Explicit
=> Ada_Version_Explicit
,
158 Assertions_Enabled
=> Assertions_Enabled
,
159 Assume_No_Invalid_Values
=> Assume_No_Invalid_Values
,
160 Check_Float_Overflow
=> Check_Float_Overflow
,
161 Check_Policy_List
=> Check_Policy_List
,
162 Default_Pool
=> Default_Pool
,
163 Default_SSO
=> Default_SSO
,
164 Dynamic_Elaboration_Checks
=> Dynamic_Elaboration_Checks
,
165 Exception_Locations_Suppressed
=> Exception_Locations_Suppressed
,
166 External_Name_Exp_Casing
=> External_Name_Exp_Casing
,
167 External_Name_Imp_Casing
=> External_Name_Imp_Casing
,
168 Fast_Math
=> Fast_Math
,
169 Initialize_Scalars
=> Initialize_Scalars
,
170 No_Component_Reordering
=> No_Component_Reordering
,
171 Normalize_Scalars
=> Normalize_Scalars
,
172 Optimize_Alignment
=> Optimize_Alignment
,
173 Optimize_Alignment_Local
=> Optimize_Alignment_Local
,
174 Persistent_BSS_Mode
=> Persistent_BSS_Mode
,
175 Prefix_Exception_Messages
=> Prefix_Exception_Messages
,
176 SPARK_Mode
=> SPARK_Mode
,
177 SPARK_Mode_Pragma
=> SPARK_Mode_Pragma
,
178 Uneval_Old
=> Uneval_Old
,
179 Use_VADS_Size
=> Use_VADS_Size
,
180 Warnings_As_Errors_Count
=> Warnings_As_Errors_Count
);
181 end Save_Config_Switches
;
183 -------------------------
184 -- Set_Config_Switches --
185 -------------------------
187 procedure Set_Config_Switches
188 (Internal_Unit
: Boolean;
192 -- Case of internal unit
194 if Internal_Unit
then
196 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
197 -- since the whole point of this is that it still properly indicates
198 -- the configuration setting even in a run time unit.
200 Ada_Version
:= Ada_Version_Runtime
;
201 Ada_Version_Pragma
:= Empty
;
203 Dynamic_Elaboration_Checks
:= False;
204 External_Name_Exp_Casing
:= As_Is
;
205 External_Name_Imp_Casing
:= Lowercase
;
206 No_Component_Reordering
:= False;
207 Optimize_Alignment
:= 'O';
208 Optimize_Alignment_Local
:= True;
209 Persistent_BSS_Mode
:= False;
210 Prefix_Exception_Messages
:= True;
212 Use_VADS_Size
:= False;
214 -- Note: we do not need to worry about Warnings_As_Errors_Count since
215 -- we do not expect to get any warnings from compiling such a unit.
217 -- For an internal unit, assertions/debug pragmas are off unless this
218 -- is the main unit and they were explicitly enabled, or unless the
219 -- main unit was compiled in GNAT mode. We also make sure we do not
220 -- assume that values are necessarily valid and that SPARK_Mode is
221 -- set to its configuration value.
224 Assertions_Enabled
:= Assertions_Enabled_Config
;
225 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
226 Check_Policy_List
:= Check_Policy_List_Config
;
227 SPARK_Mode
:= SPARK_Mode_Config
;
228 SPARK_Mode_Pragma
:= SPARK_Mode_Pragma_Config
;
231 -- In GNATprove mode assertions should be always enabled, even
232 -- when analysing internal units.
234 if GNATprove_Mode
then
235 pragma Assert
(Assertions_Enabled
);
238 elsif GNAT_Mode_Config
then
239 Assertions_Enabled
:= Assertions_Enabled_Config
;
241 Assertions_Enabled
:= False;
244 Assume_No_Invalid_Values
:= False;
245 Check_Policy_List
:= Empty
;
247 SPARK_Mode_Pragma
:= Empty
;
250 -- Case of non-internal unit
253 Ada_Version
:= Ada_Version_Config
;
254 Ada_Version_Pragma
:= Ada_Version_Pragma_Config
;
255 Ada_Version_Explicit
:= Ada_Version_Explicit_Config
;
256 Assertions_Enabled
:= Assertions_Enabled_Config
;
257 Assume_No_Invalid_Values
:= Assume_No_Invalid_Values_Config
;
258 Check_Float_Overflow
:= Check_Float_Overflow_Config
;
259 Check_Policy_List
:= Check_Policy_List_Config
;
260 Default_SSO
:= Default_SSO_Config
;
261 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
262 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
263 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
264 Fast_Math
:= Fast_Math_Config
;
265 Initialize_Scalars
:= Initialize_Scalars_Config
;
266 No_Component_Reordering
:= No_Component_Reordering_Config
;
267 Optimize_Alignment
:= Optimize_Alignment_Config
;
268 Optimize_Alignment_Local
:= False;
269 Persistent_BSS_Mode
:= Persistent_BSS_Mode_Config
;
270 Prefix_Exception_Messages
:= Prefix_Exception_Messages_Config
;
271 SPARK_Mode
:= SPARK_Mode_Config
;
272 SPARK_Mode_Pragma
:= SPARK_Mode_Pragma_Config
;
273 Uneval_Old
:= Uneval_Old_Config
;
274 Use_VADS_Size
:= Use_VADS_Size_Config
;
275 Warnings_As_Errors_Count
:= Warnings_As_Errors_Count_Config
;
277 -- Update consistently the value of Init_Or_Norm_Scalars. The value
278 -- of Normalize_Scalars is not saved/restored because once set to
279 -- True its value is never changed. That is, if a compilation unit
280 -- has pragma Normalize_Scalars then it forces that value for all
283 Init_Or_Norm_Scalars
:= Initialize_Scalars
or Normalize_Scalars
;
286 -- Values set for all units
288 Default_Pool
:= Default_Pool_Config
;
289 Exception_Locations_Suppressed
:= Exception_Locations_Suppressed_Config
;
290 Fast_Math
:= Fast_Math_Config
;
291 end Set_Config_Switches
;