OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [opt.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                                  O P T                                   --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
10
--                                                                          --
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 3,  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.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with Gnatvsn; use Gnatvsn;
33
with System;  use System;
34
with Tree_IO; use Tree_IO;
35
 
36
package body Opt is
37
 
38
   SU : constant := Storage_Unit;
39
   --  Shorthand for System.Storage_Unit
40
 
41
   --------------------------
42
   -- Full_Expander_Active --
43
   --------------------------
44
 
45
   function Full_Expander_Active return Boolean is
46
   begin
47
      return Expander_Active and not Alfa_Mode;
48
   end Full_Expander_Active;
49
 
50
   ----------------------------------
51
   -- Register_Opt_Config_Switches --
52
   ----------------------------------
53
 
54
   procedure Register_Opt_Config_Switches is
55
   begin
56
      Ada_Version_Config                    := Ada_Version;
57
      Ada_Version_Explicit_Config           := Ada_Version_Explicit;
58
      Assertions_Enabled_Config             := Assertions_Enabled;
59
      Assume_No_Invalid_Values_Config       := Assume_No_Invalid_Values;
60
      Check_Policy_List_Config              := Check_Policy_List;
61
      Debug_Pragmas_Disabled_Config         := Debug_Pragmas_Disabled;
62
      Debug_Pragmas_Enabled_Config          := Debug_Pragmas_Enabled;
63
      Default_Pool_Config                   := Default_Pool;
64
      Dynamic_Elaboration_Checks_Config     := Dynamic_Elaboration_Checks;
65
      Exception_Locations_Suppressed_Config := Exception_Locations_Suppressed;
66
      Extensions_Allowed_Config             := Extensions_Allowed;
67
      External_Name_Exp_Casing_Config       := External_Name_Exp_Casing;
68
      External_Name_Imp_Casing_Config       := External_Name_Imp_Casing;
69
      Fast_Math_Config                      := Fast_Math;
70
      Initialize_Scalars_Config             := Initialize_Scalars;
71
      Optimize_Alignment_Config             := Optimize_Alignment;
72
      Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
73
      Polling_Required_Config               := Polling_Required;
74
      Short_Descriptors_Config              := Short_Descriptors;
75
      Use_VADS_Size_Config                  := Use_VADS_Size;
76
 
77
      --  Reset the indication that Optimize_Alignment was set locally, since
78
      --  if we had a pragma in the config file, it would set this flag True,
79
      --  but that's not a local setting.
80
 
81
      Optimize_Alignment_Local := False;
82
   end Register_Opt_Config_Switches;
83
 
84
   ---------------------------------
85
   -- Restore_Opt_Config_Switches --
86
   ---------------------------------
87
 
88
   procedure Restore_Opt_Config_Switches (Save : Config_Switches_Type) is
89
   begin
90
      Ada_Version                    := Save.Ada_Version;
91
      Ada_Version_Explicit           := Save.Ada_Version_Explicit;
92
      Assertions_Enabled             := Save.Assertions_Enabled;
93
      Assume_No_Invalid_Values       := Save.Assume_No_Invalid_Values;
94
      Check_Policy_List              := Save.Check_Policy_List;
95
      Debug_Pragmas_Disabled         := Save.Debug_Pragmas_Disabled;
96
      Debug_Pragmas_Enabled          := Save.Debug_Pragmas_Enabled;
97
      Default_Pool                   := Save.Default_Pool;
98
      Dynamic_Elaboration_Checks     := Save.Dynamic_Elaboration_Checks;
99
      Exception_Locations_Suppressed := Save.Exception_Locations_Suppressed;
100
      Extensions_Allowed             := Save.Extensions_Allowed;
101
      External_Name_Exp_Casing       := Save.External_Name_Exp_Casing;
102
      External_Name_Imp_Casing       := Save.External_Name_Imp_Casing;
103
      Fast_Math                      := Save.Fast_Math;
104
      Initialize_Scalars             := Save.Initialize_Scalars;
105
      Optimize_Alignment             := Save.Optimize_Alignment;
106
      Optimize_Alignment_Local       := Save.Optimize_Alignment_Local;
107
      Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
108
      Polling_Required               := Save.Polling_Required;
109
      Short_Descriptors              := Save.Short_Descriptors;
110
      Use_VADS_Size                  := Save.Use_VADS_Size;
111
 
112
      --  Update consistently the value of Init_Or_Norm_Scalars. The value of
113
      --  Normalize_Scalars is not saved/restored because after set to True its
114
      --  value is never changed. That is, if a compilation unit has pragma
115
      --  Normalize_Scalars then it forces that value for all with'ed units.
116
 
117
      Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
118
   end Restore_Opt_Config_Switches;
119
 
120
   ------------------------------
121
   -- Save_Opt_Config_Switches --
122
   ------------------------------
123
 
124
   procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type) is
