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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [makeutl.ads] - Blame information for rev 717

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

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              M A K E U T L                               --
6
--                                                                          --
7
--                                 S p e c                                  --
8
--                                                                          --
9
--          Copyright (C) 2004-2012, 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
--  This package contains various subprograms used by the builders, in
27
--  particular those subprograms related to project management and build
28
--  queue management.
29
 
30
with ALI;
31
with Namet;    use Namet;
32
with Opt;
33
with Osint;
34
with Prj;      use Prj;
35
with Prj.Tree;
36
with Snames;   use Snames;
37
with Table;
38
with Types;    use Types;
39
 
40
with GNAT.OS_Lib; use GNAT.OS_Lib;
41
 
42
package Makeutl is
43
 
44
   type Fail_Proc is access procedure (S : String);
45
   --  Pointer to procedure which outputs a failure message
46
 
47
   On_Windows : constant Boolean := Directory_Separator = '\';
48
   --  True when on Windows
49
 
50
   Source_Info_Option : constant String := "--source-info=";
51
   --  Switch to indicate the source info file
52
 
53
   Subdirs_Option : constant String := "--subdirs=";
54
   --  Switch used to indicate that the real directories (object, exec,
55
   --  library, ...) are subdirectories of those in the project file.
56
 
57
   Unchecked_Shared_Lib_Imports : constant String :=
58
                                    "--unchecked-shared-lib-imports";
59
   --  Command line switch to allow shared library projects to import projects
60
   --  that are not shared library projects.
61
 
62
   Single_Compile_Per_Obj_Dir_Switch : constant String :=
63
                                         "--single-compile-per-obj-dir";
64
   --  Switch to forbid simultaneous compilations for the same object directory
65
   --  when project files are used.
66
 
67
   Create_Map_File_Switch : constant String := "--create-map-file";
68
   --  Switch to create a map file when an executable is linked
69
 
70
   package Directories is new Table.Table
71
     (Table_Component_Type => Path_Name_Type,
72
      Table_Index_Type     => Integer,
73
      Table_Low_Bound      => 1,
74
      Table_Initial        => 200,
75
      Table_Increment      => 100,
76
      Table_Name           => "Makegpr.Directories");
77
   --  Table of all the source or object directories, filled up by
78
   --  Get_Directories.
79
 
80
   procedure Add
81
     (Option : String_Access;
82
      To     : in out String_List_Access;
83
      Last   : in out Natural);
84
   procedure Add
85
     (Option : String;
86
      To     : in out String_List_Access;
87
      Last   : in out Natural);
88
   --  Add a string to a list of strings
89
 
90
   function Create_Binder_Mapping_File
91
     (Project_Tree : Project_Tree_Ref) return Path_Name_Type;
92
   --  Create a binder mapping file and returns its path name
93
 
94
   function Create_Name (Name : String) return File_Name_Type;
95
   function Create_Name (Name : String) return Name_Id;
96
   function Create_Name (Name : String) return Path_Name_Type;
97
   --  Get an id for a name
98
 
99
   function Base_Name_Index_For
100
     (Main            : String;
101
      Main_Index      : Int;
102
      Index_Separator : Character) return File_Name_Type;
103
   --  Returns the base name of Main, without the extension, followed by the
104
   --  Index_Separator followed by the Main_Index if it is non-zero.
105
 
106
   function Executable_Prefix_Path return String;
107
   --  Return the absolute path parent directory of the directory where the
108
   --  current executable resides, if its directory is named "bin", otherwise
109
   --  return an empty string. When a directory is returned, it is guaranteed
110
   --  to end with a directory separator.
111
 
112
   procedure Inform (N : Name_Id := No_Name; Msg : String);
113
   procedure Inform (N : File_Name_Type; Msg : String);
114
   --  Prints out the program name followed by a colon, N and S
115
 
116
   function File_Not_A_Source_Of
117
     (Project_Tree : Project_Tree_Ref;
118
      Uname        : Name_Id;
119
      Sfile        : File_Name_Type) return Boolean;
120
   --  Check that file name Sfile is one of the source of unit Uname. Returns
121
   --  True if the unit is in one of the project file, but the file name is not
122
   --  one of its source. Returns False otherwise.
123
 
124
   function Check_Source_Info_In_ALI
125
     (The_ALI      : ALI.ALI_Id;
126
      Tree         : Project_Tree_Ref) return Name_Id;
127
   --  Check whether all file references in ALI are still valid (i.e. the
128
   --  source files are still associated with the same units). Return the name
