OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [frontend.adb] - Blame information for rev 410

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             F R O N T E N D                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2009, 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.  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 COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with System.Strings; use System.Strings;
27
 
28
with Atree;    use Atree;
29
with Checks;
30
with CStand;
31
with Debug;    use Debug;
32
with Elists;
33
with Exp_Dbug;
34
with Fmap;
35
with Fname.UF;
36
with Inline;   use Inline;
37
with Lib;      use Lib;
38
with Lib.Load; use Lib.Load;
39
with Live;     use Live;
40
with Namet;    use Namet;
41
with Nlists;   use Nlists;
42
with Opt;      use Opt;
43
with Osint;
44
with Par;
45
with Prep;
46
with Prepcomp;
47
with Restrict; use Restrict;
48
with Rident;   use Rident;
49
with Rtsfind;  use Rtsfind;
50
with Snames;   use Snames;
51
with Sprint;
52
with Scn;      use Scn;
53
with Sem;      use Sem;
54
with Sem_Aux;
55
with Sem_Ch8;  use Sem_Ch8;
56
with Sem_SCIL;
57
with Sem_Elab; use Sem_Elab;
58
with Sem_Prag; use Sem_Prag;
59
with Sem_Warn; use Sem_Warn;
60
with Sinfo;    use Sinfo;
61
with Sinput;   use Sinput;
62
with Sinput.L; use Sinput.L;
63
with Targparm; use Targparm;
64
with Tbuild;   use Tbuild;
65
with Types;    use Types;
66
 
67
procedure Frontend is
68
   Config_Pragmas : List_Id;
69
   --  Gather configuration pragmas
70
 
71
begin
72
   --  Carry out package initializations. These are initializations which might
73
   --  logically be performed at elaboration time, were it not for the fact
74
   --  that we may be doing things more than once in the big loop over files.
75
   --  Like elaboration, the order in which these calls are made is in some
76
   --  cases important. For example, Lib cannot be initialized before Namet,
77
   --  since it uses names table entries.
78
 
79
   Rtsfind.Initialize;
80
   Atree.Initialize;
81
   Nlists.Initialize;
82
   Elists.Initialize;
83
   Lib.Load.Initialize;
84
   Sem_Aux.Initialize;
85
   Sem_Ch8.Initialize;
86
   Sem_Prag.Initialize;
87
   Fname.UF.Initialize;
88
   Checks.Initialize;
89
   Sem_Warn.Initialize;
90
   Prep.Initialize;
91
 
92
   --  Create package Standard
93
 
94
   CStand.Create_Standard;
95
 
96
   --  Check possible symbol definitions specified by -gnateD switches
97
 
98
   Prepcomp.Process_Command_Line_Symbol_Definitions;
99
 
100
   --  If -gnatep= was specified, parse the preprocessing data file
101
 
102
   if Preprocessing_Data_File /= null then
103
      Name_Len := Preprocessing_Data_File'Length;
104
      Name_Buffer (1 .. Name_Len) := Preprocessing_Data_File.all;
105
      Prepcomp.Parse_Preprocessing_Data_File (Name_Find);
106
 
107
   --  Otherwise, check if there were preprocessing symbols on the command
108
   --  line and set preprocessing if there are.
109
 
110
   else
111
      Prepcomp.Check_Symbols;
112
   end if;
113
 
114
   --  Now that the preprocessing situation is established, we are able to
115
   --  load the main source (this is no longer done by Lib.Load.Initialize).
116
 
117
   Lib.Load.Load_Main_Source;
118
 
119
   --  Return immediately if the main source could not be parsed
120
 
121
   if Sinput.Main_Source_File = No_Source_File then
122
      return;
123
   end if;
124
 
125
   --  Read and process configuration pragma files if present
126
 
127
   declare
128
      Save_Style_Check : constant Boolean := Opt.Style_Check;
129
      --  Save style check mode so it can be restored later
130
 
131
      Source_Config_File : Source_File_Index;
132
      --  Source reference for -gnatec configuration file
133
 
134
      Prag : Node_Id;
135
 
136
   begin
137
      --  We always analyze config files with style checks off, since
138
      --  we don't want a miscellaneous gnat.adc that is around to
139
      --  discombobulate intended -gnatg or -gnaty compilations. We
140
      --  also disconnect checking for maximum line length.
141
 
142
      Opt.Style_Check := False;
143
      Style_Check := False;
144
 
145
      --  Capture current suppress options, which may get modified
146
 
147
      Scope_Suppress := Opt.Suppress_Options;
148
 
149
      --  First deal with gnat.adc file
150
 
151
      if Opt.Config_File then
152
         Name_Buffer (1 .. 8) := "gnat.adc";
153
         Name_Len := 8;
