1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2000, Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 with Ada.Exceptions; use Ada.Exceptions;
37 with Gnatvsn; use Gnatvsn;
38 with System; use System;
39 with Tree_IO; use Tree_IO;
43 Tree_Version_String : String (Gnat_Version_String'Range);
44 -- Used to store the compiler version string read from a tree file to
45 -- check if it is the same as stored in the version ctring in Gnatvsn.
46 -- Therefore its length is taken directly from the version string in
47 -- Gnatvsn. If the length of the version string stored in the three is
48 -- different, then versions are for sure different.
50 Immediate_Errors : Boolean := True;
51 -- This is an obsolete flag that is no longer present in opt.ads. We
52 -- retain it here because this flag was written to the tree and there
53 -- is no point in making trees incomaptible just for the sake of saving
54 -- one byte of data. The value written is ignored.
56 ----------------------------------
57 -- Register_Opt_Config_Switches --
58 ----------------------------------
60 procedure Register_Opt_Config_Switches is
62 Ada_83_Config := Ada_83;
63 Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
64 Extensions_Allowed_Config := Extensions_Allowed;
65 External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
66 External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
67 Polling_Required_Config := Polling_Required;
68 Use_VADS_Size_Config := Use_VADS_Size;
69 end Register_Opt_Config_Switches;
71 ---------------------------------
72 -- Restore_Opt_Config_Switches --
73 ---------------------------------
75 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
77 Ada_83 := Save.Ada_83;
79 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
80 Extensions_Allowed := Save.Extensions_Allowed;
81 External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
82 External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
83 Polling_Required := Save.Polling_Required;
84 Use_VADS_Size := Save.Use_VADS_Size;
85 end Restore_Opt_Config_Switches;
87 ------------------------------
88 -- Save_Opt_Config_Switches --
89 ------------------------------
91 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
93 Save.Ada_83 := Ada_83;
94 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
95 Save.Extensions_Allowed := Extensions_Allowed;
96 Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
97 Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
98 Save.Polling_Required := Polling_Required;
99 Save.Use_VADS_Size := Use_VADS_Size;
100 end Save_Opt_Config_Switches;
102 -----------------------------
103 -- Set_Opt_Config_Switches --
104 -----------------------------
106 procedure Set_Opt_Config_Switches (Internal_Unit : Boolean) is
108 if Internal_Unit then
111 Dynamic_Elaboration_Checks := False;
112 Extensions_Allowed := True;
113 External_Name_Exp_Casing := As_Is;
114 External_Name_Imp_Casing := Lowercase;
115 Use_VADS_Size := False;
118 Ada_83 := Ada_83_Config;
119 Ada_95 := not Ada_83_Config;
120 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
121 Extensions_Allowed := Extensions_Allowed_Config;
122 External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
123 External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
124 Use_VADS_Size := Use_VADS_Size_Config;
127 Polling_Required := Polling_Required_Config;
128 end Set_Opt_Config_Switches;
134 procedure Tree_Read is
135 Tree_Version_String_Len : Nat;
138 Tree_Read_Bool (Brief_Output);
139 Tree_Read_Bool (GNAT_Mode);
140 Tree_Read_Char (Identifier_Character_Set);
141 Tree_Read_Int (Maximum_File_Name_Length);
142 Tree_Read_Data (Suppress_Options'Address,
143 Suppress_Record'Object_Size / Storage_Unit);
144 Tree_Read_Bool (Verbose_Mode);
145 Tree_Read_Data (Warning_Mode'Address,
146 Warning_Mode_Type'Object_Size / Storage_Unit);
147 Tree_Read_Bool (Ada_83_Config);
148 Tree_Read_Bool (All_Errors_Mode);
149 Tree_Read_Bool (Assertions_Enabled);
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 (Software_Overflow_Checking);
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 (Full_List);
204 Tree_Write_Int (Int (Gnat_Version_String'Length));
205 Tree_Write_Data (Gnat_Version_String'Address,
206 Gnat_Version_String'Length);
207 Tree_Write_Data (Distribution_Stub_Mode'Address,
208 Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
209 Tree_Write_Bool (Immediate_Errors);
210 Tree_Write_Bool (Inline_Active);
211 Tree_Write_Bool (Inline_Processing_Required);
212 Tree_Write_Bool (List_Units);
213 Tree_Write_Bool (No_Run_Time);
214 Tree_Write_Data (Operating_Mode'Address,
215 Operating_Mode_Type'Object_Size / Storage_Unit);
216 Tree_Write_Bool (Software_Overflow_Checking);
217 Tree_Write_Bool (Try_Semantics);
218 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
219 WC_Encoding_Method'Object_Size / Storage_Unit);
220 Tree_Write_Bool (Upper_Half_Encoding);
221 Tree_Write_Bool (Force_ALI_Tree_File);