129
   --  of the unit if everything is still valid. Return No_Name otherwise.
130
 
131
   function Is_Subunit (Source : Source_Id) return Boolean;
132
   --  Return True if source is a subunit
133
 
134
   procedure Initialize_Source_Record (Source : Source_Id);
135
   --  Get information either about the source file, or the object and
136
   --  dependency file, as well as their timestamps.
137
 
138
   function Is_External_Assignment
139
     (Env  : Prj.Tree.Environment;
140
      Argv : String) return Boolean;
141
   --  Verify that an external assignment switch is syntactically correct
142
   --
143
   --  Correct forms are:
144
   --
145
   --      -Xname=value
146
   --      -X"name=other value"
147
   --
148
   --  Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
149
   --
150
   --  When this function returns True, the external assignment has been
151
   --  entered by a call to Prj.Ext.Add, so that in a project file, External
152
   --  ("name") will return "value".
153
 
154
   procedure Verbose_Msg
155
     (N1                : Name_Id;
156
      S1                : String;
157
      N2                : Name_Id := No_Name;
158
      S2                : String  := "";
159
      Prefix            : String  := "  -> ";
160
      Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
161
   procedure Verbose_Msg
162
     (N1                : File_Name_Type;
163
      S1                : String;
164
      N2                : File_Name_Type := No_File;
165
      S2                : String  := "";
166
      Prefix            : String  := "  -> ";
167
      Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low);
168
   --  If the verbose flag (Verbose_Mode) is set and the verbosity level is at
169
   --  least equal to Minimum_Verbosity, then print Prefix to standard output
170
   --  followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2
171
   --  is printed last. Both N1 and N2 are printed in quotation marks. The two
172
   --  forms differ only in taking Name_Id or File_name_Type arguments.
173
 
174
   type Name_Ids is array (Positive range <>) of Name_Id;
175
   No_Names : constant Name_Ids := (1 .. 0 => No_Name);
176
   --  Name_Ids is used for list of language names in procedure Get_Directories
177
   --  below.
178
 
179
   Ada_Only : constant Name_Ids := (1 => Name_Ada);
180
   --  Used to invoke Get_Directories in gnatmake
181
 
182
   type Activity_Type is (Compilation, Executable_Binding, SAL_Binding);
183
 
184
   procedure Get_Directories
185
     (Project_Tree : Project_Tree_Ref;
186
      For_Project  : Project_Id;
187
      Activity     : Activity_Type;
188
      Languages    : Name_Ids);
189
   --  Put in table Directories the source (when Sources is True) or
190
   --  object/library (when Sources is False) directories of project
191
   --  For_Project and of all the project it imports directly or indirectly.
192
   --  The source directories of imported projects are only included if one
193
   --  of the declared languages is in the list Languages.
194
 
195
   procedure Write_Path_File (FD : File_Descriptor);
196
   --  Write in the specified open path file the directories in table
197
   --  Directories, then closed the path file.
198
 
199
   procedure Get_Switches
200
     (Source       : Source_Id;
201
      Pkg_Name     : Name_Id;
202
      Project_Tree : Project_Tree_Ref;
203
      Value        : out Variable_Value;
204
      Is_Default   : out Boolean);
205
   procedure Get_Switches
206
     (Source_File         : File_Name_Type;
207
      Source_Lang         : Name_Id;
208
      Source_Prj          : Project_Id;
209
      Pkg_Name            : Name_Id;
210
      Project_Tree        : Project_Tree_Ref;
211
      Value               : out Variable_Value;
212
      Is_Default          : out Boolean;
213
      Test_Without_Suffix : Boolean := False;
214
      Check_ALI_Suffix    : Boolean := False);
215
   --  Compute the switches (Compilation switches for instance) for the given
216
   --  file. This checks various attributes to see if there are file specific
217
   --  switches, or else defaults on the switches for the corresponding
218
   --  language. Is_Default is set to False if there were file-specific
219
   --  switches Source_File can be set to No_File to force retrieval of the
220
   --  default switches. If Test_Without_Suffix is True, and there is no " for
221
   --  Switches(Source_File) use", then this procedure also tests without the
222
   --  extension of the filename. If Test_Without_Suffix is True and
223
   --  Check_ALI_Suffix is True, then we also replace the file extension with
224
   --  ".ali" when testing.
225
 
226
   function Linker_Options_Switches
227
     (Project  : Project_Id;
228
      Do_Fail  : Fail_Proc;
229
      In_Tree  : Project_Tree_Ref) return String_List;
230
   --  Collect the options specified in the Linker'Linker_Options attributes
231
   --  of project Project, in project tree In_Tree, and in the projects that
232
   --  it imports directly or indirectly, and returns the result.
233
 
234
   function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
235
   --  Find the index of a unit in a source file. Return zero if the file is
236
   --  not a multi-unit source file.
237
 
238
   procedure Test_If_Relative_Path
239
     (Switch               : in out String_Access;
240
      Parent               : String;
241
      Do_Fail              : Fail_Proc;
242
      Including_L_Switch   : Boolean := True;
243
      Including_Non_Switch : Boolean := True;
244
      Including_RTS        : Boolean := False);
245
   --  Test if Switch is a relative search path switch. If so, fail if Parent
246
   --  is the empty string, otherwise prepend the path with Parent. This
247
   --  subprogram is only used when using project files. For gnatbind switches,
248
   --  Including_L_Switch is False, because the argument of the -L switch is
249
   --  not a path. If Including_RTS is True, process also switches --RTS=.
250
   --  Do_Fail is called in case of error. Using Osint.Fail might be
251
   --  appropriate.
252
 
253
   function Path_Or_File_Name (Path : Path_Name_Type) return String;
254
   --  Returns a file name if -df is used, otherwise return a path name
255
 
256
   -------------------------
257
   -- Program termination --
258
   -------------------------
259
 
260
   procedure Fail_Program
261
     (Project_Tree   : Project_Tree_Ref;
262
      S              : String;
263
      Flush_Messages : Boolean := True);
264
   --  Terminate program with a message and a fatal status code
265
 
266
   procedure Finish_Program
267
     (Project_Tree : Project_Tree_Ref;
268
      Exit_Code    : Osint.Exit_Code_Type := Osint.E_Success;
269
      S            : String := "");
270
   --  Terminate program, with or without a message, setting the status code
271
   --  according to Fatal. This properly removes all temporary files.
272
 
273
   --------------
274
   -- Switches --
275
   --------------
276
 
277
   generic
278
      with function Add_Switch
279
        (Switch      : String;
280
         For_Lang    : Name_Id;
281
         For_Builder : Boolean;
282
         Has_Global_Compilation_Switches : Boolean) return Boolean;
283
      --  For_Builder is true if we have a builder switch
284
      --  This function should return True in case of success (the switch is
285
      --  valid), False otherwise. The error message will be displayed by
286
      --  Compute_Builder_Switches itself.
287
      --  Has_Global_Compilation_Switches is True if the attribute
288
      --  Global_Compilation_Switches is defined in the project.
289
 
290
   procedure Compute_Builder_Switches
291
     (Project_Tree     : Project_Tree_Ref;
292
      Root_Environment : in out Prj.Tree.Environment;
293
      Main_Project     : Project_Id;
294
      Only_For_Lang    : Name_Id := No_Name);
295
   --  Compute the builder switches and global compilation switches.
296
   --  Every time a switch is found in the project, it is passed to Add_Switch.
297
   --  You can provide a value for Only_For_Lang so that we only look for
298
   --  this language when parsing the global compilation switches.
299
 
300
   -----------------------
301
   -- Project_Tree data --
302
   -----------------------
303
 
304
   --  The following types are specific to builders, and associated with each
305
   --  of the loaded project trees.
306
 
307
   type Binding_Data_Record;
308
   type Binding_Data is access Binding_Data_Record;
309
   type Binding_Data_Record is record
310
      Language           : Language_Ptr;
311
      Language_Name      : Name_Id;
312
      Binder_Driver_Name : File_Name_Type;
313
      Binder_Driver_Path : String_Access;
314
      Binder_Prefix      : Name_Id;
315
      Next               : Binding_Data;
316
   end record;
317
   --  Data for a language that have a binder driver
318
 
319
   type Builder_Project_Tree_Data is new Project_Tree_Appdata with record
320
      Binding : Binding_Data;
321
 
322
      There_Are_Binder_Drivers : Boolean := False;
323
      --  True when there is a binder driver. Set by Get_Configuration when
324
      --  an attribute Language_Processing'Binder_Driver is declared.
325
      --  Reset to False if there are no sources of the languages with binder
326
      --  drivers.
327
 
328
      Number_Of_Mains : Natural := 0;
329
      --  Number of main units in this project tree
330
 
331
      Closure_Needed : Boolean := False;
332
      --  If True, we need to add the closure of the file we just compiled to
333
      --  the queue. If False, it is assumed that all files are already on the
334
      --  queue so we do not waste time computing the closure.
335
 
336
      Need_Compilation : Boolean := True;
337
      Need_Binding     : Boolean := True;
338
      Need_Linking     : Boolean := True;
339
      --  Which of the compilation phases are needed for this project tree
340
   end record;
341
   type Builder_Data_Access is access all Builder_Project_Tree_Data;
342
 
343
   procedure Free (Data : in out Builder_Project_Tree_Data);
344
   --  Free all memory allocated for Data
345
 
346
   function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access;
347
   --  Return (allocate if needed) tree-specific data
348
 
349
   procedure Compute_Compilation_Phases
350
     (Tree                  : Project_Tree_Ref;
351
      Root_Project          : Project_Id;
352
      Option_Unique_Compile : Boolean := False;   --  Was "-u" specified ?
353
      Option_Compile_Only   : Boolean := False;   --  Was "-c" specified ?
354
      Option_Bind_Only      : Boolean := False;
355
      Option_Link_Only      : Boolean := False);
356
   --  Compute which compilation phases will be needed for Tree. This also does
357
   --  the computation for aggregated trees. This also check whether we'll need
358
   --  to check the closure of the files we have just compiled to add them to
359
   --  the queue.
360
 
361
   -----------
362
   -- Mains --
363
   -----------
364
 
365
   --  Package Mains is used to store the mains specified on the command line
366
   --  and to retrieve them when a project file is used, to verify that the
367
   --  files exist and that they belong to a project file.
368
 
369
   --  Mains are stored in a table. An index is used to retrieve the mains
370
   --  from the table.
371
 
372
   type Main_Info is record
373
      File      : File_Name_Type;  --  Always canonical casing
374
      Index     : Int := 0;
375
      Location  : Source_Ptr := No_Location;
376
 
377
      Source    : Prj.Source_Id := No_Source;
378
      Project   : Project_Id;
379
      Tree      : Project_Tree_Ref;
380
   end record;
381
 
382
   No_Main_Info : constant Main_Info :=
383
                    (No_File, 0, No_Location, No_Source, No_Project, null);
384
 
385
   package Mains is
386
      procedure Add_Main
387
        (Name     : String;
388
         Index    : Int := 0;
389
         Location : Source_Ptr := No_Location;
390
         Project  : Project_Id := No_Project;
391
         Tree     : Project_Tree_Ref := null);
392
      --  Add one main to the table. This is in general used to add the main
393
      --  files specified on the command line. Index is used for multi-unit
394
      --  source files, and indicates which unit in the source is concerned.
395
      --  Location is the location within the project file (if a project file
396
      --  is used). Project and Tree indicate to which project the main should
397
      --  belong. In particular, for aggregate projects, this isn't necessarily
398
      --  the main project tree. These can be set to No_Project and null when
399
      --  not using projects.
400
 
401
      procedure Delete;
402
      --  Empty the table
403
 
404
      procedure Reset;
405
      --  Reset the cursor to the beginning of the table
406
 
407
      procedure Set_Multi_Unit_Index
408
        (Project_Tree : Project_Tree_Ref := null;
409
         Index        : Int := 0);
410
      --  If a single main file was defined, this subprogram indicates which
411
      --  unit inside it is the main (case of a multi-unit source files).
412
      --  Errors are raised if zero or more than one main file was defined,
413
      --  and Index is non-zaero. This subprogram is used for the handling
414
      --  of the command line switch.
415
 
416
      function Next_Main return String;
417
      function Next_Main return Main_Info;
418
      --  Moves the cursor forward and returns the new current entry. Returns
419
      --  No_Main_Info there are no more mains in the table.
420
 
421
      function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
422
      --  Returns the number of mains in this project tree (if Tree is null, it
423
      --  returns the total number of project trees)
424
 
425
      procedure Fill_From_Project
426
        (Root_Project : Project_Id;
427
         Project_Tree : Project_Tree_Ref);
428
      --  If no main was already added (presumably from the command line), add
429
      --  the main units from root_project (or in the case of an aggregate
430
      --  project from all the aggregated projects).
431
 
432
      procedure Complete_Mains
433
        (Flags        : Processing_Flags;
434
         Root_Project : Project_Id;
435
         Project_Tree : Project_Tree_Ref);
436
      --  If some main units were already added from the command line, check
437
      --  that they all belong to the root project, and that they are full
438
      --  paths rather than (partial) base names (e.g. no body suffix was
439
      --  specified).
440
 
441
   end Mains;
442
 
443
   -----------
444
   -- Queue --
445
   -----------
446
 
447
   type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake);
