1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- O P T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2013, 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 -- Register_Opt_Config_Switches -- 43 ---------------------------------- 44 45 procedure Register_Opt_Config_Switches is 46 begin 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; 70 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. 74 75 Optimize_Alignment_Local := False; 76 end Register_Opt_Config_Switches; 77 78 --------------------------------- 79 -- Restore_Opt_Config_Switches -- 80 --------------------------------- 81 82 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is 83 begin 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; 108 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. 113 114 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; 115 end Restore_Opt_Config_Switches; 116 117 ------------------------------ 118 -- Save_Opt_Config_Switches -- 119 ------------------------------ 120 121 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is 122 begin 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; 148 149 ----------------------------- 150 -- Set_Opt_Config_Switches -- 151 ----------------------------- 152 153 procedure Set_Opt_Config_Switches 154 (Internal_Unit : Boolean; 155 Main_Unit : Boolean) 156 is 157 begin 158 -- Case of internal unit 159 160 if Internal_Unit then 161 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. 165 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; 176 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. 179 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. 184 185 if Main_Unit then 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; 191 else 192 Assertions_Enabled := False; 193 Assume_No_Invalid_Values := False; 194 Check_Policy_List := Empty; 195 SPARK_Mode := None; 196 SPARK_Mode_Pragma := Empty; 197 end if; 198 199 -- Case of non-internal unit 200 201 else 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; 222 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 227 -- with'ed units. 228 229 Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars; 230 end if; 231 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; 239 240 --------------- 241 -- Tree_Read -- 242 --------------- 243 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; 249 250 begin 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); 270 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); 277 278 -- Read version string: we have to get the length first 279 280 Tree_Read_Int (Tree_Version_String_Len); 281 282 declare 283 Tmp : String (1 .. Integer (Tree_Version_String_Len)); 284 begin 285 Tree_Read_Data 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); 290 end; 291 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); 306 end Tree_Read; 307 308 ---------------- 309 -- Tree_Write -- 310 ---------------- 311 312 procedure Tree_Write is 313 Version_String : String := Gnat_Version_String; 314 315 begin 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); 351 end Tree_Write; 352 353end Opt; 354