125
   begin
126
      Save.Ada_Version                    := Ada_Version;
127
      Save.Ada_Version_Explicit           := Ada_Version_Explicit;
128
      Save.Assertions_Enabled             := Assertions_Enabled;
129
      Save.Assume_No_Invalid_Values       := Assume_No_Invalid_Values;
130
      Save.Check_Policy_List              := Check_Policy_List;
131
      Save.Debug_Pragmas_Disabled         := Debug_Pragmas_Disabled;
132
      Save.Debug_Pragmas_Enabled          := Debug_Pragmas_Enabled;
133
      Save.Default_Pool                   := Default_Pool;
134
      Save.Dynamic_Elaboration_Checks     := Dynamic_Elaboration_Checks;
135
      Save.Exception_Locations_Suppressed := Exception_Locations_Suppressed;
136
      Save.Extensions_Allowed             := Extensions_Allowed;
137
      Save.External_Name_Exp_Casing       := External_Name_Exp_Casing;
138
      Save.External_Name_Imp_Casing       := External_Name_Imp_Casing;
139
      Save.Fast_Math                      := Fast_Math;
140
      Save.Initialize_Scalars             := Initialize_Scalars;
141
      Save.Optimize_Alignment             := Optimize_Alignment;
142
      Save.Optimize_Alignment_Local       := Optimize_Alignment_Local;
143
      Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
144
      Save.Polling_Required               := Polling_Required;
145
      Save.Short_Descriptors              := Short_Descriptors;
146
      Save.Use_VADS_Size                  := Use_VADS_Size;
147
   end Save_Opt_Config_Switches;
148
 
149
   -----------------------------
150
   -- Set_Opt_Config_Switches --
151
   -----------------------------
152
 
153
   procedure Set_Opt_Config_Switches
154
     (Internal_Unit : Boolean;
155
      Main_Unit     : Boolean)
156
   is
157
   begin
158
      --  Case of internal unit
159
 
160
      if Internal_Unit then
161
 
162
         --  Set standard switches. Note we do NOT set Ada_Version_Explicit
163
         --  since the whole point of this is that it still properly indicates
164
         --  the configuration setting even in a run time unit.
165
 
166
         Ada_Version                 := Ada_Version_Runtime;
167
         Dynamic_Elaboration_Checks  := False;
168
         Extensions_Allowed          := True;
169
         External_Name_Exp_Casing    := As_Is;
170
         External_Name_Imp_Casing    := Lowercase;
171
         Optimize_Alignment          := 'O';
172
         Persistent_BSS_Mode         := False;
173
         Use_VADS_Size               := False;
174
         Optimize_Alignment_Local    := True;
175
 
176
         --  For an internal unit, assertions/debug pragmas are off unless this
177
         --  is the main unit and they were explicitly enabled. We also make
178
         --  sure we do not assume that values are necessarily valid.
179
 
180
         if Main_Unit then
181
            Assertions_Enabled       := Assertions_Enabled_Config;
182
            Assume_No_Invalid_Values := Assume_No_Invalid_Values_Config;
183
            Debug_Pragmas_Disabled   := Debug_Pragmas_Disabled_Config;
184
            Debug_Pragmas_Enabled    := Debug_Pragmas_Enabled_Config;
185
            Check_Policy_List        := Check_Policy_List_Config;
186
         else
187
            Assertions_Enabled       := False;
188
            Assume_No_Invalid_Values := False;
189
            Debug_Pragmas_Disabled   := False;
190
            Debug_Pragmas_Enabled    := False;
191
            Check_Policy_List        := Empty;
