1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- O P T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2020, 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. 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. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26package body Opt is 27 28 ------------------------- 29 -- Back_End_Exceptions -- 30 ------------------------- 31 32 function Back_End_Exceptions return Boolean is 33 begin 34 return 35 Exception_Mechanism = Back_End_SJLJ 36 or else 37 Exception_Mechanism = Back_End_ZCX; 38 end Back_End_Exceptions; 39 40 ------------------------- 41 -- Front_End_Exceptions -- 42 ------------------------- 43 44 function Front_End_Exceptions return Boolean is 45 begin 46 return Exception_Mechanism = Front_End_SJLJ; 47 end Front_End_Exceptions; 48 49 -------------------- 50 -- SJLJ_Exceptions -- 51 -------------------- 52 53 function SJLJ_Exceptions return Boolean is 54 begin 55 return 56 Exception_Mechanism = Back_End_SJLJ 57 or else 58 Exception_Mechanism = Front_End_SJLJ; 59 end SJLJ_Exceptions; 60 61 -------------------- 62 -- ZCX_Exceptions -- 63 -------------------- 64 65 function ZCX_Exceptions return Boolean is 66 begin 67 return Exception_Mechanism = Back_End_ZCX; 68 end ZCX_Exceptions; 69 70 ------------------------------ 71 -- Register_Config_Switches -- 72 ------------------------------ 73 74 procedure Register_Config_Switches is 75 begin 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; 101 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. 105 106 Optimize_Alignment_Local := False; 107 end Register_Config_Switches; 108 109 ----------------------------- 110 -- Restore_Config_Switches -- 111 ----------------------------- 112 113 procedure Restore_Config_Switches (Save : Config_Switches_Type) is 114 begin 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; 141 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. 146 147 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; 148 end Restore_Config_Switches; 149 150 -------------------------- 151 -- Save_Config_Switches -- 152 -------------------------- 153 154 function Save_Config_Switches return Config_Switches_Type is 155 begin 156 return 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; 185 186 ------------------------- 187 -- Set_Config_Switches -- 188 ------------------------- 189 190 procedure Set_Config_Switches 191 (Internal_Unit : Boolean; 192 Main_Unit : Boolean) 193 is 194 begin 195 -- Case of internal unit 196 197 if Internal_Unit then 198 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. 202 203 Ada_Version := Ada_Version_Runtime; 204 Ada_Version_Pragma := Empty; 205 Default_SSO := ' '; 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; 215 Uneval_Old := 'E'; 216 Use_VADS_Size := False; 217 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. 220 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. 226 227 if Main_Unit then 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; 233 234 else 235 -- In GNATprove mode assertions should be always enabled, even 236 -- when analysing internal units. 237 238 if GNATprove_Mode then 239 pragma Assert (Assertions_Enabled); 240 null; 241 242 elsif GNAT_Mode_Config then 243 Assertions_Enabled := Assertions_Enabled_Config; 244 else 245 Assertions_Enabled := False; 246 end if; 247 248 Assume_No_Invalid_Values := False; 249 Check_Policy_List := Empty; 250 SPARK_Mode := None; 251 SPARK_Mode_Pragma := Empty; 252 end if; 253 254 -- Case of non-internal unit 255 256 else 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; 281 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 286 -- with'ed units. 287 288 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; 289 end if; 290 291 -- Values set for all units 292 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; 297 298end Opt; 299