154
         Source_gnat_adc := Load_Config_File (Name_Enter);
155
 
156
         if Source_gnat_adc /= No_Source_File then
157
            Initialize_Scanner (No_Unit, Source_gnat_adc);
158
            Config_Pragmas := Par (Configuration_Pragmas => True);
159
 
160
         else
161
            Config_Pragmas := Empty_List;
162
         end if;
163
 
164
      else
165
         Config_Pragmas := Empty_List;
166
      end if;
167
 
168
      --  Now deal with specified config pragmas files if there are any
169
 
170
      if Opt.Config_File_Names /= null then
171
         for Index in Opt.Config_File_Names'Range loop
172
            Name_Len := Config_File_Names (Index)'Length;
173
            Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
174
            Source_Config_File := Load_Config_File (Name_Enter);
175
 
176
            if Source_Config_File = No_Source_File then
177
               Osint.Fail
178
                 ("cannot find configuration pragmas file "
179
                  & Config_File_Names (Index).all);
180
            end if;
181
 
182
            Initialize_Scanner (No_Unit, Source_Config_File);
183
            Append_List_To
184
              (Config_Pragmas, Par (Configuration_Pragmas => True));
185
         end loop;
186
      end if;
187
 
188
      --  Now analyze all pragmas except those whose analysis must be
189
      --  deferred till after the main unit is analyzed.
190
 
191
      if Config_Pragmas /= Error_List
192
        and then Operating_Mode /= Check_Syntax
193
      then
194
         Prag := First (Config_Pragmas);
195
         while Present (Prag) loop
196
            if not Delay_Config_Pragma_Analyze (Prag) then
197
               Analyze_Pragma (Prag);
198
            end if;
199
 
200
            Next (Prag);
201
         end loop;
202
      end if;
203
 
204
      --  Restore style check, but if config file turned on checks, leave on!
205
 
206
      Opt.Style_Check := Save_Style_Check or Style_Check;
207
 
208
      --  Capture any modifications to suppress options from config pragmas
209
 
210
      Opt.Suppress_Options := Scope_Suppress;
211
   end;
212
 
213
   --  If there was a -gnatem switch, initialize the mappings of unit names to
214
   --  file names and of file names to path names from the mapping file.
215
 
216
   if Mapping_File_Name /= null then
217
      Fmap.Initialize (Mapping_File_Name.all);
218
   end if;
219
 
220
   --  Adjust Optimize_Alignment mode from debug switches if necessary
221
 
222
   if Debug_Flag_Dot_SS then
223
      Optimize_Alignment := 'S';
224
   elsif Debug_Flag_Dot_TT then
225
      Optimize_Alignment := 'T';
226
   end if;
227
 
228
   --  We have now processed the command line switches, and the gnat.adc
229
   --  file, so this is the point at which we want to capture the values
230
   --  of the configuration switches (see Opt for further details).
231
 
232
   Opt.Register_Opt_Config_Switches;
233
 
234
   --  Check for file which contains No_Body pragma
235
 
236
   if Source_File_Is_No_Body (Source_Index (Main_Unit)) then
237
      Change_Main_Unit_To_Spec;
238
   end if;
239
 
240
   --  Initialize the scanner. Note that we do this after the call to
241
   --  Create_Standard, which uses the scanner in its processing of
242
   --  floating-point bounds.
243
 
244
   Initialize_Scanner (Main_Unit, Source_Index (Main_Unit));
245
 
246
   --  Here we call the parser to parse the compilation unit (or units in
247
   --  the check syntax mode, but in that case we won't go on to the
248
   --  semantics in any case).
249
 
250
   Discard_List (Par (Configuration_Pragmas => False));
251
 
252
   --  The main unit is now loaded, and subunits of it can be loaded,
253
   --  without reporting spurious loading circularities.
254
 
255
   Set_Loading (Main_Unit, False);
256
 
257
   --  Now that the main unit is installed, we can complete the analysis
258
   --  of the pragmas in gnat.adc and the configuration file, that require
259
   --  a context for their semantic processing.
260
 
261
   if Config_Pragmas /= Error_List
262
     and then Operating_Mode /= Check_Syntax
263
   then
264
      --  Pragmas that require some semantic activity, such as
265
      --  Interrupt_State, cannot be processed until the main unit
266
      --  is installed, because they require a compilation unit on
267
      --  which to attach with_clauses, etc. So analyze them now.
268
 
269
      declare
270
         Prag : Node_Id;
271
 
272
      begin
273
         Prag := First (Config_Pragmas);
274
         while Present (Prag) loop
275
            if Delay_Config_Pragma_Analyze (Prag) then
276
               Analyze_Pragma (Prag);
277
            end if;
278
 
279
            Next (Prag);
280
         end loop;
281
      end;
282
   end if;
283
 
