diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/makeutl.ads')
| -rw-r--r-- | gcc-4.7/gcc/ada/makeutl.ads | 556 |
1 files changed, 556 insertions, 0 deletions
diff --git a/gcc-4.7/gcc/ada/makeutl.ads b/gcc-4.7/gcc/ada/makeutl.ads new file mode 100644 index 000000000..3ddb2085d --- /dev/null +++ b/gcc-4.7/gcc/ada/makeutl.ads @@ -0,0 +1,556 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- M A K E U T L -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2004-2012, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package contains various subprograms used by the builders, in +-- particular those subprograms related to project management and build +-- queue management. + +with ALI; +with Namet; use Namet; +with Opt; +with Osint; +with Prj; use Prj; +with Prj.Tree; +with Snames; use Snames; +with Table; +with Types; use Types; + +with GNAT.OS_Lib; use GNAT.OS_Lib; + +package Makeutl is + + type Fail_Proc is access procedure (S : String); + -- Pointer to procedure which outputs a failure message + + On_Windows : constant Boolean := Directory_Separator = '\'; + -- True when on Windows + + Source_Info_Option : constant String := "--source-info="; + -- Switch to indicate the source info file + + Subdirs_Option : constant String := "--subdirs="; + -- Switch used to indicate that the real directories (object, exec, + -- library, ...) are subdirectories of those in the project file. + + Unchecked_Shared_Lib_Imports : constant String := + "--unchecked-shared-lib-imports"; + -- Command line switch to allow shared library projects to import projects + -- that are not shared library projects. + + Single_Compile_Per_Obj_Dir_Switch : constant String := + "--single-compile-per-obj-dir"; + -- Switch to forbid simultaneous compilations for the same object directory + -- when project files are used. + + Create_Map_File_Switch : constant String := "--create-map-file"; + -- Switch to create a map file when an executable is linked + + package Directories is new Table.Table + (Table_Component_Type => Path_Name_Type, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 200, + Table_Increment => 100, + Table_Name => "Makegpr.Directories"); + -- Table of all the source or object directories, filled up by + -- Get_Directories. + + procedure Add + (Option : String_Access; + To : in out String_List_Access; + Last : in out Natural); + procedure Add + (Option : String; + To : in out String_List_Access; + Last : in out Natural); + -- Add a string to a list of strings + + function Create_Binder_Mapping_File + (Project_Tree : Project_Tree_Ref) return Path_Name_Type; + -- Create a binder mapping file and returns its path name + + function Create_Name (Name : String) return File_Name_Type; + function Create_Name (Name : String) return Name_Id; + function Create_Name (Name : String) return Path_Name_Type; + -- Get an id for a name + + function Base_Name_Index_For + (Main : String; + Main_Index : Int; + Index_Separator : Character) return File_Name_Type; + -- Returns the base name of Main, without the extension, followed by the + -- Index_Separator followed by the Main_Index if it is non-zero. + + function Executable_Prefix_Path return String; + -- Return the absolute path parent directory of the directory where the + -- current executable resides, if its directory is named "bin", otherwise + -- return an empty string. When a directory is returned, it is guaranteed + -- to end with a directory separator. + + procedure Inform (N : Name_Id := No_Name; Msg : String); + procedure Inform (N : File_Name_Type; Msg : String); + -- Prints out the program name followed by a colon, N and S + + function File_Not_A_Source_Of + (Project_Tree : Project_Tree_Ref; + Uname : Name_Id; + Sfile : File_Name_Type) return Boolean; + -- Check that file name Sfile is one of the source of unit Uname. Returns + -- True if the unit is in one of the project file, but the file name is not + -- one of its source. Returns False otherwise. + + function Check_Source_Info_In_ALI + (The_ALI : ALI.ALI_Id; + Tree : Project_Tree_Ref) return Name_Id; + -- Check whether all file references in ALI are still valid (i.e. the + -- source files are still associated with the same units). Return the name + -- of the unit if everything is still valid. Return No_Name otherwise. + + function Is_Subunit (Source : Source_Id) return Boolean; + -- Return True if source is a subunit + + procedure Initialize_Source_Record (Source : Source_Id); + -- Get information either about the source file, or the object and + -- dependency file, as well as their timestamps. + + function Is_External_Assignment + (Env : Prj.Tree.Environment; + Argv : String) return Boolean; + -- Verify that an external assignment switch is syntactically correct + -- + -- Correct forms are: + -- + -- -Xname=value + -- -X"name=other value" + -- + -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X" + -- + -- When this function returns True, the external assignment has been + -- entered by a call to Prj.Ext.Add, so that in a project file, External + -- ("name") will return "value". + + procedure Verbose_Msg + (N1 : Name_Id; + S1 : String; + N2 : Name_Id := No_Name; + S2 : String := ""; + Prefix : String := " -> "; + Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); + procedure Verbose_Msg + (N1 : File_Name_Type; + S1 : String; + N2 : File_Name_Type := No_File; + S2 : String := ""; + Prefix : String := " -> "; + Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); + -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at + -- least equal to Minimum_Verbosity, then print Prefix to standard output + -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 + -- is printed last. Both N1 and N2 are printed in quotation marks. The two + -- forms differ only in taking Name_Id or File_name_Type arguments. + + type Name_Ids is array (Positive range <>) of Name_Id; + No_Names : constant Name_Ids := (1 .. 0 => No_Name); + -- Name_Ids is used for list of language names in procedure Get_Directories + -- below. + + Ada_Only : constant Name_Ids := (1 => Name_Ada); + -- Used to invoke Get_Directories in gnatmake + + type Activity_Type is (Compilation, Executable_Binding, SAL_Binding); + + procedure Get_Directories + (Project_Tree : Project_Tree_Ref; + For_Project : Project_Id; + Activity : Activity_Type; + Languages : Name_Ids); + -- Put in table Directories the source (when Sources is True) or + -- object/library (when Sources is False) directories of project + -- For_Project and of all the project it imports directly or indirectly. + -- The source directories of imported projects are only included if one + -- of the declared languages is in the list Languages. + + procedure Write_Path_File (FD : File_Descriptor); + -- Write in the specified open path file the directories in table + -- Directories, then closed the path file. + + procedure Get_Switches + (Source : Source_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean); + procedure Get_Switches + (Source_File : File_Name_Type; + Source_Lang : Name_Id; + Source_Prj : Project_Id; + Pkg_Name : Name_Id; + Project_Tree : Project_Tree_Ref; + Value : out Variable_Value; + Is_Default : out Boolean; + Test_Without_Suffix : Boolean := False; + Check_ALI_Suffix : Boolean := False); + -- Compute the switches (Compilation switches for instance) for the given + -- file. This checks various attributes to see if there are file specific + -- switches, or else defaults on the switches for the corresponding + -- language. Is_Default is set to False if there were file-specific + -- switches Source_File can be set to No_File to force retrieval of the + -- default switches. If Test_Without_Suffix is True, and there is no " for + -- Switches(Source_File) use", then this procedure also tests without the + -- extension of the filename. If Test_Without_Suffix is True and + -- Check_ALI_Suffix is True, then we also replace the file extension with + -- ".ali" when testing. + + function Linker_Options_Switches + (Project : Project_Id; + Do_Fail : Fail_Proc; + In_Tree : Project_Tree_Ref) return String_List; + -- Collect the options specified in the Linker'Linker_Options attributes + -- of project Project, in project tree In_Tree, and in the projects that + -- it imports directly or indirectly, and returns the result. + + function Unit_Index_Of (ALI_File : File_Name_Type) return Int; + -- Find the index of a unit in a source file. Return zero if the file is + -- not a multi-unit source file. + + procedure Test_If_Relative_Path + (Switch : in out String_Access; + Parent : String; + Do_Fail : Fail_Proc; + Including_L_Switch : Boolean := True; + Including_Non_Switch : Boolean := True; + Including_RTS : Boolean := False); + -- Test if Switch is a relative search path switch. If so, fail if Parent + -- is the empty string, otherwise prepend the path with Parent. This + -- subprogram is only used when using project files. For gnatbind switches, + -- Including_L_Switch is False, because the argument of the -L switch is + -- not a path. If Including_RTS is True, process also switches --RTS=. + -- Do_Fail is called in case of error. Using Osint.Fail might be + -- appropriate. + + function Path_Or_File_Name (Path : Path_Name_Type) return String; + -- Returns a file name if -df is used, otherwise return a path name + + ------------------------- + -- Program termination -- + ------------------------- + + procedure Fail_Program + (Project_Tree : Project_Tree_Ref; + S : String; + Flush_Messages : Boolean := True); + -- Terminate program with a message and a fatal status code + + procedure Finish_Program + (Project_Tree : Project_Tree_Ref; + Exit_Code : Osint.Exit_Code_Type := Osint.E_Success; + S : String := ""); + -- Terminate program, with or without a message, setting the status code + -- according to Fatal. This properly removes all temporary files. + + -------------- + -- Switches -- + -------------- + + generic + with function Add_Switch + (Switch : String; + For_Lang : Name_Id; + For_Builder : Boolean; + Has_Global_Compilation_Switches : Boolean) return Boolean; + -- For_Builder is true if we have a builder switch + -- This function should return True in case of success (the switch is + -- valid), False otherwise. The error message will be displayed by + -- Compute_Builder_Switches itself. + -- Has_Global_Compilation_Switches is True if the attribute + -- Global_Compilation_Switches is defined in the project. + + procedure Compute_Builder_Switches + (Project_Tree : Project_Tree_Ref; + Root_Environment : in out Prj.Tree.Environment; + Main_Project : Project_Id; + Only_For_Lang : Name_Id := No_Name); + -- Compute the builder switches and global compilation switches. + -- Every time a switch is found in the project, it is passed to Add_Switch. + -- You can provide a value for Only_For_Lang so that we only look for + -- this language when parsing the global compilation switches. + + ----------------------- + -- Project_Tree data -- + ----------------------- + + -- The following types are specific to builders, and associated with each + -- of the loaded project trees. + + type Binding_Data_Record; + type Binding_Data is access Binding_Data_Record; + type Binding_Data_Record is record + Language : Language_Ptr; + Language_Name : Name_Id; + Binder_Driver_Name : File_Name_Type; + Binder_Driver_Path : String_Access; + Binder_Prefix : Name_Id; + Next : Binding_Data; + end record; + -- Data for a language that have a binder driver + + type Builder_Project_Tree_Data is new Project_Tree_Appdata with record + Binding : Binding_Data; + + There_Are_Binder_Drivers : Boolean := False; + -- True when there is a binder driver. Set by Get_Configuration when + -- an attribute Language_Processing'Binder_Driver is declared. + -- Reset to False if there are no sources of the languages with binder + -- drivers. + + Number_Of_Mains : Natural := 0; + -- Number of main units in this project tree + + Closure_Needed : Boolean := False; + -- If True, we need to add the closure of the file we just compiled to + -- the queue. If False, it is assumed that all files are already on the + -- queue so we do not waste time computing the closure. + + Need_Compilation : Boolean := True; + Need_Binding : Boolean := True; + Need_Linking : Boolean := True; + -- Which of the compilation phases are needed for this project tree + end record; + type Builder_Data_Access is access all Builder_Project_Tree_Data; + + procedure Free (Data : in out Builder_Project_Tree_Data); + -- Free all memory allocated for Data + + function Builder_Data (Tree : Project_Tree_Ref) return Builder_Data_Access; + -- Return (allocate if needed) tree-specific data + + procedure Compute_Compilation_Phases + (Tree : Project_Tree_Ref; + Root_Project : Project_Id; + Option_Unique_Compile : Boolean := False; -- Was "-u" specified ? + Option_Compile_Only : Boolean := False; -- Was "-c" specified ? + Option_Bind_Only : Boolean := False; + Option_Link_Only : Boolean := False); + -- Compute which compilation phases will be needed for Tree. This also does + -- the computation for aggregated trees. This also check whether we'll need + -- to check the closure of the files we have just compiled to add them to + -- the queue. + + ----------- + -- Mains -- + ----------- + + -- Package Mains is used to store the mains specified on the command line + -- and to retrieve them when a project file is used, to verify that the + -- files exist and that they belong to a project file. + + -- Mains are stored in a table. An index is used to retrieve the mains + -- from the table. + + type Main_Info is record + File : File_Name_Type; -- Always canonical casing + Index : Int := 0; + Location : Source_Ptr := No_Location; + + Source : Prj.Source_Id := No_Source; + Project : Project_Id; + Tree : Project_Tree_Ref; + end record; + + No_Main_Info : constant Main_Info := + (No_File, 0, No_Location, No_Source, No_Project, null); + + package Mains is + procedure Add_Main + (Name : String; + Index : Int := 0; + Location : Source_Ptr := No_Location; + Project : Project_Id := No_Project; + Tree : Project_Tree_Ref := null); + -- Add one main to the table. This is in general used to add the main + -- files specified on the command line. Index is used for multi-unit + -- source files, and indicates which unit in the source is concerned. + -- Location is the location within the project file (if a project file + -- is used). Project and Tree indicate to which project the main should + -- belong. In particular, for aggregate projects, this isn't necessarily + -- the main project tree. These can be set to No_Project and null when + -- not using projects. + + procedure Delete; + -- Empty the table + + procedure Reset; + -- Reset the cursor to the beginning of the table + + procedure Set_Multi_Unit_Index + (Project_Tree : Project_Tree_Ref := null; + Index : Int := 0); + -- If a single main file was defined, this subprogram indicates which + -- unit inside it is the main (case of a multi-unit source files). + -- Errors are raised if zero or more than one main file was defined, + -- and Index is non-zaero. This subprogram is used for the handling + -- of the command line switch. + + function Next_Main return String; + function Next_Main return Main_Info; + -- Moves the cursor forward and returns the new current entry. Returns + -- No_Main_Info there are no more mains in the table. + + function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural; + -- Returns the number of mains in this project tree (if Tree is null, it + -- returns the total number of project trees) + + procedure Fill_From_Project + (Root_Project : Project_Id; + Project_Tree : Project_Tree_Ref); + -- If no main was already added (presumably from the command line), add + -- the main units from root_project (or in the case of an aggregate + -- project from all the aggregated projects). + + procedure Complete_Mains + (Flags : Processing_Flags; + Root_Project : Project_Id; + Project_Tree : Project_Tree_Ref); + -- If some main units were already added from the command line, check + -- that they all belong to the root project, and that they are full + -- paths rather than (partial) base names (e.g. no body suffix was + -- specified). + + end Mains; + + ----------- + -- Queue -- + ----------- + + type Source_Info_Format is (Format_Gprbuild, Format_Gnatmake); + + package Queue is + + -- The queue of sources to be checked for compilation. There can be a + -- single such queue per application. + + type Source_Info (Format : Source_Info_Format := Format_Gprbuild) is + record + case Format is + when Format_Gprbuild => + Tree : Project_Tree_Ref := null; + Id : Source_Id := null; + + when Format_Gnatmake => + File : File_Name_Type := No_File; + Unit : Unit_Name_Type := No_Unit_Name; + Index : Int := 0; + Project : Project_Id := No_Project; + end case; + end record; + -- Information about files stored in the queue. The exact information + -- depends on the builder, and in particular whether it only supports + -- project-based files (in which case we have a full Source_Id record). + + No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null); + + procedure Initialize + (Queue_Per_Obj_Dir : Boolean; + Force : Boolean := False); + -- Initialize the queue + -- + -- Queue_Per_Obj_Dir matches the --single-compile-per-obj-dir switch: + -- when True, there cannot be simultaneous compilations with the object + -- files in the same object directory when project files are used. + -- + -- Nothing is done if Force is False and the queue was already + -- initialized. + + procedure Remove_Marks; + -- Remove all marks set for the files. This means that the files will be + -- handed to the compiler if they are added to the queue, and is mostly + -- useful when recompiling several executables in non-project mode, as + -- the switches may be different and -s may be in use. + + function Is_Empty return Boolean; + -- Returns True if the queue is empty + + function Is_Virtually_Empty return Boolean; + -- Returns True if queue is empty or if all object directories are busy + + procedure Insert (Source : Source_Info; With_Roots : Boolean := False); + function Insert + (Source : Source_Info; With_Roots : Boolean := False) return Boolean; + -- Insert source in the queue. The second version returns False if the + -- Source was already marked in the queue. If With_Roots is True and the + -- source is in Format_Gprbuild mode (ie with a project), this procedure + -- also includes the "Roots" for this main, ie all the other files that + -- must be included in the library or binary (in particular to combine + -- Ada and C files connected through pragma Export/Import). When the + -- roots are computed, they are also stored in the corresponding + -- Source_Id for later reuse by the binder. + + procedure Insert_Project_Sources + (Project : Project_Id; + Project_Tree : Project_Tree_Ref; + All_Projects : Boolean; + Unique_Compile : Boolean); + -- Insert all the compilable sources of the project in the queue. If + -- All_Project is true, then all sources from imported projects are also + -- inserted. Unique_Compile should be true if "-u" was specified on the + -- command line: if True and some files were given on the command line), + -- only those files will be compiled (so Insert_Project_Sources will do + -- nothing). If True and no file was specified on the command line, all + -- files of the project(s) will be compiled. This procedure also + -- processed aggregated projects. + + procedure Insert_Withed_Sources_For + (The_ALI : ALI.ALI_Id; + Project_Tree : Project_Tree_Ref; + Excluding_Shared_SALs : Boolean := False); + -- Insert in the queue those sources withed by The_ALI, if there are not + -- already in the queue and Only_Interfaces is False or they are part of + -- the interfaces of their project. + + procedure Extract + (Found : out Boolean; + Source : out Source_Info); + -- Get the first source that can be compiled from the queue. If no + -- source may be compiled, sets Found to False. In this case, the value + -- for Source is undefined. + + function Size return Natural; + -- Return the total size of the queue, including the sources already + -- extracted. + + function Processed return Natural; + -- Return the number of source in the queue that have aready been + -- processed. + + procedure Set_Obj_Dir_Busy (Obj_Dir : Path_Name_Type); + procedure Set_Obj_Dir_Free (Obj_Dir : Path_Name_Type); + -- Mark Obj_Dir as busy or free (see the parameter to Initialize) + + function Element (Rank : Positive) return File_Name_Type; + -- Get the file name for element of index Rank in the queue + + end Queue; + +end Makeutl; |