1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Ada
.Exceptions
; use Ada
.Exceptions
;
36 with Gnatvsn
; use Gnatvsn
;
37 with System
; use System
;
38 with Tree_IO
; use Tree_IO
;
42 Tree_Version_String
: String (Gnat_Version_String
'Range);
43 -- Used to store the compiler version string read from a tree file to
44 -- check if it is the same as stored in the version ctring in Gnatvsn.
45 -- Therefore its length is taken directly from the version string in
46 -- Gnatvsn. If the length of the version string stored in the three is
47 -- different, then versions are for sure different.
49 Immediate_Errors
: Boolean := True;
50 -- This is an obsolete flag that is no longer present in opt.ads. We
51 -- retain it here because this flag was written to the tree and there
52 -- is no point in making trees incomaptible just for the sake of saving
53 -- one byte of data. The value written is ignored.
55 ----------------------------------
56 -- Register_Opt_Config_Switches --
57 ----------------------------------
59 procedure Register_Opt_Config_Switches
is
61 Ada_83_Config
:= Ada_83
;
62 Dynamic_Elaboration_Checks_Config
:= Dynamic_Elaboration_Checks
;
63 Extensions_Allowed_Config
:= Extensions_Allowed
;
64 External_Name_Exp_Casing_Config
:= External_Name_Exp_Casing
;
65 External_Name_Imp_Casing_Config
:= External_Name_Imp_Casing
;
66 Polling_Required_Config
:= Polling_Required
;
67 Use_VADS_Size_Config
:= Use_VADS_Size
;
68 end Register_Opt_Config_Switches
;
70 ---------------------------------
71 -- Restore_Opt_Config_Switches --
72 ---------------------------------
74 procedure Restore_Opt_Config_Switches
(Save
: Config_Switches_Type
) is
76 Ada_83
:= Save
.Ada_83
;
78 Dynamic_Elaboration_Checks
:= Save
.Dynamic_Elaboration_Checks
;
79 Extensions_Allowed
:= Save
.Extensions_Allowed
;
80 External_Name_Exp_Casing
:= Save
.External_Name_Exp_Casing
;
81 External_Name_Imp_Casing
:= Save
.External_Name_Imp_Casing
;
82 Polling_Required
:= Save
.Polling_Required
;
83 Use_VADS_Size
:= Save
.Use_VADS_Size
;
84 end Restore_Opt_Config_Switches
;
86 ------------------------------
87 -- Save_Opt_Config_Switches --
88 ------------------------------
90 procedure Save_Opt_Config_Switches
(Save
: out Config_Switches_Type
) is
92 Save
.Ada_83
:= Ada_83
;
93 Save
.Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks
;
94 Save
.Extensions_Allowed
:= Extensions_Allowed
;
95 Save
.External_Name_Exp_Casing
:= External_Name_Exp_Casing
;
96 Save
.External_Name_Imp_Casing
:= External_Name_Imp_Casing
;
97 Save
.Polling_Required
:= Polling_Required
;
98 Save
.Use_VADS_Size
:= Use_VADS_Size
;
99 end Save_Opt_Config_Switches
;
101 -----------------------------
102 -- Set_Opt_Config_Switches --
103 -----------------------------
105 procedure Set_Opt_Config_Switches
(Internal_Unit
: Boolean) is
107 if Internal_Unit
then
110 Dynamic_Elaboration_Checks
:= False;
111 Extensions_Allowed
:= True;
112 External_Name_Exp_Casing
:= As_Is
;
113 External_Name_Imp_Casing
:= Lowercase
;
114 Use_VADS_Size
:= False;
117 Ada_83
:= Ada_83_Config
;
118 Ada_95
:= not Ada_83_Config
;
119 Dynamic_Elaboration_Checks
:= Dynamic_Elaboration_Checks_Config
;
120 Extensions_Allowed
:= Extensions_Allowed_Config
;
121 External_Name_Exp_Casing
:= External_Name_Exp_Casing_Config
;
122 External_Name_Imp_Casing
:= External_Name_Imp_Casing_Config
;
123 Use_VADS_Size
:= Use_VADS_Size_Config
;
126 Polling_Required
:= Polling_Required_Config
;
127 end Set_Opt_Config_Switches
;
133 procedure Tree_Read
is
134 Tree_Version_String_Len
: Nat
;
137 Tree_Read_Bool
(Brief_Output
);
138 Tree_Read_Bool
(GNAT_Mode
);
139 Tree_Read_Char
(Identifier_Character_Set
);
140 Tree_Read_Int
(Maximum_File_Name_Length
);
141 Tree_Read_Data
(Suppress_Options
'Address,
142 Suppress_Record
'Object_Size / Storage_Unit
);
143 Tree_Read_Bool
(Verbose_Mode
);
144 Tree_Read_Data
(Warning_Mode
'Address,
145 Warning_Mode_Type
'Object_Size / Storage_Unit
);
146 Tree_Read_Bool
(Ada_83_Config
);
147 Tree_Read_Bool
(All_Errors_Mode
);
148 Tree_Read_Bool
(Assertions_Enabled
);
149 Tree_Read_Bool
(Enable_Overflow_Checks
);
150 Tree_Read_Bool
(Full_List
);
152 -- Read and check version string
154 Tree_Read_Int
(Tree_Version_String_Len
);
156 if Tree_Version_String_Len
= Tree_Version_String
'Length then
158 (Tree_Version_String
'Address, Tree_Version_String
'Length);
161 if Tree_Version_String_Len
/= Tree_Version_String
'Length
162 or else Tree_Version_String
/= Gnat_Version_String
165 (Program_Error
'Identity, "Inconsistent versions of GNAT and ASIS");
168 Tree_Read_Data
(Distribution_Stub_Mode
'Address,
169 Distribution_Stub_Mode_Type
'Object_Size / Storage_Unit
);
170 Tree_Read_Bool
(Immediate_Errors
);
171 Tree_Read_Bool
(Inline_Active
);
172 Tree_Read_Bool
(Inline_Processing_Required
);
173 Tree_Read_Bool
(List_Units
);
174 Tree_Read_Bool
(No_Run_Time
);
175 Tree_Read_Data
(Operating_Mode
'Address,
176 Operating_Mode_Type
'Object_Size / Storage_Unit
);
177 Tree_Read_Bool
(Suppress_Checks
);
178 Tree_Read_Bool
(Try_Semantics
);
179 Tree_Read_Data
(Wide_Character_Encoding_Method
'Address,
180 WC_Encoding_Method
'Object_Size / Storage_Unit
);
181 Tree_Read_Bool
(Upper_Half_Encoding
);
182 Tree_Read_Bool
(Force_ALI_Tree_File
);
189 procedure Tree_Write
is
191 Tree_Write_Bool
(Brief_Output
);
192 Tree_Write_Bool
(GNAT_Mode
);
193 Tree_Write_Char
(Identifier_Character_Set
);
194 Tree_Write_Int
(Maximum_File_Name_Length
);
195 Tree_Write_Data
(Suppress_Options
'Address,
196 Suppress_Record
'Object_Size / Storage_Unit
);
197 Tree_Write_Bool
(Verbose_Mode
);
198 Tree_Write_Data
(Warning_Mode
'Address,
199 Warning_Mode_Type
'Object_Size / Storage_Unit
);
200 Tree_Write_Bool
(Ada_83_Config
);
201 Tree_Write_Bool
(All_Errors_Mode
);
202 Tree_Write_Bool
(Assertions_Enabled
);
203 Tree_Write_Bool
(Enable_Overflow_Checks
);
204 Tree_Write_Bool
(Full_List
);
205 Tree_Write_Int
(Int
(Gnat_Version_String
'Length));
206 Tree_Write_Data
(Gnat_Version_String
'Address,
207 Gnat_Version_String
'Length);
208 Tree_Write_Data
(Distribution_Stub_Mode
'Address,
209 Distribution_Stub_Mode_Type
'Object_Size / Storage_Unit
);
210 Tree_Write_Bool
(Immediate_Errors
);
211 Tree_Write_Bool
(Inline_Active
);
212 Tree_Write_Bool
(Inline_Processing_Required
);
213 Tree_Write_Bool
(List_Units
);
214 Tree_Write_Bool
(No_Run_Time
);
215 Tree_Write_Data
(Operating_Mode
'Address,
216 Operating_Mode_Type
'Object_Size / Storage_Unit
);
217 Tree_Write_Bool
(Suppress_Checks
);
218 Tree_Write_Bool
(Try_Semantics
);
219 Tree_Write_Data
(Wide_Character_Encoding_Method
'Address,
220 WC_Encoding_Method
'Object_Size / Storage_Unit
);
221 Tree_Write_Bool
(Upper_Half_Encoding
);
222 Tree_Write_Bool
(Force_ALI_Tree_File
);