1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005, 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 System
; use System
;
35 with Tree_IO
; use Tree_IO
;
39 Immediate_Errors
: Boolean := True;
40 -- This is an obsolete flag that is no longer present in opt.ads. We
41 -- retain it here because this flag was written to the tree and there
42 -- is no point in making trees incomaptible just for the sake of saving
43 -- one byte of data. The value written is ignored.
45 ----------------------------------
46 -- Register_Opt_Config_Switches --
47 ----------------------------------
49 procedure Register_Opt_Config_Switches
is
51 Ada_Version_Config
:= Ada_Version
;
52 Ada_Version_Explicit_Config
:= Ada_Version_Explicit
;
53 Assertions_Enabled_Config
:= Assertions_Enabled
;
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 Persistent_BSS_Mode_Config
:= Persistent_BSS_Mode
;
61 Polling_Required_Config
:= Polling_Required
;
62 Use_VADS_Size_Config
:= Use_VADS_Size
;
63 end Register_Opt_Config_Switches
;
65 ---------------------------------
66 -- Restore_Opt_Config_Switches --
67 ---------------------------------
69 procedure Restore_Opt_Config_Switches
(Save
: Config_Switches_Type
) is
71 Ada_Version
:= Save
.Ada_Version
;
72 Ada_Version_Explicit
:= Save
.Ada_Version_Explicit
;
73 Assertions_Enabled
:= Save
.Assertions_Enabled
;
74 Debug_Pragmas_Enabled
:= Save
.Debug_Pragmas_Enabled
;
75 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
76 Exception_Locations_Suppressed
:= Save
.Exception_Locations_Suppressed
;
77 Extensions_Allowed
:= Save
.Extensions_Allowed
;
78 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
79 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
80 Persistent_BSS_Mode
:= Save
.Persistent_BSS_Mode
;
81 Polling_Required
:= Save
.Polling_Required
;
82 Use_VADS_Size
:= Save
.Use_VADS_Size
;
83 end Restore_Opt_Config_Switches
;
85 ------------------------------
86 -- Save_Opt_Config_Switches --
87 ------------------------------
89 procedure Save_Opt_Config_Switches
(Save
: out Config_Switches_Type
) is
91 Save
.Ada_Version
:= Ada_Version
;
92 Save
.Ada_Version_Explicit
:= Ada_Version_Explicit
;
93 Save
.Assertions_Enabled
:= Assertions_Enabled
;
94 Save
.Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled
;
95 Save
.Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks
;
96 Save
.Exception_Locations_Suppressed
:= Exception_Locations_Suppressed
;
97 Save
.Extensions_Allowed
:= Extensions_Allowed
;
98 Save
.External_Name_Exp_Casing
:= External_Name_Exp_Casing
;
99 Save
.External_Name_Imp_Casing
:= External_Name_Imp_Casing
;
100 Save
.Persistent_BSS_Mode
:= Persistent_BSS_Mode
;
101 Save
.Polling_Required
:= Polling_Required
;
102 Save
.Use_VADS_Size
:= Use_VADS_Size
;
103 end Save_Opt_Config_Switches
;
105 -----------------------------
106 -- Set_Opt_Config_Switches --
107 -----------------------------
109 procedure Set_Opt_Config_Switches
110 (Internal_Unit
: Boolean;
114 -- Case of internal unit
116 if Internal_Unit
then
117 Ada_Version
:= Ada_Version_Runtime
;
118 Dynamic_Elaboration_Checks
:= False;
119 Extensions_Allowed
:= True;
120 External_Name_Exp_Casing
:= As_Is
;
121 External_Name_Imp_Casing
:= Lowercase
;
122 Persistent_BSS_Mode
:= False;
123 Use_VADS_Size
:= False;
125 -- For an internal unit, assertions/debug pragmas are off unless this
126 -- is the main unit and they were explicitly enabled.
129 Assertions_Enabled
:= Assertions_Enabled_Config
;
130 Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled_Config
;
132 Assertions_Enabled
:= False;
133 Debug_Pragmas_Enabled
:= False;
136 -- Case of non-internal unit
139 Ada_Version
:= Ada_Version_Config
;
140 Assertions_Enabled
:= Assertions_Enabled_Config
;
141 Debug_Pragmas_Enabled
:= Debug_Pragmas_Enabled_Config
;
142 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
143 Extensions_Allowed
:= Extensions_Allowed_Config
;
144 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
145 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
146 Persistent_BSS_Mode
:= Persistent_BSS_Mode_Config
;
147 Use_VADS_Size
:= Use_VADS_Size_Config
;
150 Exception_Locations_Suppressed
:= Exception_Locations_Suppressed_Config
;
151 Polling_Required
:= Polling_Required_Config
;
152 Ada_Version_Explicit
:= Ada_Version_Explicit_Config
;
153 end Set_Opt_Config_Switches
;
159 procedure Tree_Read
is
160 Tree_Version_String_Len
: Nat
;
161 Ada_Version_Config_Val
: Nat
;
162 Ada_Version_Explicit_Config_Val
: Nat
;
163 Assertions_Enabled_Config_Val
: Nat
;
166 Tree_Read_Int
(Tree_ASIS_Version_Number
);
167 Tree_Read_Bool
(Brief_Output
);
168 Tree_Read_Bool
(GNAT_Mode
);
169 Tree_Read_Char
(Identifier_Character_Set
);
170 Tree_Read_Int
(Maximum_File_Name_Length
);
171 Tree_Read_Data
(Suppress_Options
'Address,
172 Suppress_Array
'Object_Size / Storage_Unit
);
173 Tree_Read_Bool
(Verbose_Mode
);
174 Tree_Read_Data
(Warning_Mode
'Address,
175 Warning_Mode_Type
'Object_Size / Storage_Unit
);
176 Tree_Read_Int
(Ada_Version_Config_Val
);
177 Tree_Read_Int
(Ada_Version_Explicit_Config_Val
);
178 Tree_Read_Int
(Assertions_Enabled_Config_Val
);
179 Tree_Read_Bool
(All_Errors_Mode
);
180 Tree_Read_Bool
(Assertions_Enabled
);
181 Tree_Read_Bool
(Debug_Pragmas_Enabled
);
182 Tree_Read_Bool
(Enable_Overflow_Checks
);
183 Tree_Read_Bool
(Full_List
);
185 Ada_Version_Config
:=
186 Ada_Version_Type
'Val (Ada_Version_Config_Val
);
187 Ada_Version_Explicit_Config
:=
188 Ada_Version_Type
'Val (Ada_Version_Explicit_Config_Val
);
189 Assertions_Enabled_Config
:=
190 Boolean'Val (Assertions_Enabled_Config_Val
);
192 -- Read version string: we have to check the length first
194 Tree_Read_Int
(Tree_Version_String_Len
);
196 if Tree_Version_String_Len
= Tree_Version_String
'Length then
198 (Tree_Version_String
'Address, Tree_Version_String_Len
);
200 Tree_Version_String
:= (others => '?');
203 Tmp
: String (1 .. Integer (Tree_Version_String_Len
));
206 (Tmp
'Address, Tree_Version_String_Len
);
211 Tree_Read_Data
(Distribution_Stub_Mode
'Address,
212 Distribution_Stub_Mode_Type
'Object_Size / Storage_Unit
);
213 Tree_Read_Bool
(Immediate_Errors
);
214 Tree_Read_Bool
(Inline_Active
);
215 Tree_Read_Bool
(Inline_Processing_Required
);
216 Tree_Read_Bool
(List_Units
);
217 Tree_Read_Bool
(Configurable_Run_Time_Mode
);
218 Tree_Read_Data
(Operating_Mode
'Address,
219 Operating_Mode_Type
'Object_Size / Storage_Unit
);
220 Tree_Read_Bool
(Suppress_Checks
);
221 Tree_Read_Bool
(Try_Semantics
);
222 Tree_Read_Data
(Wide_Character_Encoding_Method
'Address,
223 WC_Encoding_Method
'Object_Size / Storage_Unit
);
224 Tree_Read_Bool
(Upper_Half_Encoding
);
225 Tree_Read_Bool
(Force_ALI_Tree_File
);
232 procedure Tree_Write
is
233 Version_String
: String := Gnat_Version_String
;
235 Tree_Write_Int
(ASIS_Version_Number
);
236 Tree_Write_Bool
(Brief_Output
);
237 Tree_Write_Bool
(GNAT_Mode
);
238 Tree_Write_Char
(Identifier_Character_Set
);
239 Tree_Write_Int
(Maximum_File_Name_Length
);
240 Tree_Write_Data
(Suppress_Options
'Address,
241 Suppress_Array
'Object_Size / Storage_Unit
);
242 Tree_Write_Bool
(Verbose_Mode
);
243 Tree_Write_Data
(Warning_Mode
'Address,
244 Warning_Mode_Type
'Object_Size / Storage_Unit
);
245 Tree_Write_Int
(Ada_Version_Type
'Pos (Ada_Version_Config
));
246 Tree_Write_Int
(Ada_Version_Type
'Pos (Ada_Version_Explicit_Config
));
247 Tree_Write_Int
(Boolean'Pos (Assertions_Enabled_Config
));
248 Tree_Write_Bool
(All_Errors_Mode
);
249 Tree_Write_Bool
(Assertions_Enabled
);
250 Tree_Write_Bool
(Debug_Pragmas_Enabled
);
251 Tree_Write_Bool
(Enable_Overflow_Checks
);
252 Tree_Write_Bool
(Full_List
);
253 Tree_Write_Int
(Int
(Version_String
'Length));
254 Tree_Write_Data
(Version_String
'Address,
255 Version_String
'Length);
256 Tree_Write_Data
(Distribution_Stub_Mode
'Address,
257 Distribution_Stub_Mode_Type
'Object_Size / Storage_Unit
);
258 Tree_Write_Bool
(Immediate_Errors
);
259 Tree_Write_Bool
(Inline_Active
);
260 Tree_Write_Bool
(Inline_Processing_Required
);
261 Tree_Write_Bool
(List_Units
);
262 Tree_Write_Bool
(Configurable_Run_Time_Mode
);
263 Tree_Write_Data
(Operating_Mode
'Address,
264 Operating_Mode_Type
'Object_Size / Storage_Unit
);
265 Tree_Write_Bool
(Suppress_Checks
);
266 Tree_Write_Bool
(Try_Semantics
);
267 Tree_Write_Data
(Wide_Character_Encoding_Method
'Address,
268 WC_Encoding_Method
'Object_Size / Storage_Unit
);
269 Tree_Write_Bool
(Upper_Half_Encoding
);
270 Tree_Write_Bool
(Force_ALI_Tree_File
);