1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003, 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 Immediate_Errors : Boolean := True;
41 -- This is an obsolete flag that is no longer present in opt.ads. We
42 -- retain it here because this flag was written to the tree and there
43 -- is no point in making trees incomaptible just for the sake of saving
44 -- one byte of data. The value written is ignored.
46 ----------------------------------
47 -- Register_Opt_Config_Switches --
48 ----------------------------------
50 procedure Register_Opt_Config_Switches is
52 Ada_83_Config := Ada_83;
53 Dynamic_Elaboration_Checks_Config := Dynamic_Elaboration_Checks;
54 Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
55 Extensions_Allowed_Config := Extensions_Allowed;
56 External_Name_Exp_Casing_Config := External_Name_Exp_Casing;
57 External_Name_Imp_Casing_Config := External_Name_Imp_Casing;
58 Polling_Required_Config := Polling_Required;
59 Use_VADS_Size_Config := Use_VADS_Size;
60 end Register_Opt_Config_Switches;
62 ---------------------------------
63 -- Restore_Opt_Config_Switches --
64 ---------------------------------
66 procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
68 Ada_83 := Save.Ada_83;
70 Dynamic_Elaboration_Checks := Save.Dynamic_Elaboration_Checks;
71 Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
72 Extensions_Allowed := Save.Extensions_Allowed;
73 External_Name_Exp_Casing := Save.External_Name_Exp_Casing;
74 External_Name_Imp_Casing := Save.External_Name_Imp_Casing;
75 Polling_Required := Save.Polling_Required;
76 Use_VADS_Size := Save.Use_VADS_Size;
77 end Restore_Opt_Config_Switches;
79 ------------------------------
80 -- Save_Opt_Config_Switches --
81 ------------------------------
83 procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
85 Save.Ada_83 := Ada_83;
86 Save.Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks;
87 Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
88 Save.Extensions_Allowed := Extensions_Allowed;
89 Save.External_Name_Exp_Casing := External_Name_Exp_Casing;
90 Save.External_Name_Imp_Casing := External_Name_Imp_Casing;
91 Save.Polling_Required := Polling_Required;
92 Save.Use_VADS_Size := Use_VADS_Size;
93 end Save_Opt_Config_Switches;
95 -----------------------------
96 -- Set_Opt_Config_Switches --
97 -----------------------------
99 procedure Set_Opt_Config_Switches (Internal_Unit : Boolean) is
101 if Internal_Unit then
104 Dynamic_Elaboration_Checks := False;
105 Extensions_Allowed := True;
106 External_Name_Exp_Casing := As_Is;
107 External_Name_Imp_Casing := Lowercase;
108 Use_VADS_Size := False;
111 Ada_83 := Ada_83_Config;
112 Ada_95 := not Ada_83_Config;
113 Dynamic_Elaboration_Checks := Dynamic_Elaboration_Checks_Config;
114 Extensions_Allowed := Extensions_Allowed_Config;
115 External_Name_Exp_Casing := External_Name_Exp_Casing_Config;
116 External_Name_Imp_Casing := External_Name_Imp_Casing_Config;
117 Use_VADS_Size := Use_VADS_Size_Config;
120 Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
121 Polling_Required := Polling_Required_Config;
122 end Set_Opt_Config_Switches;
128 procedure Tree_Read is
129 Tree_Version_String_Len : Nat;
132 Tree_Read_Int (Tree_ASIS_Version_Number);
133 Tree_Read_Bool (Brief_Output);
134 Tree_Read_Bool (GNAT_Mode);
135 Tree_Read_Char (Identifier_Character_Set);
136 Tree_Read_Int (Maximum_File_Name_Length);
137 Tree_Read_Data (Suppress_Options'Address,
138 Suppress_Array'Object_Size / Storage_Unit);
139 Tree_Read_Bool (Verbose_Mode);
140 Tree_Read_Data (Warning_Mode'Address,
141 Warning_Mode_Type'Object_Size / Storage_Unit);
142 Tree_Read_Bool (Ada_83_Config);
143 Tree_Read_Bool (All_Errors_Mode);
144 Tree_Read_Bool (Assertions_Enabled);
145 Tree_Read_Bool (Enable_Overflow_Checks);
146 Tree_Read_Bool (Full_List);
148 -- Read version string: we have to check the length first
150 Tree_Read_Int (Tree_Version_String_Len);
152 if Tree_Version_String_Len = Tree_Version_String'Length then
154 (Tree_Version_String'Address, Tree_Version_String_Len);
156 Tree_Version_String := (others => '?');
159 Tmp : String (1 .. Integer (Tree_Version_String_Len));
162 (Tmp'Address, Tree_Version_String_Len);
167 Tree_Read_Data (Distribution_Stub_Mode'Address,
168 Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
169 Tree_Read_Bool (Immediate_Errors);
170 Tree_Read_Bool (Inline_Active);
171 Tree_Read_Bool (Inline_Processing_Required);
172 Tree_Read_Bool (List_Units);
173 Tree_Read_Bool (Configurable_Run_Time_Mode);
174 Tree_Read_Data (Operating_Mode'Address,
175 Operating_Mode_Type'Object_Size / Storage_Unit);
176 Tree_Read_Bool (Suppress_Checks);
177 Tree_Read_Bool (Try_Semantics);
178 Tree_Read_Data (Wide_Character_Encoding_Method'Address,
179 WC_Encoding_Method'Object_Size / Storage_Unit);
180 Tree_Read_Bool (Upper_Half_Encoding);
181 Tree_Read_Bool (Force_ALI_Tree_File);
188 procedure Tree_Write is
189 Version_String : String := Gnat_Version_String;
191 Tree_Write_Int (ASIS_Version_Number);
192 Tree_Write_Bool (Brief_Output);
193 Tree_Write_Bool (GNAT_Mode);
194 Tree_Write_Char (Identifier_Character_Set);
195 Tree_Write_Int (Maximum_File_Name_Length);
196 Tree_Write_Data (Suppress_Options'Address,
197 Suppress_Array'Object_Size / Storage_Unit);
198 Tree_Write_Bool (Verbose_Mode);
199 Tree_Write_Data (Warning_Mode'Address,
200 Warning_Mode_Type'Object_Size / Storage_Unit);
201 Tree_Write_Bool (Ada_83_Config);
202 Tree_Write_Bool (All_Errors_Mode);
203 Tree_Write_Bool (Assertions_Enabled);
204 Tree_Write_Bool (Enable_Overflow_Checks);
205 Tree_Write_Bool (Full_List);
206 Tree_Write_Int (Int (Version_String'Length));
207 Tree_Write_Data (Version_String'Address,
208 Version_String'Length);
209 Tree_Write_Data (Distribution_Stub_Mode'Address,
210 Distribution_Stub_Mode_Type'Object_Size / Storage_Unit);
211 Tree_Write_Bool (Immediate_Errors);
212 Tree_Write_Bool (Inline_Active);
213 Tree_Write_Bool (Inline_Processing_Required);
214 Tree_Write_Bool (List_Units);
215 Tree_Write_Bool (Configurable_Run_Time_Mode);
216 Tree_Write_Data (Operating_Mode'Address,
217 Operating_Mode_Type'Object_Size / Storage_Unit);
218 Tree_Write_Bool (Suppress_Checks);
219 Tree_Write_Bool (Try_Semantics);
220 Tree_Write_Data (Wide_Character_Encoding_Method'Address,
221 WC_Encoding_Method'Object_Size / Storage_Unit);
222 Tree_Write_Bool (Upper_Half_Encoding);
223 Tree_Write_Bool (Force_ALI_Tree_File);