192
         end if;
193
 
194
      --  Case of non-internal unit
195
 
196
      else
197
         Ada_Version                 := Ada_Version_Config;
198
         Ada_Version_Explicit        := Ada_Version_Explicit_Config;
199
         Assertions_Enabled          := Assertions_Enabled_Config;
200
         Assume_No_Invalid_Values    := Assume_No_Invalid_Values_Config;
201
         Check_Policy_List           := Check_Policy_List_Config;
202
         Debug_Pragmas_Disabled      := Debug_Pragmas_Disabled_Config;
203
         Debug_Pragmas_Enabled       := Debug_Pragmas_Enabled_Config;
204
         Dynamic_Elaboration_Checks  := Dynamic_Elaboration_Checks_Config;
205
         Extensions_Allowed          := Extensions_Allowed_Config;
206
         External_Name_Exp_Casing    := External_Name_Exp_Casing_Config;
207
         External_Name_Imp_Casing    := External_Name_Imp_Casing_Config;
208
         Fast_Math                   := Fast_Math_Config;
209
         Initialize_Scalars          := Initialize_Scalars_Config;
210
         Optimize_Alignment          := Optimize_Alignment_Config;
211
         Optimize_Alignment_Local    := False;
212
         Persistent_BSS_Mode         := Persistent_BSS_Mode_Config;
213
         Use_VADS_Size               := Use_VADS_Size_Config;
214
 
215
         --  Update consistently the value of Init_Or_Norm_Scalars. The value
216
         --  of Normalize_Scalars is not saved/restored because once set to
217
         --  True its value is never changed. That is, if a compilation unit
218
         --  has pragma Normalize_Scalars then it forces that value for all
219
         --  with'ed units.
220
 
221
         Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
222
      end if;
223
 
224
      Default_Pool                   := Default_Pool_Config;
225
      Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
226
      Fast_Math                      := Fast_Math_Config;
227
      Optimize_Alignment             := Optimize_Alignment_Config;
228
      Polling_Required               := Polling_Required_Config;
229
      Short_Descriptors              := Short_Descriptors_Config;
230
   end Set_Opt_Config_Switches;
231
 
232
   ---------------
233
   -- Tree_Read --
234
   ---------------
235
 
236
   procedure Tree_Read is
237
      Tree_Version_String_Len         : Nat;
238
      Ada_Version_Config_Val          : Nat;
239
      Ada_Version_Explicit_Config_Val : Nat;
240
      Assertions_Enabled_Config_Val   : Nat;
241
 
242
   begin
243
      Tree_Read_Int  (Tree_ASIS_Version_Number);
244
      Tree_Read_Bool (Brief_Output);
245
      Tree_Read_Bool (GNAT_Mode);
246
      Tree_Read_Char (Identifier_Character_Set);
247
      Tree_Read_Int  (Maximum_File_Name_Length);