448
 
449
   package Queue is
450
 
451
      --  The queue of sources to be checked for compilation. There can be a
452
      --  single such queue per application.
453
 
454
      type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is
455
         record
456
            case Format is
457
               when Format_Gprbuild =>
458
                  Tree : Project_Tree_Ref := null;
459
                  Id   : Source_Id        := null;
460
 
461
               when Format_Gnatmake =>
462
                  File    : File_Name_Type := No_File;
463
                  Unit    : Unit_Name_Type := No_Unit_Name;
464
                  Index   : Int            := 0;
465
                  Project : Project_Id     := No_Project;
466
            end case;
467
         end record;
468
      --  Information about files stored in the queue. The exact information
469
      --  depends on the builder, and in particular whether it only supports
470
      --  project-based files (in which case we have a full Source_Id record).
471
 
472
      No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
473
 
474
      procedure Initialize
475
        (Queue_Per_Obj_Dir : Boolean;
476
         Force             : Boolean := False);
477
      --  Initialize the queue
478
      --
479
      --  Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch:
480
      --  when True, there cannot be simultaneous compilations with the object
481
      --  files in the same object directory when project files are used.
482
      --
483
      --  Nothing is done if Force is False and the queue was already
484
      --  initialized.
485
 
486
      procedure Remove_Marks;
