1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- O P T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2015, 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 32with Gnatvsn; use Gnatvsn; 33with System; use System; 34with Tree_IO; use Tree_IO; 35 36package 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 Optimize_Alignment_Config := Optimize_Alignment; 106 Persistent_BSS_Mode_Config := Persistent_BSS_Mode; 107 Polling_Required_Config := Polling_Required; 108 Prefix_Exception_Messages_Config := Prefix_Exception_Messages; 109 SPARK_Mode_Config := SPARK_Mode; 110 SPARK_Mode_Pragma_Config := SPARK_Mode_Pragma; 111 Uneval_Old_Config := Uneval_Old; 112 Use_VADS_Size_Config := Use_VADS_Size; 113 Warnings_As_Errors_Count_Config := Warnings_As_Errors_Count; 114 115 -- Reset the indication that Optimize_Alignment was set locally, since 116 -- if we had a pragma in the config file, it would set this flag True, 117 -- but that's not a local setting. 118 119 Optimize_Alignment_Local := False; 120 end Register_Opt_Config_Switches; 121 122 --------------------------------- 123 -- Restore_Opt_Config_Switches -- 124 --------------------------------- 125 126 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is 127 begin 128 Ada_Version := Save.Ada_Version; 129 Ada_Version_Pragma := Save.Ada_Version_Pragma; 130 Ada_Version_Explicit := Save.Ada_Version_Explicit; 131 Assertions_Enabled := Save.Assertions_Enabled; 132 Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values; 133 Check_Float_Overflow := Save.Check_Float_Overflow; 134 Check_Policy_List := Save.Check_Policy_List; 135 Default_Pool := Save.Default_Pool; 136 Default_SSO := Save.Default_SSO; 137 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks; 138 Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed; 139 Extensions_Allowed := Save.Extensions_Allowed; 140 External_Name_Exp_Casing := Save.External_Name_Exp_Casing; 141 External_Name_Imp_Casing := Save.External_Name_Imp_Casing; 142 Fast_Math := Save.Fast_Math; 143 Initialize_Scalars := Save.Initialize_Scalars; 144 Optimize_Alignment := Save.Optimize_Alignment; 145 Optimize_Alignment_Local := Save.Optimize_Alignment_Local; 146 Persistent_BSS_Mode := Save.Persistent_BSS_Mode; 147 Polling_Required := Save.Polling_Required; 148 Prefix_Exception_Messages := Save.Prefix_Exception_Messages; 149 SPARK_Mode := Save.SPARK_Mode; 150 SPARK_Mode_Pragma := Save.SPARK_Mode_Pragma; 151 Uneval_Old := Save.Uneval_Old; 152 Use_VADS_Size := Save.Use_VADS_Size; 153 Warnings_As_Errors_Count := Save.Warnings_As_Errors_Count; 154 155 -- Update consistently the value of Init_Or_Norm_Scalars. The value of 156 -- Normalize_Scalars is not saved/restored because after set to True its 157 -- value is never changed. That is, if a compilation unit has pragma 158 -- Normalize_Scalars then it forces that value for all with'ed units. 159 160 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; 161 end Restore_Opt_Config_Switches; 162 163 ------------------------------ 164 -- Save_Opt_Config_Switches -- 165 ------------------------------ 166 167 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is 168 begin 169 Save.Ada_Version := Ada_Version; 170 Save.Ada_Version_Pragma := Ada_Version_Pragma; 171 Save.Ada_Version_Explicit := Ada_Version_Explicit; 172 Save.Assertions_Enabled := Assertions_Enabled; 173 Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values; 174 Save.Check_Float_Overflow := Check_Float_Overflow; 175 Save.Check_Policy_List := Check_Policy_List; 176 Save.Default_Pool := Default_Pool; 177 Save.Default_SSO := Default_SSO; 178 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks; 179 Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed; 180 Save.Extensions_Allowed := Extensions_Allowed; 181 Save.External_Name_Exp_Casing := External_Name_Exp_Casing; 182 Save.External_Name_Imp_Casing := External_Name_Imp_Casing; 183 Save.Fast_Math := Fast_Math; 184 Save.Initialize_Scalars := Initialize_Scalars; 185 Save.Optimize_Alignment := Optimize_Alignment; 186 Save.Optimize_Alignment_Local := Optimize_Alignment_Local; 187 Save.Persistent_BSS_Mode := Persistent_BSS_Mode; 188 Save.Polling_Required := Polling_Required; 189 Save.Prefix_Exception_Messages := Prefix_Exception_Messages; 190 Save.SPARK_Mode := SPARK_Mode; 191 Save.SPARK_Mode_Pragma := SPARK_Mode_Pragma; 192 Save.Uneval_Old := Uneval_Old; 193 Save.Use_VADS_Size := Use_VADS_Size; 194 Save.Warnings_As_Errors_Count := Warnings_As_Errors_Count; 195 end Save_Opt_Config_Switches; 196 197 ----------------------------- 198 -- Set_Opt_Config_Switches -- 199 ----------------------------- 200 201 procedure Set_Opt_Config_Switches 202 (Internal_Unit : Boolean; 203 Main_Unit : Boolean) 204 is 205 begin 206 -- Case of internal unit 207 208 if Internal_Unit then 209 210 -- Set standard switches. Note we do NOT set Ada_Version_Explicit 211 -- since the whole point of this is that it still properly indicates 212 -- the configuration setting even in a run time unit. 213 214 Ada_Version := Ada_Version_Runtime; 215 Ada_Version_Pragma := Empty; 216 Default_SSO := ' '; 217 Dynamic_Elaboration_Checks := False; 218 Extensions_Allowed := True; 219 External_Name_Exp_Casing := As_Is; 220 External_Name_Imp_Casing := Lowercase; 221 Optimize_Alignment := 'O'; 222 Persistent_BSS_Mode := False; 223 Prefix_Exception_Messages := True; 224 Uneval_Old := 'E'; 225 Use_VADS_Size := False; 226 Optimize_Alignment_Local := True; 227 228 -- Note: we do not need to worry about Warnings_As_Errors_Count since 229 -- we do not expect to get any warnings from compiling such a unit. 230 231 -- For an internal unit, assertions/debug pragmas are off unless this 232 -- is the main unit and they were explicitly enabled, or unless the 233 -- main unit was compiled in GNAT mode. We also make sure we do not 234 -- assume that values are necessarily valid and that SPARK_Mode is 235 -- set to its configuration value. 236 237 if Main_Unit then 238 Assertions_Enabled := Assertions_Enabled_Config; 239 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; 240 Check_Policy_List := Check_Policy_List_Config; 241 SPARK_Mode := SPARK_Mode_Config; 242 SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config; 243 else 244 if GNAT_Mode_Config then 245 Assertions_Enabled := Assertions_Enabled_Config; 246 else 247 Assertions_Enabled := False; 248 end if; 249 Assume_No_Invalid_Values := False; 250 Check_Policy_List := Empty; 251 SPARK_Mode := None; 252 SPARK_Mode_Pragma := Empty; 253 end if; 254 255 -- Case of non-internal unit 256 257 else 258 Ada_Version := Ada_Version_Config; 259 Ada_Version_Pragma := Ada_Version_Pragma_Config; 260 Ada_Version_Explicit := Ada_Version_Explicit_Config; 261 Assertions_Enabled := Assertions_Enabled_Config; 262 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config; 263 Check_Float_Overflow := Check_Float_Overflow_Config; 264 Check_Policy_List := Check_Policy_List_Config; 265 Default_SSO := Default_SSO_Config; 266 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config; 267 Extensions_Allowed := Extensions_Allowed_Config; 268 External_Name_Exp_Casing := External_Name_Exp_Casing_Config; 269 External_Name_Imp_Casing := External_Name_Imp_Casing_Config; 270 Fast_Math := Fast_Math_Config; 271 Initialize_Scalars := Initialize_Scalars_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 Optimize_Alignment := Optimize_Alignment_Config; 297 Polling_Required := Polling_Required_Config; 298 end Set_Opt_Config_Switches; 299 300 --------------- 301 -- Tree_Read -- 302 --------------- 303 304 procedure Tree_Read is 305 Tree_Version_String_Len : Nat; 306 Ada_Version_Config_Val : Nat; 307 Ada_Version_Explicit_Config_Val : Nat; 308 Assertions_Enabled_Config_Val : Nat; 309 310 begin 311 Tree_Read_Int (Tree_ASIS_Version_Number); 312 313 Tree_Read_Bool (Address_Is_Private); 314 Tree_Read_Bool (Brief_Output); 315 Tree_Read_Bool (GNAT_Mode); 316 Tree_Read_Char (Identifier_Character_Set); 317 Tree_Read_Bool (Ignore_Rep_Clauses); 318 Tree_Read_Bool (Ignore_Style_Checks_Pragmas); 319 Tree_Read_Int (Maximum_File_Name_Length); 320 Tree_Read_Data (Suppress_Options'Address, 321 (Suppress_Options'Size + SU - 1) / SU); 322 Tree_Read_Bool (Verbose_Mode); 323 Tree_Read_Data (Warning_Mode'Address, 324 (Warning_Mode'Size + SU - 1) / SU); 325 Tree_Read_Int (Ada_Version_Config_Val); 326 Tree_Read_Int (Ada_Version_Explicit_Config_Val); 327 Tree_Read_Int (Assertions_Enabled_Config_Val); 328 Tree_Read_Bool (All_Errors_Mode); 329 Tree_Read_Bool (Assertions_Enabled); 330 Tree_Read_Bool (Check_Float_Overflow); 331 Tree_Read_Int (Int (Check_Policy_List)); 332 Tree_Read_Int (Int (Default_Pool)); 333 Tree_Read_Bool (Full_List); 334 335 Ada_Version_Config := 336 Ada_Version_Type'Val (Ada_Version_Config_Val); 337 Ada_Version_Explicit_Config := 338 Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val); 339 Assertions_Enabled_Config := 340 Boolean'Val (Assertions_Enabled_Config_Val); 341 342 -- Read version string: we have to get the length first 343 344 Tree_Read_Int (Tree_Version_String_Len); 345 346 declare 347 Tmp : String (1 .. Integer (Tree_Version_String_Len)); 348 begin 349 Tree_Read_Data 350 (Tmp'Address, Tree_Version_String_Len); 351 System.Strings.Free (Tree_Version_String); 352 Free (Tree_Version_String); 353 Tree_Version_String := new String'(Tmp); 354 end; 355 356 Tree_Read_Data (Distribution_Stub_Mode'Address, 357 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit); 358 Tree_Read_Bool (Inline_Active); 359 Tree_Read_Bool (Inline_Processing_Required); 360 Tree_Read_Bool (List_Units); 361 Tree_Read_Int (Multiple_Unit_Index); 362 Tree_Read_Bool (Configurable_Run_Time_Mode); 363 Tree_Read_Data (Operating_Mode'Address, 364 (Operating_Mode'Size + SU - 1) / Storage_Unit); 365 Tree_Read_Bool (Suppress_Checks); 366 Tree_Read_Bool (Try_Semantics); 367 Tree_Read_Data (Wide_Character_Encoding_Method'Address, 368 (Wide_Character_Encoding_Method'Size + SU - 1) / SU); 369 Tree_Read_Bool (Upper_Half_Encoding); 370 Tree_Read_Bool (Force_ALI_Tree_File); 371 end Tree_Read; 372 373 ---------------- 374 -- Tree_Write -- 375 ---------------- 376 377 procedure Tree_Write is 378 Version_String : String := Gnat_Version_String; 379 380 begin 381 Tree_Write_Int (ASIS_Version_Number); 382 383 Tree_Write_Bool (Address_Is_Private); 384 Tree_Write_Bool (Brief_Output); 385 Tree_Write_Bool (GNAT_Mode); 386 Tree_Write_Char (Identifier_Character_Set); 387 Tree_Write_Bool (Ignore_Rep_Clauses); 388 Tree_Write_Bool (Ignore_Style_Checks_Pragmas); 389 Tree_Write_Int (Maximum_File_Name_Length); 390 Tree_Write_Data (Suppress_Options'Address, 391 (Suppress_Options'Size + SU - 1) / SU); 392 Tree_Write_Bool (Verbose_Mode); 393 Tree_Write_Data (Warning_Mode'Address, 394 (Warning_Mode'Size + SU - 1) / Storage_Unit); 395 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config)); 396 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config)); 397 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config)); 398 Tree_Write_Bool (All_Errors_Mode); 399 Tree_Write_Bool (Assertions_Enabled); 400 Tree_Write_Bool (Check_Float_Overflow); 401 Tree_Write_Int (Int (Check_Policy_List)); 402 Tree_Write_Int (Int (Default_Pool)); 403 Tree_Write_Bool (Full_List); 404 Tree_Write_Int (Int (Version_String'Length)); 405 Tree_Write_Data (Version_String'Address, Version_String'Length); 406 Tree_Write_Data (Distribution_Stub_Mode'Address, 407 (Distribution_Stub_Mode'Size + SU - 1) / SU); 408 Tree_Write_Bool (Inline_Active); 409 Tree_Write_Bool (Inline_Processing_Required); 410 Tree_Write_Bool (List_Units); 411 Tree_Write_Int (Multiple_Unit_Index); 412 Tree_Write_Bool (Configurable_Run_Time_Mode); 413 Tree_Write_Data (Operating_Mode'Address, 414 (Operating_Mode'Size + SU - 1) / SU); 415 Tree_Write_Bool (Suppress_Checks); 416 Tree_Write_Bool (Try_Semantics); 417 Tree_Write_Data (Wide_Character_Encoding_Method'Address, 418 (Wide_Character_Encoding_Method'Size + SU - 1) / SU); 419 Tree_Write_Bool (Upper_Half_Encoding); 420 Tree_Write_Bool (Force_ALI_Tree_File); 421 end Tree_Write; 422 423end Opt; 424