1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2008, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Gnatvsn; use Gnatvsn;
35 with System; use System;
36 with Tree_IO; use Tree_IO;
40 SU : constant := Storage_Unit;
41 -- Shorthand for System.Storage_Unit
43 ----------------------------------
44 -- Register_Opt_Config_Switches --
45 ----------------------------------
47 procedure Register_Opt_Config_Switches is
49 Ada_Version_Config := Ada_Version;
50 Ada_Version_Explicit_Config := Ada_Version_Explicit;
51 Assertions_Enabled_Config := Assertions_Enabled;
52 Assume_No_Invalid_Values_Config := Assume_No_Invalid_Values;
53 Check_Policy_List_Config := Check_Policy_List;
54 Debug_Pragmas_Enabled_Config := Debug_Pragmas_Enabled;
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 Optimize_Alignment_Config := Optimize_Alignment;
62 Persistent_BSS_Mode_Config := Persistent_BSS_Mode;
63 Polling_Required_Config := Polling_Required;
64 Use_VADS_Size_Config := Use_VADS_Size;
66 -- Reset the indication that Optimize_Alignment was set locally, since
67 -- if we had a pragma in the config file, it would set this flag True,
68 -- but that's not a local setting.
70 Optimize_Alignment_Local := False;
71 end Register_Opt_Config_Switches;
73 ---------------------------------
74 -- Restore_Opt_Config_Switches --
75 ---------------------------------
77 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
79 Ada_Version := Save.Ada_Version;
80 Ada_Version_Explicit := Save.Ada_Version_Explicit;
81 Assertions_Enabled := Save.Assertions_Enabled;
82 Assume_No_Invalid_Values := Save.Assume_No_Invalid_Values;
83 Check_Policy_List := Save.Check_Policy_List;
84 Debug_Pragmas_Enabled := Save.Debug_Pragmas_Enabled;
85 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
86 Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
87 Extensions_Allowed := Save.Extensions_Allowed;
88 External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
89 External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
90 Fast_Math := Save.Fast_Math;
91 Optimize_Alignment := Save.Optimize_Alignment;
92 Optimize_Alignment_Local := Save.Optimize_Alignment_Local;
93 Persistent_BSS_Mode := Save.Persistent_BSS_Mode;
94 Polling_Required := Save.Polling_Required;
95 Use_VADS_Size := Save.Use_VADS_Size;
96 end Restore_Opt_Config_Switches;
98 ------------------------------
99 -- Save_Opt_Config_Switches --
100 ------------------------------
102 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
104 Save.Ada_Version := Ada_Version;
105 Save.Ada_Version_Explicit := Ada_Version_Explicit;
106 Save.Assertions_Enabled := Assertions_Enabled;
107 Save.Assume_No_Invalid_Values := Assume_No_Invalid_Values;
108 Save.Check_Policy_List := Check_Policy_List;
109 Save.Debug_Pragmas_Enabled := Debug_Pragmas_Enabled;
110 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
111 Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
112 Save.Extensions_Allowed := Extensions_Allowed;
113 Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
114 Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
115 Save.Fast_Math := Fast_Math;
116 Save.Optimize_Alignment := Optimize_Alignment;
117 Save.Optimize_Alignment_Local := Optimize_Alignment_Local;
118 Save.Persistent_BSS_Mode := Persistent_BSS_Mode;
119 Save.Polling_Required := Polling_Required;
120 Save.Use_VADS_Size := Use_VADS_Size;
121 end Save_Opt_Config_Switches;
123 -----------------------------
124 -- Set_Opt_Config_Switches --
125 -----------------------------
127 procedure Set_Opt_Config_Switches
128 (Internal_Unit : Boolean;
132 -- Case of internal unit
134 if Internal_Unit then
136 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
137 -- since the whole point of this is that it still properly indicates
138 -- the configuration setting even in a run time unit.
140 Ada_Version := Ada_Version_Runtime;
141 Dynamic_Elaboration_Checks := False;
142 Extensions_Allowed := True;
143 External_Name_Exp_Casing := As_Is;
144 External_Name_Imp_Casing := Lowercase;
145 Optimize_Alignment := 'O';
146 Persistent_BSS_Mode := False;
147 Use_VADS_Size := False;
148 Optimize_Alignment_Local := True;
150 -- For an internal unit, assertions/debug pragmas are off unless this
151 -- is the main unit and they were explicitly enabled. We also make
152 -- sure we do not assume that values are necessarily valid.
155 Assertions_Enabled := Assertions_Enabled_Config;
156 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
157 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
158 Check_Policy_List := Check_Policy_List_Config;
160 Assertions_Enabled := False;
161 Assume_No_Invalid_Values := False;
162 Debug_Pragmas_Enabled := False;
163 Check_Policy_List := Empty;
166 -- Case of non-internal unit
169 Ada_Version := Ada_Version_Config;
170 Ada_Version_Explicit := Ada_Version_Explicit_Config;
171 Assertions_Enabled := Assertions_Enabled_Config;
172 Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
173 Check_Policy_List := Check_Policy_List_Config;
174 Debug_Pragmas_Enabled := Debug_Pragmas_Enabled_Config;
175 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
176 Extensions_Allowed := Extensions_Allowed_Config;
177 External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
178 External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
179 Fast_Math := Fast_Math_Config;
180 Optimize_Alignment := Optimize_Alignment_Config;
181 Optimize_Alignment_Local := False;
182 Persistent_BSS_Mode := Persistent_BSS_Mode_Config;
183 Use_VADS_Size := Use_VADS_Size_Config;
186 Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
187 Fast_Math := Fast_Math_Config;
188 Optimize_Alignment := Optimize_Alignment_Config;
189 Polling_Required := Polling_Required_Config;
190 end Set_Opt_Config_Switches;
196 procedure Tree_Read is
197 Tree_Version_String_Len : Nat;
198 Ada_Version_Config_Val : Nat;
199 Ada_Version_Explicit_Config_Val : Nat;
200 Assertions_Enabled_Config_Val : Nat;
203 Tree_Read_Int (Tree_ASIS_Version_Number);
204 Tree_Read_Bool (Brief_Output);
205 Tree_Read_Bool (GNAT_Mode);
206 Tree_Read_Char (Identifier_Character_Set);
207 Tree_Read_Int (Maximum_File_Name_Length);
208 Tree_Read_Data (Suppress_Options'Address,
209 (Suppress_Options'Size + SU - 1) / SU);
210 Tree_Read_Bool (Verbose_Mode);
211 Tree_Read_Data (Warning_Mode'Address,
212 (Warning_Mode'Size + SU - 1) / SU);
213 Tree_Read_Int (Ada_Version_Config_Val);
214 Tree_Read_Int (Ada_Version_Explicit_Config_Val);
215 Tree_Read_Int (Assertions_Enabled_Config_Val);
216 Tree_Read_Bool (All_Errors_Mode);
217 Tree_Read_Bool (Assertions_Enabled);
218 Tree_Read_Int (Int (Check_Policy_List));
219 Tree_Read_Bool (Debug_Pragmas_Enabled);
220 Tree_Read_Bool (Enable_Overflow_Checks);
221 Tree_Read_Bool (Full_List);
223 Ada_Version_Config :=
224 Ada_Version_Type'Val (Ada_Version_Config_Val);
225 Ada_Version_Explicit_Config :=
226 Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
227 Assertions_Enabled_Config :=
228 Boolean'Val (Assertions_Enabled_Config_Val);
230 -- Read version string: we have to get the length first
232 Tree_Read_Int (Tree_Version_String_Len);
235 Tmp : String (1 .. Integer (Tree_Version_String_Len));
238 (Tmp'Address, Tree_Version_String_Len);
239 System.Strings.Free (Tree_Version_String);
240 Free (Tree_Version_String);
241 Tree_Version_String := new String'(Tmp);
244 Tree_Read_Data (Distribution_Stub_Mode'Address,
245 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
246 Tree_Read_Bool (Inline_Active);
247 Tree_Read_Bool (Inline_Processing_Required);
248 Tree_Read_Bool (List_Units);
249 Tree_Read_Bool (Configurable_Run_Time_Mode);
250 Tree_Read_Data (Operating_Mode'Address,
251 (Operating_Mode'Size + SU - 1) / Storage_Unit);
252 Tree_Read_Bool (Suppress_Checks);
253 Tree_Read_Bool (Try_Semantics);
254 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
255 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
256 Tree_Read_Bool (Upper_Half_Encoding);
257 Tree_Read_Bool (Force_ALI_Tree_File);
264 procedure Tree_Write is
265 Version_String : String := Gnat_Version_String;
268 Tree_Write_Int (ASIS_Version_Number);
269 Tree_Write_Bool (Brief_Output);
270 Tree_Write_Bool (GNAT_Mode);
271 Tree_Write_Char (Identifier_Character_Set);
272 Tree_Write_Int (Maximum_File_Name_Length);
273 Tree_Write_Data (Suppress_Options'Address,
274 (Suppress_Options'Size + SU - 1) / SU);
275 Tree_Write_Bool (Verbose_Mode);
276 Tree_Write_Data (Warning_Mode'Address,
277 (Warning_Mode'Size + SU - 1) / Storage_Unit);
278 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
279 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
280 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
281 Tree_Write_Bool (All_Errors_Mode);
282 Tree_Write_Bool (Assertions_Enabled);
283 Tree_Write_Int (Int (Check_Policy_List));
284 Tree_Write_Bool (Debug_Pragmas_Enabled);
285 Tree_Write_Bool (Enable_Overflow_Checks);
286 Tree_Write_Bool (Full_List);
287 Tree_Write_Int (Int (Version_String'Length));
288 Tree_Write_Data (Version_String'Address, Version_String'Length);
289 Tree_Write_Data (Distribution_Stub_Mode'Address,
290 (Distribution_Stub_Mode'Size + SU - 1) / SU);
291 Tree_Write_Bool (Inline_Active);
292 Tree_Write_Bool (Inline_Processing_Required);
293 Tree_Write_Bool (List_Units);
294 Tree_Write_Bool (Configurable_Run_Time_Mode);
295 Tree_Write_Data (Operating_Mode'Address,
296 (Operating_Mode'Size + SU - 1) / SU);
297 Tree_Write_Bool (Suppress_Checks);
298 Tree_Write_Bool (Try_Semantics);
299 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
300 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
301 Tree_Write_Bool (Upper_Half_Encoding);
302 Tree_Write_Bool (Force_ALI_Tree_File);