487
      --  Remove all marks set for the files. This means that the files will be
488
      --  handed to the compiler if they are added to the queue, and is mostly
489
      --  useful when recompiling several executables in non-project mode, as
490
      --  the switches may be different and -s may be in use.
491
 
492
      function Is_Empty return Boolean;
493
      --  Returns True if the queue is empty
494
 
495
      function Is_Virtually_Empty return Boolean;
496
      --  Returns True if queue is empty or if all object directories are busy
497
 
498
      procedure Insert (Source  : Source_Info; With_Roots : Boolean := False);
499
      function Insert
500
        (Source  : Source_Info; With_Roots : Boolean := False) return Boolean;
501
      --  Insert source in the queue. The second version returns False if the
502
      --  Source was already marked in the queue. If With_Roots is True and the
503
      --  source is in Format_Gprbuild mode (ie with a project), this procedure
504
      --  also includes the "Roots" for this main, ie all the other files that
505
      --  must be included in the library or binary (in particular to combine
506
      --  Ada and C files connected through pragma Export/Import). When the
507
      --  roots are computed, they are also stored in the corresponding
508
      --  Source_Id for later reuse by the binder.
509
 
510
      procedure Insert_Project_Sources
511
        (Project        : Project_Id;
512
         Project_Tree   : Project_Tree_Ref;
513
         All_Projects   : Boolean;
514
         Unique_Compile : Boolean);
