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 Check_Policy_List_Config
:= Check_Policy_List
;
53 Debug_Pragmas_Enabled_Config
:= Debug_Pragmas_Enabled
;
54 Dynamic_Elaboration_Checks_Config
:= Dynamic_Elaboration_Checks
;
55 Exception_Locations_Suppressed_Config
:= Exception_Locations_Suppressed
;
56 Extensions_Allowed_Config
:= Extensions_Allowed
;
57 External_Name_Exp_Casing_Config
:= External_Name_Exp_Casing
;
58 External_Name_Imp_Casing_Config
:= External_Name_Imp_Casing
;
59 Fast_Math_Config
:= Fast_Math
;
60 Optimize_Alignment_Config
:= Optimize_Alignment
;
61 Persistent_BSS_Mode_Config
:= Persistent_BSS_Mode
;
62 Polling_Required_Config
:= Polling_Required
;
63 Use_VADS_Size_Config
:= Use_VADS_Size
;
65 -- Reset the indication that Optimize_Alignment was set locally, since
66 -- if we had a pragma in the config file, it would set this flag True,
67 -- but that's not a local setting.
69 Optimize_Alignment_Local
:= False;
70 end Register_Opt_Config_Switches
;
72 ---------------------------------
73 -- Restore_Opt_Config_Switches --
74 ---------------------------------
76 procedure Restore_Opt_Config_Switches
(Save
: Config_Switches_Type
) is
78 Ada_Version
:= Save
.Ada_Version
;
79 Ada_Version_Explicit
:= Save
.Ada_Version_Explicit
;
80 Assertions_Enabled
:= Save
.Assertions_Enabled
;
81 Check_Policy_List
:= Save
.Check_Policy_List
;
82 Debug_Pragmas_Enabled
:= Save
.Debug_Pragmas_Enabled
;
83 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
84 Exception_Locations_Suppressed
:= Save
.Exception_Locations_Suppressed
;
85 Extensions_Allowed
:= Save
.Extensions_Allowed
;
86 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
87 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
88 Fast_Math
:= Save
.Fast_Math
;
89 Optimize_Alignment
:= Save
.Optimize_Alignment
;
90 Optimize_Alignment_Local
:= Save
.Optimize_Alignment_Local
;
91 Persistent_BSS_Mode
:= Save
.Persistent_BSS_Mode
;
92 Polling_Required
:= Save
.Polling_Required
;
93 Use_VADS_Size
:= Save
.Use_VADS_Size
;
94 end Restore_Opt_Config_Switches
;
96 ------------------------------
97 -- Save_Opt_Config_Switches --
98 ------------------------------
100 procedure Save_Opt_Config_Switches
(Save
: out Config_Switches_Type
) is
102 Save
.Ada_Version
:= Ada_Version
;
103 Save
.Ada_Version_Explicit
:= Ada_Version_Explicit
;
104 Save
.Assertions_Enabled
:= Assertions_Enabled
;
105 Save
.Check_Policy_List
:= Check_Policy_List
;
106 Save
.Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled
;
107 Save
.Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks
;
108 Save
.Exception_Locations_Suppressed
:= Exception_Locations_Suppressed
;
109 Save
.Extensions_Allowed
:= Extensions_Allowed
;
110 Save
.External_Name_Exp_Casing
:= External_Name_Exp_Casing
;
111 Save
.External_Name_Imp_Casing
:= External_Name_Imp_Casing
;
112 Save
.Fast_Math
:= Fast_Math
;
113 Save
.Optimize_Alignment
:= Optimize_Alignment
;
114 Save
.Optimize_Alignment_Local
:= Optimize_Alignment_Local
;
115 Save
.Persistent_BSS_Mode
:= Persistent_BSS_Mode
;
116 Save
.Polling_Required
:= Polling_Required
;
117 Save
.Use_VADS_Size
:= Use_VADS_Size
;
118 end Save_Opt_Config_Switches
;
120 -----------------------------
121 -- Set_Opt_Config_Switches --
122 -----------------------------
124 procedure Set_Opt_Config_Switches
125 (Internal_Unit
: Boolean;
129 -- Case of internal unit
131 if Internal_Unit
then
133 -- Set standard switches. Note we do NOT set Ada_Version_Explicit
134 -- since the whole point of this is that it still properly indicates
135 -- the configuration setting even in a run time unit.
137 Ada_Version
:= Ada_Version_Runtime
;
138 Dynamic_Elaboration_Checks
:= False;
139 Extensions_Allowed
:= True;
140 External_Name_Exp_Casing
:= As_Is
;
141 External_Name_Imp_Casing
:= Lowercase
;
142 Optimize_Alignment
:= 'O';
143 Persistent_BSS_Mode
:= False;
144 Use_VADS_Size
:= False;
145 Optimize_Alignment_Local
:= True;
147 -- For an internal unit, assertions/debug pragmas are off unless this
148 -- is the main unit and they were explicitly enabled.
151 Assertions_Enabled
:= Assertions_Enabled_Config
;
152 Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled_Config
;
153 Check_Policy_List
:= Check_Policy_List_Config
;
155 Assertions_Enabled
:= False;
156 Debug_Pragmas_Enabled
:= False;
157 Check_Policy_List
:= Empty
;
160 -- Case of non-internal unit
163 Ada_Version
:= Ada_Version_Config
;
164 Ada_Version_Explicit
:= Ada_Version_Explicit_Config
;
165 Assertions_Enabled
:= Assertions_Enabled_Config
;
166 Check_Policy_List
:= Check_Policy_List_Config
;
167 Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled_Config
;
168 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
169 Extensions_Allowed
:= Extensions_Allowed_Config
;
170 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
171 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
172 Fast_Math
:= Fast_Math_Config
;
173 Optimize_Alignment
:= Optimize_Alignment_Config
;
174 Optimize_Alignment_Local
:= False;
175 Persistent_BSS_Mode
:= Persistent_BSS_Mode_Config
;
176 Use_VADS_Size
:= Use_VADS_Size_Config
;
179 Exception_Locations_Suppressed
:= Exception_Locations_Suppressed_Config
;
180 Fast_Math
:= Fast_Math_Config
;
181 Optimize_Alignment
:= Optimize_Alignment_Config
;
182 Polling_Required
:= Polling_Required_Config
;
183 end Set_Opt_Config_Switches
;
189 procedure Tree_Read
is
190 Tree_Version_String_Len
: Nat
;
191 Ada_Version_Config_Val
: Nat
;
192 Ada_Version_Explicit_Config_Val
: Nat
;
193 Assertions_Enabled_Config_Val
: Nat
;
196 Tree_Read_Int
(Tree_ASIS_Version_Number
);
197 Tree_Read_Bool
(Brief_Output
);
198 Tree_Read_Bool
(GNAT_Mode
);
199 Tree_Read_Char
(Identifier_Character_Set
);
200 Tree_Read_Int
(Maximum_File_Name_Length
);
201 Tree_Read_Data
(Suppress_Options
'Address,
202 (Suppress_Options
'Size + SU
- 1) / SU
);
203 Tree_Read_Bool
(Verbose_Mode
);
204 Tree_Read_Data
(Warning_Mode
'Address,
205 (Warning_Mode
'Size + SU
- 1) / SU
);
206 Tree_Read_Int
(Ada_Version_Config_Val
);
207 Tree_Read_Int
(Ada_Version_Explicit_Config_Val
);
208 Tree_Read_Int
(Assertions_Enabled_Config_Val
);
209 Tree_Read_Bool
(All_Errors_Mode
);
210 Tree_Read_Bool
(Assertions_Enabled
);
211 Tree_Read_Int
(Int
(Check_Policy_List
));
212 Tree_Read_Bool
(Debug_Pragmas_Enabled
);
213 Tree_Read_Bool
(Enable_Overflow_Checks
);
214 Tree_Read_Bool
(Full_List
);
216 Ada_Version_Config
:=
217 Ada_Version_Type
'Val (Ada_Version_Config_Val
);
218 Ada_Version_Explicit_Config
:=
219 Ada_Version_Type
'Val (Ada_Version_Explicit_Config_Val
);
220 Assertions_Enabled_Config
:=
221 Boolean'Val (Assertions_Enabled_Config_Val
);
223 -- Read version string: we have to get the length first
225 Tree_Read_Int
(Tree_Version_String_Len
);
228 Tmp
: String (1 .. Integer (Tree_Version_String_Len
));
231 (Tmp
'Address, Tree_Version_String_Len
);
232 System
.Strings
.Free
(Tree_Version_String
);
233 Free
(Tree_Version_String
);
234 Tree_Version_String
:= new String'(Tmp);
237 Tree_Read_Data (Distribution_Stub_Mode'Address,
238 (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
239 Tree_Read_Bool (Inline_Active);
240 Tree_Read_Bool (Inline_Processing_Required);
241 Tree_Read_Bool (List_Units);
242 Tree_Read_Bool (Configurable_Run_Time_Mode);
243 Tree_Read_Data (Operating_Mode'Address,
244 (Operating_Mode'Size + SU - 1) / Storage_Unit);
245 Tree_Read_Bool (Suppress_Checks);
246 Tree_Read_Bool (Try_Semantics);
247 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
248 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
249 Tree_Read_Bool (Upper_Half_Encoding);
250 Tree_Read_Bool (Force_ALI_Tree_File);
257 procedure Tree_Write is
258 Version_String : String := Gnat_Version_String;
261 Tree_Write_Int (ASIS_Version_Number);
262 Tree_Write_Bool (Brief_Output);
263 Tree_Write_Bool (GNAT_Mode);
264 Tree_Write_Char (Identifier_Character_Set);
265 Tree_Write_Int (Maximum_File_Name_Length);
266 Tree_Write_Data (Suppress_Options'Address,
267 (Suppress_Options'Size + SU - 1) / SU);
268 Tree_Write_Bool (Verbose_Mode);
269 Tree_Write_Data (Warning_Mode'Address,
270 (Warning_Mode'Size + SU - 1) / Storage_Unit);
271 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config));
272 Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
273 Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config));
274 Tree_Write_Bool (All_Errors_Mode);
275 Tree_Write_Bool (Assertions_Enabled);
276 Tree_Write_Int (Int (Check_Policy_List));
277 Tree_Write_Bool (Debug_Pragmas_Enabled);
278 Tree_Write_Bool (Enable_Overflow_Checks);
279 Tree_Write_Bool (Full_List);
280 Tree_Write_Int (Int (Version_String'Length));
281 Tree_Write_Data (Version_String'Address, Version_String'Length);
282 Tree_Write_Data (Distribution_Stub_Mode'Address,
283 (Distribution_Stub_Mode'Size + SU - 1) / SU);
284 Tree_Write_Bool (Inline_Active);
285 Tree_Write_Bool (Inline_Processing_Required);
286 Tree_Write_Bool (List_Units);
287 Tree_Write_Bool (Configurable_Run_Time_Mode);
288 Tree_Write_Data (Operating_Mode'Address,
289 (Operating_Mode'Size + SU - 1) / SU);
290 Tree_Write_Bool (Suppress_Checks);
291 Tree_Write_Bool (Try_Semantics);
292 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
293 (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
294 Tree_Write_Bool (Upper_Half_Encoding);
295 Tree_Write_Bool (Force_ALI_Tree_File);