248
      Tree_Read_Data (Suppress_Options'Address,
249
                      (Suppress_Options'Size + SU - 1) / SU);
250
      Tree_Read_Bool (Verbose_Mode);
251
      Tree_Read_Data (Warning_Mode'Address,
252
                      (Warning_Mode'Size + SU - 1) / SU);
253
      Tree_Read_Int  (Ada_Version_Config_Val);
254
      Tree_Read_Int  (Ada_Version_Explicit_Config_Val);
255
      Tree_Read_Int  (Assertions_Enabled_Config_Val);
256
      Tree_Read_Bool (All_Errors_Mode);
257
      Tree_Read_Bool (Assertions_Enabled);
258
      Tree_Read_Int  (Int (Check_Policy_List));
259
      Tree_Read_Bool (Debug_Pragmas_Disabled);
260
      Tree_Read_Bool (Debug_Pragmas_Enabled);
261
      Tree_Read_Int  (Int (Default_Pool));
262
      Tree_Read_Bool (Enable_Overflow_Checks);
263
      Tree_Read_Bool (Full_List);
264
 
265
      Ada_Version_Config :=
266
        Ada_Version_Type'Val (Ada_Version_Config_Val);
267
      Ada_Version_Explicit_Config :=
268
        Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val);
269
      Assertions_Enabled_Config :=
270
        Boolean'Val (Assertions_Enabled_Config_Val);
271
 
272
      --  Read version string: we have to get the length first
273
 
274
      Tree_Read_Int (Tree_Version_String_Len);
275
 
276
      declare
277
         Tmp : String (1 .. Integer (Tree_Version_String_Len));
278
      begin
279
         Tree_Read_Data
280
           (Tmp'Address, Tree_Version_String_Len);
281
         System.Strings.Free (Tree_Version_String);
282
         Free (Tree_Version_String);
283
         Tree_Version_String := new String'(Tmp);
284
      end;
285
 
286
      Tree_Read_Data (Distribution_Stub_Mode'Address,
287
                      (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit);
288
      Tree_Read_Bool (Inline_Active);
289
      Tree_Read_Bool (Inline_Processing_Required);
290
      Tree_Read_Bool (List_Units);
291
      Tree_Read_Bool (Configurable_Run_Time_Mode);
292
      Tree_Read_Data (Operating_Mode'Address,
293
                      (Operating_Mode'Size + SU - 1) / Storage_Unit);
294
      Tree_Read_Bool (Suppress_Checks);
295
      Tree_Read_Bool (Try_Semantics);
296
      Tree_Read_Data (Wide_Character_Encoding_Method'Address,
297
                      (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
298
      Tree_Read_Bool (Upper_Half_Encoding);
299
      Tree_Read_Bool (Force_ALI_Tree_File);
300
   end Tree_Read;
301
 
302
   ----------------
303
   -- Tree_Write --
304
   ----------------
305
 
306
   procedure Tree_Write is
307
      Version_String : String := Gnat_Version_String;
308
 
309
   begin
310
      Tree_Write_Int  (ASIS_Version_Number);
311
      Tree_Write_Bool (Brief_Output);
312
      Tree_Write_Bool (GNAT_Mode);
313
      Tree_Write_Char (Identifier_Character_Set);
314
      Tree_Write_Int  (Maximum_File_Name_Length);
315
      Tree_Write_Data (Suppress_Options'Address,
316
                       (Suppress_Options'Size + SU - 1) / SU);
317
      Tree_Write_Bool (Verbose_Mode);
318
      Tree_Write_Data (Warning_Mode'Address,
319
                       (Warning_Mode'Size + SU - 1) / Storage_Unit);
320
      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Config));
321
      Tree_Write_Int  (Ada_Version_Type'Pos (Ada_Version_Explicit_Config));
322
      Tree_Write_Int  (Boolean'Pos (Assertions_Enabled_Config));
323
      Tree_Write_Bool (All_Errors_Mode);
324
      Tree_Write_Bool (Assertions_Enabled);
325
      Tree_Write_Int  (Int (Check_Policy_List));
326
      Tree_Write_Bool (Debug_Pragmas_Disabled);
327
      Tree_Write_Bool (Debug_Pragmas_Enabled);
328
      Tree_Write_Int  (Int (Default_Pool));
329
      Tree_Write_Bool (Enable_Overflow_Checks);
330
      Tree_Write_Bool (Full_List);
331
      Tree_Write_Int  (Int (Version_String'Length));
332
      Tree_Write_Data (Version_String'Address, Version_String'Length);
333
      Tree_Write_Data (Distribution_Stub_Mode'Address,
334
                       (Distribution_Stub_Mode'Size + SU - 1) / SU);
335
      Tree_Write_Bool (Inline_Active);
336
      Tree_Write_Bool (Inline_Processing_Required);
337
      Tree_Write_Bool (List_Units);
338
      Tree_Write_Bool (Configurable_Run_Time_Mode);
339
      Tree_Write_Data (Operating_Mode'Address,
340
                       (Operating_Mode'Size + SU - 1) / SU);
341
      Tree_Write_Bool (Suppress_Checks);
342
      Tree_Write_Bool (Try_Semantics);
343
      Tree_Write_Data (Wide_Character_Encoding_Method'Address,
344
                       (Wide_Character_Encoding_Method'Size + SU - 1) / SU);
345
      Tree_Write_Bool (Upper_Half_Encoding);
346
      Tree_Write_Bool (Force_ALI_Tree_File);
347
   end Tree_Write;
348
 
349
end Opt;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.