515
      --  Insert all the compilable sources of the project in the queue. If
516
      --  All_Project is true, then all sources from imported projects are also
517
      --  inserted. Unique_Compile should be true if "-u" was specified on the
518
      --  command line: if True and some files were given on the command line),
519
      --  only those files will be compiled (so Insert_Project_Sources will do
520
      --  nothing). If True and no file was specified on the command line, all
521
      --  files of the project(s) will be compiled. This procedure also
522
      --  processed aggregated projects.
523
 
524
      procedure Insert_Withed_Sources_For
525
        (The_ALI               : ALI.ALI_Id;
526
         Project_Tree          : Project_Tree_Ref;
527
         Excluding_Shared_SALs : Boolean := False);
528
      --  Insert in the queue those sources withed by The_ALI, if there are not
529
      --  already in the queue and Only_Interfaces is False or they are part of
530
      --  the interfaces of their project.
531
 
532
      procedure Extract
533
        (Found  : out Boolean;
534
         Source : out Source_Info);
535
      --  Get the first source that can be compiled from the queue. If no
536
      --  source may be compiled, sets Found to False. In this case, the value
537
      --  for Source is undefined.
538
 
539
      function Size return Natural;
540
      --  Return the total size of the queue, including the sources already
541
      --  extracted.
542
 
543
      function Processed return Natural;
544
      --  Return the number of source in the queue that have aready been
545
      --  processed.
546
 
547
      procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type);
548
      procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type);
549
      --  Mark Obj_Dir as busy or free (see the parameter to Initialize)
550
 
551
      function Element (Rank : Positive) return File_Name_Type;
552
      --  Get the file name for element of index Rank in the queue
553
 
554
   end Queue;
555
 
556
end Makeutl;

powered by: WebSVN 2.1.0

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