284
   --  If we have restriction No_Exception_Propagation, and we did not have an
285
   --  explicit switch turning off Warn_On_Non_Local_Exception, then turn on
286
   --  this warning by default if we have encountered an exception handler.
287
 
288
   if Restriction_Active (No_Exception_Propagation)
289
     and then not No_Warn_On_Non_Local_Exception
290
     and then Exception_Handler_Encountered
291
   then
292
      Warn_On_Non_Local_Exception := True;
293
   end if;
294
 
295
   --  Now on to the semantics. Skip if in syntax only mode
296
 
297
   if Operating_Mode /= Check_Syntax then
298
 
299
      --  Install the configuration pragmas in the tree
300
 
301
      Set_Config_Pragmas (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas);
302
 
303
      --  Following steps are skipped if we had a fatal error during parsing
304
 
305
      if not Fatal_Error (Main_Unit) then
306
 
307
         --  Reset Operating_Mode to Check_Semantics for subunits. We cannot
308
         --  actually generate code for subunits, so we suppress expansion.
309
         --  This also corrects certain problems that occur if we try to
310
         --  incorporate subunits at a lower level.
311
 
312
         if Operating_Mode = Generate_Code
313
           and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
314
         then
315
            Operating_Mode := Check_Semantics;
316
         end if;
317
 
318
         --  Analyze (and possibly expand) main unit
319
 
320
         Scope_Suppress := Suppress_Options;
321
         Semantics (Cunit (Main_Unit));
322
 
323
         --  Cleanup processing after completing main analysis
324
 
325
         if Operating_Mode = Generate_Code
326
           or else (Operating_Mode = Check_Semantics
327
                     and then ASIS_Mode)
328
         then
329
            Instantiate_Bodies;
330
         end if;
331
 
332
         if Operating_Mode = Generate_Code then
333
            if Inline_Processing_Required then
334
               Analyze_Inlined_Bodies;
335
            end if;
336
 
337
            --  Remove entities from program that do not have any
338
            --  execution time references.
339
 
340
            if Debug_Flag_UU then
341
               Collect_Garbage_Entities;
342
            end if;
343
 
344
            Check_Elab_Calls;
345
         end if;
346
 
347
         --  List library units if requested
348
 
349
         if List_Units then
350
            Lib.List;
351
         end if;
352
 
353
         --  Output waiting warning messages
354
 
355
         Sem_Warn.Output_Non_Modified_In_Out_Warnings;
356
         Sem_Warn.Output_Unreferenced_Messages;
357
         Sem_Warn.Check_Unused_Withs;
358
         Sem_Warn.Output_Unused_Warnings_Off_Warnings;
359
      end if;
360
   end if;
361
 
362
   --  Qualify all entity names in inner packages, package bodies, etc.,
363
   --  except when compiling for the VM back-ends, which depend on
364
   --  having unqualified names in certain cases and handles the
365
   --  generation of qualified names when needed.
366
 
367
   if VM_Target = No_VM then
368
      Exp_Dbug.Qualify_All_Entity_Names;
369
   end if;
370
 
371
   --  SCIL backend requirement. Check that SCIL nodes associated with
372
   --  dispatching calls reference subprogram calls.
373
 
374
   if Generate_SCIL then
375
      pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit)));
376
      null;
377
   end if;
378
 
379
   --  Dump the source now. Note that we do this as soon as the analysis
380
   --  of the tree is complete, because it is not just a dump in the case
381
   --  of -gnatD, where it rewrites all source locations in the tree.
382
 
383
   Sprint.Source_Dump;
384
 
385
   --  Check again for configuration pragmas that appear in the context of
386
   --  the main unit. These pragmas only affect the main unit, and the
387
   --  corresponding flag is reset after each call to Semantics, but they
388
   --  may affect the generated ali for the unit, and therefore the flag
389
   --  must be set properly after compilation. Currently we only check for
390
   --  Initialize_Scalars, but others should be checked: as well???
391
 
392
   declare
393
      Item  : Node_Id;
394
 
395
   begin
396
      Item := First (Context_Items (Cunit (Main_Unit)));
397
      while Present (Item) loop
398
         if Nkind (Item) = N_Pragma
399
           and then Pragma_Name (Item) = Name_Initialize_Scalars
400
         then
401
            Initialize_Scalars := True;
402
         end if;
403
 
404
         Next (Item);
405
      end loop;
406
   end;
407
 
408
   --  If a mapping file has been specified by a -gnatem switch, update
409
   --  it if there has been some sources that were not in the mappings.
410
 
411
   if Mapping_File_Name /= null then
412
      Fmap.Update_Mapping_File (Mapping_File_Name.all);
413
   end if;
414
 
415
   return;
416
end Frontend;

powered by: WebSVN 2.1.0

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