diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-06-06 12:37:41 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-06-06 12:37:41 +0200 |
| commit | d3cc6a322691df8a2732ec4ee5b0957caa057316 (patch) | |
| tree | a8498719c9b6fae7520643f6460dafa368f13ec6 /gcc/ada | |
| parent | 437bae3f742fc7f73ca0755a9e23c503aea872e1 (diff) | |
| download | gcc-d3cc6a322691df8a2732ec4ee5b0957caa057316.zip gcc-d3cc6a322691df8a2732ec4ee5b0957caa057316.tar.gz gcc-d3cc6a322691df8a2732ec4ee5b0957caa057316.tar.bz2 | |
lib-writ.adb: Handle Convention_CIL in addition to Convention_Java, since both are separated.
2007-04-20 Arnaud Charlet <charlet@adacore.com>
Vincent Celier <celier@adacore.com>
* lib-writ.adb: Handle Convention_CIL in addition to Convention_Java,
since both are separated.
Add support for imported CIL packages.
Add further special handling of "value_type" for CIL.
Add special handling of pragma Import for CIL.
* make.ads, make.adb: When switch -eS is used, direct all outputs to
standard output instead of standard error, except errors.
(Absolute_Path): Use untouched casing for the parent directory.
(Add_Library_Search_Dir): Use the untouched directory name.
(Add_Source_Search_Dir): Idem.
(Change_To_Object_Directory): Update output to use proper casing.
(Create_Binder_Mapping_File): Use the untouched filename to set
ALI_Name.
(Gnatmake): Use untouched library and executable directory names.
(Insert_Project_Sources): Use untouched filename for spec and body.
(Is_In_Object_Directory): Use untouched object directory.
(Mark_Directory): Idem.
(Collect_Arguments_And_Compile): Ensure that Full_Source_File always
contains the non-canonical filename in all cases.
(Change_To_Object_Directory): In verbose mode, display the name of the
object directory we're changing to.
(Compile_Sources): Make sure, when a project file is used, to compile
the body of the unit, when there is one, even when only the spec is
recorded in an ALI file.
(Gcc_Switches, Binder_Switches, Linker_Switches): Tables moved from the
spec to the body.
(Report_Compilation_Failed): New procedure
(Bind, Display_Commands, Compile_Sources, Initialize, Scan_Make_Arg):
procedures moved from the spec to the body.
(Extract_Failure): Removed, not used
Replace explicit raises of exception Bind_Failed and Link_Failed with
calls to Make_Failed with the proper message.
Replace explicit raises of exception Compilation_Failed with calls to
procedure Report_Compilation_Failed.
(Initialize): Create mapping files unconditionally when using project
files.
* sem_mech.adb: (Name_CIL, Name_CIL_Constructor, Convention_CIL,
Pragma_CIL_Constructor): New names.
* targparm.ads, targparm.adb
(Compiler_System_Version): Removed, no longer used.
(Get_Target_Parameters): Relax checks on system.ads validity. Add
handling of two new system flags: JVM and CLI.
From-SVN: r125432
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/lib-writ.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 956 | ||||
| -rw-r--r-- | gcc/ada/make.ads | 250 | ||||
| -rw-r--r-- | gcc/ada/sem_mech.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/targparm.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/targparm.ads | 43 |
6 files changed, 693 insertions, 630 deletions
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 14c62f0..d62b70d 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -33,7 +33,6 @@ with Fname; use Fname; with Fname.UF; use Fname.UF; with Lib.Util; use Lib.Util; with Lib.Xref; use Lib.Xref; -with Namet; use Namet; with Nlists; use Nlists; with Gnatvsn; use Gnatvsn; with Opt; use Opt; @@ -45,6 +44,7 @@ with Rident; use Rident; with Scn; use Scn; with Sinfo; use Sinfo; with Sinput; use Sinput; +with Snames; use Snames; with Stringt; use Stringt; with Tbuild; use Tbuild; with Uname; use Uname; @@ -71,8 +71,8 @@ package body Lib.Writ is Units.Increment_Last; Units.Table (Units.Last) := (Unit_File_Name => File_Name (S), - Unit_Name => No_Name, - Expected_Unit => No_Name, + Unit_Name => No_Unit_Name, + Expected_Unit => No_Unit_Name, Source_Index => S, Cunit => Empty, Cunit_Entity => Empty, @@ -427,7 +427,16 @@ package body Lib.Writ is (Declaration_Node (Body_Entity (Uent)))))) then - Write_Info_Str (" EE"); + if Convention (Uent) = Convention_CIL then + + -- Special case for generic CIL packages which never have + -- elaboration code + + Write_Info_Str (" NE"); + + else + Write_Info_Str (" EE"); + end if; end if; if Has_No_Elaboration_Code (Unode) then @@ -672,7 +681,7 @@ package body Lib.Writ is -- For preproc. data and def. files, there is no Unit_Name, -- check for that first. - if Unit_Name (J) /= No_Name + if Unit_Name (J) /= No_Unit_Name and then (With_Flags (J) or else Unit_Name (J) = Pname) then Num_Withs := Num_Withs + 1; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index c12cbc5..7fe2d28 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -54,15 +54,18 @@ with Sinput.P; with Snames; use Snames; with Switch; use Switch; with Switch.M; use Switch.M; -with Targparm; +with Targparm; use Targparm; +with Table; with Tempdir; +with Types; use Types; with Ada.Exceptions; use Ada.Exceptions; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.Case_Util; use GNAT.Case_Util; +with System.Case_Util; use System.Case_Util; +with System.OS_Lib; use System.OS_Lib; with System.HTable; package body Make is @@ -123,7 +126,7 @@ package body Make is procedure Insert_Q (Source_File : File_Name_Type; - Source_Unit : Unit_Name_Type := No_Name; + Source_Unit : Unit_Name_Type := No_Unit_Name; Index : Int := 0); -- Inserts Source_File at the end of Q. Provide Source_Unit when possible -- for external use (gnatdist). Provide index for multi-unit sources. @@ -176,13 +179,40 @@ package body Make is package Q is new Table.Table ( Table_Component_Type => Q_Record, - Table_Index_Type => Natural, + Table_Index_Type => Integer, Table_Low_Bound => 0, Table_Initial => 4000, Table_Increment => 100, Table_Name => "Make.Q"); -- This is the actual Q + -- The 3 following packages are used to store gcc, gnatbind and gnatlink + -- switches found in the project files. + + package Gcc_Switches is new Table.Table ( + Table_Component_Type => String_Access, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 20, + Table_Increment => 100, + Table_Name => "Make.Gcc_Switches"); + + package Binder_Switches is new Table.Table ( + Table_Component_Type => String_Access, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 20, + Table_Increment => 100, + Table_Name => "Make.Binder_Switches"); + + package Linker_Switches is new Table.Table ( + Table_Component_Type => String_Access, + Table_Index_Type => Integer, + Table_Low_Bound => 1, + Table_Initial => 20, + Table_Increment => 100, + Table_Name => "Make.Linker_Switches"); + -- The following instantiations and variables are necessary to save what -- is found on the command line, in case there is a project file specified. @@ -279,7 +309,7 @@ package body Make is Main_Project : Prj.Project_Id := No_Project; -- The project id of the main project file, if any - Project_Object_Directory : Project_Id := No_Project; + Project_Of_Current_Object_Directory : Project_Id := No_Project; -- The object directory of the project for the last compilation. Avoid -- calling Change_Dir if the current working directory is already this -- directory @@ -399,30 +429,30 @@ package body Make is type Header_Num is range 1 .. Max_Header; -- Header_Num for the hash table Obsoleted below - function Hash (F : Name_Id) return Header_Num; + function Hash (F : File_Name_Type) return Header_Num; -- Hash function for the hash table Obsoleted below package Obsoleted is new System.HTable.Simple_HTable (Header_Num => Header_Num, Element => Boolean, No_Element => False, - Key => Name_Id, + Key => File_Name_Type, Hash => Hash, Equal => "="); -- A hash table to keep all files that have been compiled, to detect -- if an executable is up to date or not. - procedure Enter_Into_Obsoleted (F : Name_Id); + procedure Enter_Into_Obsoleted (F : File_Name_Type); -- Enter a file name, without directory information, into the hash table -- Obsoleted. - function Is_In_Obsoleted (F : Name_Id) return Boolean; + function Is_In_Obsoleted (F : File_Name_Type) return Boolean; -- Check if a file name, without directory information, has already been -- entered into the hash table Obsoleted. type Dependency is record - This : Name_Id; - Depends_On : Name_Id; + This : File_Name_Type; + Depends_On : File_Name_Type; end record; -- Components of table Dependencies below @@ -434,10 +464,7 @@ package body Make is Table_Increment => 100, Table_Name => "Make.Dependencies"); -- A table to keep dependencies, to be able to decide if an executable - -- is obsolete. - - procedure Add_Dependency (S : Name_Id; On : Name_Id); - -- Add one entry in table Dependencies + -- is obsolete. More explanation needed ??? ---------------------------- -- Arguments and Switches -- @@ -485,8 +512,10 @@ package body Make is -- no additional ALI files should be scanned between the two calls (i.e. -- between the call to Compile_Sources and List_Depend.) - procedure Inform (N : Name_Id := No_Name; Msg : String); - -- Prints out the program name followed by a colon, N and S + procedure Inform (N : Name_Id; Msg : String); + procedure Inform (N : File_Name_Type; Msg : String); + procedure Inform (Msg : String); + -- Prints out the program name followed by a colon, N (if present) and Msg procedure List_Bad_Compilations; -- Prints out the list of all files for which the compilation failed @@ -498,6 +527,13 @@ package body Make is S2 : String := ""; Prefix : String := " -> "; Minimum_Verbosity : 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 : 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 @@ -511,6 +547,8 @@ package body Make is -- Set Usage_Needed to False. procedure Debug_Msg (S : String; N : Name_Id); + procedure Debug_Msg (S : String; N : File_Name_Type); + procedure Debug_Msg (S : String; N : Unit_Name_Type); -- If Debug.Debug_Flag_W is set outputs string S followed by name N procedure Recursive_Compute_Depth @@ -554,7 +592,7 @@ package body Make is -- Check what steps (Compile, Bind, Link) must be executed. -- Set the step flags accordingly. - function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean; + function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean; -- Get directory prefix of this file and get lib mark stored in name -- table for this directory. Then check if an Ada lib mark has been set. @@ -577,7 +615,7 @@ package body Make is -- compiler. function Switches_Of - (Source_File : Name_Id; + (Source_File : File_Name_Type; Source_File_Name : String; Source_Index : Int; Naming : Naming_Data; @@ -612,11 +650,11 @@ package body Make is -- Given by the command line. Will be used, if non null Gcc_Path : String_Access := - GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); + System.OS_Lib.Locate_Exec_On_Path (Gcc.all); Gnatbind_Path : String_Access := - GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); + System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); Gnatlink_Path : String_Access := - GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); + System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); -- Path for compiler, binder, linker programs, defaulted now for gnatdist. -- Changed later if overridden on command line. @@ -721,14 +759,17 @@ package body Make is -- Displays Program followed by the arguments in Args if variable -- Display_Executed_Programs is set. The lower bound of Args must be 1. + procedure Report_Compilation_Failed; + -- Delete all temporary files and fail graciously + ----------------- -- Mapping files ----------------- - type Temp_File_Names is - array (Project_Id range <>, Positive range <>) of Name_Id; + type Temp_Path_Names is + array (Project_Id range <>, Positive range <>) of Path_Name_Type; - type Temp_Files_Ptr is access Temp_File_Names; + type Temp_Path_Ptr is access Temp_Path_Names; type Indices is array (Project_Id range <>) of Natural; @@ -739,7 +780,7 @@ package body Make is type Free_Indices_Ptr is access Free_File_Indices; - The_Mapping_File_Names : Temp_Files_Ptr; + The_Mapping_File_Names : Temp_Path_Ptr; -- For each project, the name ids of the temporary mapping files used Last_Mapping_File_Names : Indices_Ptr; @@ -771,6 +812,186 @@ package body Make is procedure Delete_All_Temp_Files; -- Delete all temp files (config files, mapping files, path files) + ------------------------------------------------- + -- Subprogram declarations moved from the spec -- + ------------------------------------------------- + + procedure Bind (ALI_File : File_Name_Type; Args : Argument_List); + -- Binds ALI_File. Args are the arguments to pass to the binder. + -- Args must have a lower bound of 1. + + procedure Display_Commands (Display : Boolean := True); + -- The default behavior of Make commands (Compile_Sources, Bind, Link) + -- is to display them on stderr. This behavior can be changed repeatedly + -- by invoking this procedure. + + -- If a compilation, bind or link failed one of the following 3 exceptions + -- is raised. These need to be handled by the calling routines. + + procedure Compile_Sources + (Main_Source : File_Name_Type; + Args : Argument_List; + First_Compiled_File : out File_Name_Type; + Most_Recent_Obj_File : out File_Name_Type; + Most_Recent_Obj_Stamp : out Time_Stamp_Type; + Main_Unit : out Boolean; + Compilation_Failures : out Natural; + Main_Index : Int := 0; + Check_Readonly_Files : Boolean := False; + Do_Not_Execute : Boolean := False; + Force_Compilations : Boolean := False; + Keep_Going : Boolean := False; + In_Place_Mode : Boolean := False; + Initialize_ALI_Data : Boolean := True; + Max_Process : Positive := 1); + -- Compile_Sources will recursively compile all the sources needed by + -- Main_Source. Before calling this routine make sure Namet has been + -- initialized. This routine can be called repeatedly with different + -- Main_Source file as long as all the source (-I flags), library + -- (-B flags) and ada library (-A flags) search paths between calls are + -- *exactly* the same. The default directory must also be the same. + -- + -- Args contains the arguments to use during the compilations. + -- The lower bound of Args must be 1. + -- + -- First_Compiled_File is set to the name of the first file that is + -- compiled or that needs to be compiled. This is set to No_Name if no + -- compilations were needed. + -- + -- Most_Recent_Obj_File is set to the full name of the most recent + -- object file found when no compilations are needed, that is when + -- First_Compiled_File is set to No_Name. When First_Compiled_File + -- is set then Most_Recent_Obj_File is set to No_Name. + -- + -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File. + -- + -- Main_Unit is set to True if Main_Source can be a main unit. + -- If Do_Not_Execute is False and First_Compiled_File /= No_Name + -- the value of Main_Unit is always False. + -- Is this used any more??? It is certainly not used by gnatmake??? + -- + -- Compilation_Failures is a count of compilation failures. This count + -- is used to extract compilation failure reports with Extract_Failure. + -- + -- Main_Index, when not zero, is the index of the main unit in source + -- file Main_Source which is a multi-unit source. + -- Zero indicates that Main_Source is a single unit source file. + -- + -- Check_Readonly_Files set it to True to compile source files + -- which library files are read-only. When compiling GNAT predefined + -- files the "-gnatg" flag is used. + -- + -- Do_Not_Execute set it to True to find out the first source that + -- needs to be recompiled, but without recompiling it. This file is + -- saved in First_Compiled_File. + -- + -- Force_Compilations forces all compilations no matter what but + -- recompiles read-only files only if Check_Readonly_Files + -- is set. + -- + -- Keep_Going when True keep compiling even in the presence of + -- compilation errors. + -- + -- In_Place_Mode when True save library/object files in their object + -- directory if they already exist; otherwise, in the source directory. + -- + -- Initialize_ALI_Data set it to True when you want to initialize ALI + -- data-structures. This is what you should do most of the time. + -- (especially the first time around when you call this routine). + -- This parameter is set to False to preserve previously recorded + -- ALI file data. + -- + -- Max_Process is the maximum number of processes that should be spawned + -- to carry out compilations. + -- + -- Flags in Package Opt Affecting Compile_Sources + -- ----------------------------------------------- + -- + -- Check_Object_Consistency set it to False to omit all consistency + -- checks between an .ali file and its corresponding object file. + -- When this flag is set to true, every time an .ali is read, + -- package Osint checks that the corresponding object file + -- exists and is more recent than the .ali. + -- + -- Use of Name Table Info + -- ---------------------- + -- + -- All file names manipulated by Compile_Sources are entered into the + -- Names table. The Byte field of a source file is used to mark it. + -- + -- Calling Compile_Sources Several Times + -- ------------------------------------- + -- + -- Upon return from Compile_Sources all the ALI data structures are left + -- intact for further browsing. HOWEVER upon entry to this routine ALI + -- data structures are re-initialized if parameter Initialize_ALI_Data + -- above is set to true. Typically this is what you want the first time + -- you call Compile_Sources. You should not load an ali file, call this + -- routine with flag Initialize_ALI_Data set to True and then expect + -- that ALI information to be around after the call. Note that the first + -- time you call Compile_Sources you better set Initialize_ALI_Data to + -- True unless you have called Initialize_ALI yourself. + -- + -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source) + -- ------------------------- + -- + -- 1. Insert Main_Source in a Queue (Q) and mark it. + -- + -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is + -- missing but its corresponding ali file is in an Ada library directory + -- (see below) then, remove unit.adb from the Q and goto step 4. + -- Otherwise, look at the files under the D (dependency) section of + -- unit.ali. If unit.ali does not exist or some of the time stamps do + -- not match, (re)compile unit.adb. + -- + -- An Ada library directory is a directory containing Ada specs, ali + -- and object files but no source files for the bodies. An Ada library + -- directory is communicated to gnatmake by means of some switch so that + -- gnatmake can skip the sources whole ali are in that directory. + -- There are two reasons for skipping the sources in this case. Firstly, + -- Ada libraries typically come without full sources but binding and + -- linking against those libraries is still possible. Secondly, it would + -- be very wasteful for gnatmake to systematically check the consistency + -- of every external Ada library used in a program. The binder is + -- already in charge of catching any potential inconsistencies. + -- + -- 3. Look into the W section of unit.ali and insert into the Q all + -- unmarked source files. Mark all files newly inserted in the Q. + -- Specifically, assuming that the W section looks like + -- + -- W types%s types.adb types.ali + -- W unchecked_deallocation%s + -- W xref_tab%s xref_tab.adb xref_tab.ali + -- + -- Then xref_tab.adb and types.adb are inserted in the Q if they are not + -- already marked. + -- Note that there is no file listed under W unchecked_deallocation%s + -- so no generic body should ever be explicitly compiled (unless the + -- Main_Source at the start was a generic body). + -- + -- 4. Repeat steps 2 and 3 above until the Q is empty + -- + -- Note that the above algorithm works because the units withed in + -- subunits are transitively included in the W section (with section) of + -- the main unit. Likewise the withed units in a generic body needed + -- during a compilation are also transitively included in the W section + -- of the originally compiled file. + + procedure Initialize; + -- Performs default and package initialization. Therefore, + -- Compile_Sources can be called by an external unit. + + procedure Link + (ALI_File : File_Name_Type; + Args : Argument_List; + Success : out Boolean); + -- Links ALI_File. Args are the arguments to pass to the linker. + -- Args must have a lower bound of 1. Success indicates if the link + -- succeeded or not. + + procedure Scan_Make_Arg (Argv : String; And_Save : Boolean); + -- Scan make arguments. Argv is a single argument to be processed + ------------------- -- Add_Arguments -- ------------------- @@ -797,16 +1018,6 @@ package body Make is Last_Argument := Last_Argument + Args'Length; end Add_Arguments; - -------------------- - -- Add_Dependency -- - -------------------- - - procedure Add_Dependency (S : Name_Id; On : Name_Id) is - begin - Dependencies.Increment_Last; - Dependencies.Table (Dependencies.Last) := (S, On); - end Add_Dependency; - ---------------------------- -- Add_Library_Search_Dir -- ---------------------------- @@ -817,15 +1028,13 @@ package body Make is is begin if On_Command_Line then - Add_Lib_Search_Dir - (Normalize_Pathname (Path)); + Add_Lib_Search_Dir (Normalize_Pathname (Path)); else Get_Name_String - (Project_Tree.Projects.Table (Main_Project).Directory); + (Project_Tree.Projects.Table (Main_Project).Display_Directory); Add_Lib_Search_Dir - (Normalize_Pathname - (Path, Name_Buffer (1 .. Name_Len))); + (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len))); end if; end Add_Library_Search_Dir; @@ -871,15 +1080,13 @@ package body Make is is begin if On_Command_Line then - Add_Src_Search_Dir - (Normalize_Pathname (Path)); + Add_Src_Search_Dir (Normalize_Pathname (Path)); else Get_Name_String - (Project_Tree.Projects.Table (Main_Project).Directory); + (Project_Tree.Projects.Table (Main_Project).Display_Directory); Add_Src_Search_Dir - (Normalize_Pathname - (Path, Name_Buffer (1 .. Name_Len))); + (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len))); end if; end Add_Source_Search_Dir; @@ -1027,8 +1234,7 @@ package body Make is Switch_List := Switches.Values; while Switch_List /= Nil_String loop - Element := - Project_Tree.String_Elements.Table (Switch_List); + Element := Project_Tree.String_Elements.Table (Switch_List); Get_Name_String (Element.Value); if Name_Len > 0 then @@ -1109,7 +1315,7 @@ package body Make is Bind_Last := Bind_Last + 1; Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len)); - GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last)); + System.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last)); Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last)); @@ -1117,11 +1323,11 @@ package body Make is Make_Failed ("error, unable to locate ", Gnatbind.all); end if; - GNAT.OS_Lib.Spawn + System.OS_Lib.Spawn (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success); if not Success then - raise Bind_Failed; + Make_Failed ("*** bind failed."); end if; end Bind; @@ -1130,7 +1336,8 @@ package body Make is -------------------------------- procedure Change_To_Object_Directory (Project : Project_Id) is - Actual_Project : Project_Id; + Actual_Project : Project_Id; + Object_Directory : Path_Name_Type; begin -- For sources outside of any project, compilation occurs in the object @@ -1145,17 +1352,24 @@ package body Make is -- Nothing to do if the current working directory is already the correct -- object directory. - if Project_Object_Directory /= Actual_Project then - Project_Object_Directory := Actual_Project; + if Project_Of_Current_Object_Directory /= Actual_Project then + Project_Of_Current_Object_Directory := Actual_Project; + Object_Directory := + Project_Tree.Projects.Table (Actual_Project).Object_Directory; -- Set the working directory to the object directory of the actual -- project. - Change_Dir - (Get_Name_String - (Project_Tree.Projects.Table - (Actual_Project).Object_Directory)); + if Verbose_Mode then + Write_Str ("Changing to object directory of """); + Write_Name + (Project_Tree.Projects.Table (Actual_Project).Display_Name); + Write_Str (""": """); + Write_Name (Object_Directory); + Write_Line (""""); + end if; + Change_Dir (Get_Name_String (Object_Directory)); end if; exception @@ -1209,7 +1423,7 @@ package body Make is function New_Spec (Uname : Unit_Name_Type) return Boolean; -- Uname is the name of the spec or body of some ada unit. This -- function returns True if the Uname is the name of a body which has - -- a spec not mentioned inali file A. If True is returned + -- a spec not mentioned in ALI file A. If True is returned -- Spec_File_Name above is set to the name of this spec file. -------------- @@ -1310,7 +1524,7 @@ package body Make is -- appear in the Sdep section of Lib_File, New_Spec contains the file -- name of this new spec. - Source_Name : Name_Id; + Source_Name : File_Name_Type; Text : Text_Buffer_Ptr; Prev_Switch : String_Access; @@ -1733,7 +1947,7 @@ package body Make is -- Process linker options from the ALI files for Opt in 1 .. Linker_Options.Last loop - Check_File (Linker_Options.Table (Opt).Name); + Check_File (File_Name_Type (Linker_Options.Table (Opt).Name)); end loop; -- Process options given on the command line @@ -1831,8 +2045,7 @@ package body Make is while Data.Extended_By /= No_Project loop Arguments_Project := Data.Extended_By; - Data := - Project_Tree.Projects.Table (Arguments_Project); + Data := Project_Tree.Projects.Table (Arguments_Project); end loop; -- If building a dynamic or relocatable library, compile with @@ -1856,8 +2069,8 @@ package body Make is Data; end if; - -- We now look for package Compiler - -- and get the switches from this package. + -- We now look for package Compiler and get the switches from + -- this package. Compiler_Package := Prj.Util.Value_Of @@ -1867,17 +2080,18 @@ package body Make is if Compiler_Package /= No_Package then - -- If package Gnatmake.Compiler exists, we get - -- the specific switches for the current source, - -- or the global switches, if any. + -- If package Gnatmake.Compiler exists, we get the specific + -- switches for the current source, or the global switches, + -- if any. - Switches := Switches_Of - (Source_File => Source_File, - Source_File_Name => Source_File_Name, - Source_Index => Source_Index, - Naming => Data.Naming, - In_Package => Compiler_Package, - Allow_ALI => False); + Switches := + Switches_Of + (Source_File => Source_File, + Source_File_Name => Source_File_Name, + Source_Index => Source_Index, + Naming => Data.Naming, + In_Package => Compiler_Package, + Allow_ALI => False); end if; @@ -1978,8 +2192,8 @@ package body Make is procedure Compile_Sources (Main_Source : File_Name_Type; Args : Argument_List; - First_Compiled_File : out Name_Id; - Most_Recent_Obj_File : out Name_Id; + First_Compiled_File : out File_Name_Type; + Most_Recent_Obj_File : out File_Name_Type; Most_Recent_Obj_Stamp : out Time_Stamp_Type; Main_Unit : out Boolean; Compilation_Failures : out Natural; @@ -2035,6 +2249,9 @@ package body Make is Sfile : File_Name_Type; -- Contains the source file of the units withed by Source_File + Uname : Unit_Name_Type; + -- Contains the unit name of the units withed by Source_File + ALI : ALI_Id; -- ALI Id of the current ALI file @@ -2097,14 +2314,14 @@ package body Make is -- Collect arguments from project file (if any) and compile function Compile - (S : Name_Id; - L : Name_Id; + (S : File_Name_Type; + L : File_Name_Type; Source_Index : Int; Args : Argument_List) return Process_Id; - -- Compiles S using Args. If S is a GNAT predefined source - -- "-gnatpg" is added to Args. Non blocking call. L corresponds to the - -- expected library file name. Process_Id of the process spawned to - -- execute the compile. + -- Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is + -- added to Args. Non blocking call. L corresponds to the expected + -- library file name. Process_Id of the process spawned to execute the + -- compilation. package Good_ALI is new Table.Table ( Table_Component_Type => ALI_Id, @@ -2172,10 +2389,10 @@ package body Make is procedure Await_Compile (Sfile : out File_Name_Type; Afile : out File_Name_Type; - Uname : out File_Name_Type; + Uname : out Unit_Name_Type; OK : out Boolean) is - Pid : Process_Id; + Pid : Process_Id; Project : Project_Id; begin @@ -2183,7 +2400,7 @@ package body Make is Sfile := No_File; Afile := No_File; - Uname := No_Name; + Uname := No_Unit_Name; OK := False; -- The loop here is a work-around for a problem on VMS; in some @@ -2262,7 +2479,7 @@ package body Make is if not Targparm.Suppress_Standard_Library_On_Target then declare - Sfile : Name_Id; + Sfile : File_Name_Type; Add_It : Boolean := True; begin @@ -2350,8 +2567,7 @@ package body Make is if not Project_Tree.Projects.Table (Arguments_Project).Externally_Built then - Prj.Env.Set_Ada_Paths - (Arguments_Project, Project_Tree, True); + Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True); if not Unique_Compile and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None @@ -2395,6 +2611,11 @@ package body Make is Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index, Arguments (1 .. Last_Argument)); + + -- Register compiled unit into Full_Source_File as this is the + -- variable used to report errors. + + Full_Source_File := Arguments_Path_Name; Process_Created := True; end if; @@ -2417,8 +2638,8 @@ package body Make is ------------- function Compile - (S : Name_Id; - L : Name_Id; + (S : File_Name_Type; + L : File_Name_Type; Source_Index : Int; Args : Argument_List) return Process_Id is @@ -2427,7 +2648,7 @@ package body Make is Comp_Last : Integer; Arg_Index : Integer; - function Ada_File_Name (Name : Name_Id) return Boolean; + function Ada_File_Name (Name : File_Name_Type) return Boolean; -- Returns True if Name is the name of an ada source file -- (i.e. suffix is .ads or .adb) @@ -2435,7 +2656,7 @@ package body Make is -- Ada_File_Name -- ------------------- - function Ada_File_Name (Name : Name_Id) return Boolean is + function Ada_File_Name (Name : File_Name_Type) return Boolean is begin Get_Name_String (Name); return @@ -2552,9 +2773,9 @@ package body Make is end; end if; - if Source_Index /= 0 or else - L /= Strip_Directory (L) or else - Object_Directory_Path /= null + if Source_Index /= 0 + or else L /= Strip_Directory (L) + or else Object_Directory_Path /= null then -- Build -o argument @@ -2596,7 +2817,8 @@ package body Make is Comp_Last := Comp_Last + 1; Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len)); - GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last)); + System.OS_Lib.Normalize_Arguments + (Comp_Args (Args'First .. Comp_Last)); Comp_Last := Comp_Last + 1; Comp_Args (Comp_Last) := new String'("-gnatez"); @@ -2608,7 +2830,7 @@ package body Make is end if; return - GNAT.OS_Lib.Non_Blocking_Spawn + System.OS_Lib.Non_Blocking_Spawn (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last)); end Compile; @@ -2697,7 +2919,6 @@ package body Make is -- Package and Queue initializations Good_ALI.Init; - Output.Set_Standard_Error; if First_Q_Initialization then Init_Q; @@ -2877,9 +3098,9 @@ package body Make is -- Check that switch -x has been used if a source -- outside of project files need to be compiled. - if Main_Project /= No_Project and then - Arguments_Project = No_Project and then - not External_Unit_Compilation_Allowed + if Main_Project /= No_Project + and then Arguments_Project = No_Project + and then not External_Unit_Compilation_Allowed then Make_Failed ("external source (", Get_Name_String (Source_File), @@ -2929,6 +3150,7 @@ package body Make is if Process_Created then if Pid = Invalid_Pid then Record_Failure (Full_Source_File, Source_Unit); + else Add_Process (Pid, @@ -3078,7 +3300,49 @@ package body Make is Units.Table (J).First_With .. Units.Table (J).Last_With loop Sfile := Withs.Table (K).Sfile; - Add_Dependency (ALIs.Table (ALI).Sfile, Sfile); + Uname := Withs.Table (K).Uname; + + -- If project files are used, find the proper source + -- to compile, in case Sfile is the spec, but there + -- is a body. + + if Main_Project /= No_Project then + declare + Unit_Name : Name_Id; + Uid : Prj.Unit_Id; + Udata : Unit_Data; + + begin + Get_Name_String (Uname); + Name_Len := Name_Len - 2; + Unit_Name := Name_Find; + Uid := + Units_Htable.Get + (Project_Tree.Units_HT, Unit_Name); + + if Uid /= Prj.No_Unit then + Udata := Project_Tree.Units.Table (Uid); + + if Udata.File_Names (Body_Part).Name /= + No_File + then + Sfile := Udata.File_Names (Body_Part).Name; + Source_Index := + Udata.File_Names (Body_Part).Index; + + elsif Udata.File_Names (Specification).Name /= + No_File + then + Sfile := + Udata.File_Names (Specification).Name; + Source_Index := + Udata.File_Names (Specification).Index; + end if; + end if; + end; + end if; + + Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile)); if Is_In_Obsoleted (Sfile) then Executable_Obsolete := True; @@ -3101,8 +3365,7 @@ package body Make is Debug_Msg ("Skipping internal file:", Sfile); else - Insert_Q - (Sfile, Withs.Table (K).Uname, Source_Index); + Insert_Q (Sfile, Uname, Source_Index); Mark (Sfile, Source_Index); end if; end if; @@ -3244,7 +3507,7 @@ package body Make is Last : Natural := 0; function Absolute_Path - (Path : Name_Id; + (Path : File_Name_Type; Project : Project_Id) return String; -- Returns an absolute path for a configuration pragmas file @@ -3253,7 +3516,7 @@ package body Make is ------------------- function Absolute_Path - (Path : Name_Id; + (Path : File_Name_Type; Project : Project_Id) return String is begin @@ -3271,7 +3534,7 @@ package body Make is Parent_Directory : constant String := Get_Name_String (Project_Tree.Projects.Table - (Project).Directory); + (Project).Display_Directory); begin if Parent_Directory (Parent_Directory'Last) = @@ -3294,7 +3557,7 @@ package body Make is (For_Project, Main_Project, Project_Tree); if Project_Tree.Projects.Table - (For_Project).Config_File_Name /= No_Name + (For_Project).Config_File_Name /= No_Path then Temporary_Config_File := Project_Tree.Projects.Table (For_Project).Config_File_Temp; @@ -3334,7 +3597,9 @@ package body Make is declare Path : constant String := Absolute_Path - (Global_Attribute.Value, Global_Attribute.Project); + (File_Name_Type (Global_Attribute.Value), + Global_Attribute.Project); + begin if not Is_Regular_File (Path) then Make_Failed @@ -3371,7 +3636,9 @@ package body Make is declare Path : constant String := Absolute_Path - (Local_Attribute.Value, Local_Attribute.Project); + (File_Name_Type (Local_Attribute.Value), + Local_Attribute.Project); + begin if not Is_Regular_File (Path) then Make_Failed @@ -3402,6 +3669,16 @@ package body Make is end if; end Debug_Msg; + procedure Debug_Msg (S : String; N : File_Name_Type) is + begin + Debug_Msg (S, Name_Id (N)); + end Debug_Msg; + + procedure Debug_Msg (S : String; N : Unit_Name_Type) is + begin + Debug_Msg (S, Name_Id (N)); + end Debug_Msg; + --------------------------- -- Delete_All_Temp_Files -- --------------------------- @@ -3472,7 +3749,7 @@ package body Make is Project_Tree.Projects.Table (Project). Config_Checked := False; Project_Tree.Projects.Table (Project). - Config_File_Name := No_Name; + Config_File_Name := No_Path; Project_Tree.Projects.Table (Project). Config_File_Temp := False; end if; @@ -3489,10 +3766,6 @@ package body Make is pragma Assert (Args'First = 1); if Display_Executed_Programs then - if Commands_To_Stdout then - Set_Standard_Output; - end if; - Write_Str (Program); for J in Args'Range loop @@ -3540,7 +3813,6 @@ package body Make is end loop; Write_Eol; - Set_Standard_Error; end if; end Display; @@ -3580,12 +3852,13 @@ package body Make is -- Enter_Into_Obsoleted -- -------------------------- - procedure Enter_Into_Obsoleted (F : Name_Id) is + procedure Enter_Into_Obsoleted (F : File_Name_Type) is Name : constant String := Get_Name_String (F); - First : Natural := Name'Last; - F2 : Name_Id := F; + First : Natural; + F2 : File_Name_Type; begin + First := Name'Last; while First > Name'First and then Name (First - 1) /= Directory_Separator and then Name (First - 1) /= '/' @@ -3597,28 +3870,14 @@ package body Make is Name_Len := 0; Add_Str_To_Name_Buffer (Name (First .. Name'Last)); F2 := Name_Find; + else + F2 := F; end if; Debug_Msg ("New entry in Obsoleted table:", F2); Obsoleted.Set (F2, True); end Enter_Into_Obsoleted; - --------------------- - -- Extract_Failure -- - --------------------- - - procedure Extract_Failure - (File : out File_Name_Type; - Unit : out Unit_Name_Type; - Found : out Boolean) - is - begin - File := Bad_Compilation.Table (Bad_Compilation.Last).File; - Unit := Bad_Compilation.Table (Bad_Compilation.Last).Unit; - Found := Bad_Compilation.Table (Bad_Compilation.Last).Found; - Bad_Compilation.Decrement_Last; - end Extract_Failure; - -------------------- -- Extract_From_Q -- -------------------- @@ -3690,7 +3949,7 @@ package body Make is -- Set to True when there are Stand-Alone Libraries, so that gnatbind -- is invoked with the -F switch to force checking of elaboration flags. - Mapping_Path : Name_Id := No_Name; + Mapping_Path : Path_Name_Type := No_Path; -- The path name of the mapping file Discard : Boolean; @@ -3808,6 +4067,7 @@ package body Make is if Normed_Path /= Proj_Path then if Verbose_Mode then + Set_Standard_Error; Write_Str (Normed_Path); Write_Str (" /= "); Write_Line (Proj_Path); @@ -3863,19 +4123,19 @@ package body Make is Mapping_FD : File_Descriptor := Invalid_FD; -- A File Descriptor for an eventual mapping file - ALI_Unit : Name_Id := No_Name; + ALI_Unit : Unit_Name_Type := No_Unit_Name; -- The unit name of an ALI file - ALI_Name : Name_Id := No_Name; + ALI_Name : File_Name_Type := No_File; -- The file name of the ALI file - ALI_Project : Project_Id := No_Project; + ALI_Project : Project_Id := No_Project; -- The project of the ALI file - Bytes : Integer; - OK : Boolean := True; + Bytes : Integer; + OK : Boolean := True; - Status : Boolean; + Status : Boolean; -- For call to Close begin @@ -3889,49 +4149,46 @@ package body Make is Unit_Table.Last (Project_Tree.Units) loop declare - Unit : constant Unit_Data := - Project_Tree.Units.Table (J); + Unit : constant Unit_Data := Project_Tree.Units.Table (J); + begin if Unit.Name /= No_Name then -- If there is a body, put it in the mapping - if Unit.File_Names (Body_Part).Name /= No_Name + if Unit.File_Names (Body_Part).Name /= No_File and then Unit.File_Names (Body_Part).Project /= No_Project then Get_Name_String (Unit.Name); - Name_Buffer - (Name_Len + 1 .. Name_Len + 2) := "%b"; + Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b"; Name_Len := Name_Len + 2; ALI_Unit := Name_Find; ALI_Name := Lib_File_Name - (Unit.File_Names (Body_Part).Name); + (Unit.File_Names (Body_Part).Display_Name); ALI_Project := Unit.File_Names (Body_Part).Project; -- Otherwise, if there is a spec, put it -- in the mapping. - elsif Unit.File_Names (Specification).Name - /= No_Name - and then Unit.File_Names - (Specification).Project - /= No_Project + elsif Unit.File_Names (Specification).Name /= No_File + and then Unit.File_Names (Specification).Project /= + No_Project then Get_Name_String (Unit.Name); - Name_Buffer - (Name_Len + 1 .. Name_Len + 2) := "%s"; + Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s"; Name_Len := Name_Len + 2; ALI_Unit := Name_Find; - ALI_Name := Lib_File_Name - (Unit.File_Names (Specification).Name); + ALI_Name := + Lib_File_Name + (Unit.File_Names (Specification).Display_Name); ALI_Project := Unit.File_Names (Specification).Project; else - ALI_Name := No_Name; + ALI_Name := No_File; end if; -- If we have something to put in the mapping @@ -3942,7 +4199,7 @@ package body Make is -- ended project obj dir as well as in the -- extending project obj dir. - if ALI_Name /= No_Name + if ALI_Name /= No_File and then Project_Tree.Projects.Table (ALI_Project).Extended_By = No_Project @@ -4021,7 +4278,7 @@ package body Make is exit when not OK; - -- Third line it the ALI path name. + -- Third line it the ALI path name Bytes := Write @@ -4081,17 +4338,6 @@ package body Make is Failed_Links.Set_Last (0); Successful_Links.Set_Last (0); - if Hostparm.Java_VM then - Gcc := new String'("jgnat"); - Gnatbind := new String'("jgnatbind"); - Gnatlink := new String'("jgnatlink"); - - -- Do not check for an object file (".o") when compiling to - -- Java bytecode since ".class" files are generated instead. - - Check_Object_Consistency := False; - end if; - -- Special case when switch -B was specified if Build_Bind_And_Link_Full_Project then @@ -4178,7 +4424,7 @@ package body Make is declare Value : String_List_Id := - Project_Tree.Projects.Table (Main_Project).Mains; + Project_Tree.Projects.Table (Main_Project).Mains; begin -- The attribute Main is an empty list or not specified, @@ -4389,7 +4635,7 @@ package body Make is Do_Not_Execute := True; end if; - -- Note that Osint.Next_Main_Source will always return the (possibly + -- Note that Osint.M.Next_Main_Source will always return the (possibly -- abbreviated file) without any directory information. Main_Source_File := Next_Main_Source; @@ -4439,11 +4685,11 @@ package body Make is if Main_Project /= No_Project then if Project_Tree.Projects.Table - (Main_Project).Object_Directory /= No_Name + (Main_Project).Object_Directory /= No_Path then -- Change current directory to object directory of main project - Project_Object_Directory := No_Project; + Project_Of_Current_Object_Directory := No_Project; Change_To_Object_Directory (Main_Project); end if; @@ -4466,25 +4712,26 @@ package body Make is not Unique_Compile); The_Packages : constant Package_Id := - Project_Tree.Projects.Table (Main_Project).Decl.Packages; + Project_Tree.Projects.Table + (Main_Project).Decl.Packages; Builder_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Builder, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Builder, + In_Packages => The_Packages, + In_Tree => Project_Tree); Binder_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Binder, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Binder, + In_Packages => The_Packages, + In_Tree => Project_Tree); Linker_Package : constant Prj.Package_Id := - Prj.Util.Value_Of - (Name => Name_Linker, - In_Packages => The_Packages, - In_Tree => Project_Tree); + Prj.Util.Value_Of + (Name => Name_Linker, + In_Packages => The_Packages, + In_Tree => Project_Tree); begin -- We fail if we cannot find the main source file @@ -4655,12 +4902,36 @@ package body Make is begin Targparm.Get_Target_Parameters; - exception when Unrecoverable_Error => Make_Failed ("*** make failed."); end; + -- Special processing for VM targets + + if Targparm.VM_Target /= No_VM then + + -- Do not check for an object file (".o") when compiling to VM + -- machine since ".class" files are generated instead. + + Check_Object_Consistency := False; + + -- Set proper processing commands + + case Targparm.VM_Target is + when Targparm.JVM_Target => + Gcc := new String'("jgnat"); + Gnatbind := new String'("jgnatbind"); + Gnatlink := new String'("jgnatlink"); + + when Targparm.CLI_Target => + Gcc := new String'("dotnet-gnatcompile"); + + when Targparm.No_VM => + raise Program_Error; + end case; + end if; + Display_Commands (not Quiet_Output); Check_Steps; @@ -4684,14 +4955,13 @@ package body Make is and then (not Project_Tree.Projects.Table (Proj).Externally_Built); - if Project_Tree.Projects.Table - (Proj).Need_To_Build_Lib - then + if Project_Tree.Projects.Table (Proj).Need_To_Build_Lib then + -- If there is no object directory, then it will be -- impossible to build the library. So fail immediately. - if Project_Tree.Projects.Table - (Proj).Object_Directory = No_Name + if Project_Tree.Projects.Table (Proj).Object_Directory = + No_Path then Make_Failed ("no object files to build library for project """, @@ -4729,7 +4999,7 @@ package body Make is if Saved_Linker_Switches.Table (J).all = Output_Flag.all then declare Exec_File_Name : constant String := - Saved_Linker_Switches.Table (J + 1).all; + Saved_Linker_Switches.Table (J + 1).all; begin if not Is_Absolute_Path (Exec_File_Name) then @@ -4762,9 +5032,9 @@ package body Make is declare Dir_Path : constant String_Access := - new String'(Get_Name_String - (Project_Tree.Projects.Table - (Main_Project).Directory)); + new String'(Get_Name_String + (Project_Tree.Projects.Table + (Main_Project).Directory)); begin for J in 1 .. Binder_Switches.Last loop Test_If_Relative_Path @@ -4865,9 +5135,9 @@ package body Make is Gnatlink := Saved_Gnatlink; end if; - Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); - Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); - Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); + Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all); + Gnatbind_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); + Gnatlink_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); -- If we have specified -j switch both from the project file -- and on the command line, the one from the command line takes @@ -4881,7 +5151,7 @@ package body Make is -- number of compilation processed, for each possible project. The_Mapping_File_Names := - new Temp_File_Names + new Temp_Path_Names (No_Project .. Project_Table.Last (Project_Tree.Projects), 1 .. Saved_Maximum_Processes); Last_Mapping_File_Names := @@ -4966,13 +5236,13 @@ package body Make is if Main_Project /= No_Project then declare Exec_File_Name : constant String := - Get_Name_String (Executable); + Get_Name_String (Executable); begin if not Is_Absolute_Path (Exec_File_Name) then Get_Name_String (Project_Tree.Projects.Table - (Main_Project).Exec_Directory); + (Main_Project).Display_Exec_Dir); if Name_Buffer (Name_Len) /= Directory_Separator @@ -4995,16 +5265,16 @@ package body Make is if Do_Compile_Step then Recursive_Compilation_Step : declare - Args : Argument_List (1 .. Gcc_Switches.Last); + Args : Argument_List (1 .. Gcc_Switches.Last); - First_Compiled_File : Name_Id; - Youngest_Obj_File : Name_Id; + First_Compiled_File : File_Name_Type; + Youngest_Obj_File : File_Name_Type; Youngest_Obj_Stamp : Time_Stamp_Type; - Executable_Stamp : Time_Stamp_Type; + Executable_Stamp : Time_Stamp_Type; -- Executable is the final executable program - Library_Rebuilt : Boolean := False; + Library_Rebuilt : Boolean := False; begin for J in 1 .. Gcc_Switches.Last loop @@ -5047,7 +5317,7 @@ package body Make is goto Next_Main; else List_Bad_Compilations; - raise Compilation_Failed; + Report_Compilation_Failed; end if; end if; @@ -5076,7 +5346,7 @@ package body Make is -------------------------- procedure Add_To_Library_Projs (Proj : Project_Id) is - Prj : Project_Id; + Prj : Project_Id; begin Library_Projs.Increment_Last; @@ -5269,10 +5539,10 @@ package body Make is -- since there is currently no simple way to check the -- up-to-date status of objects - if not Hostparm.Java_VM + if Targparm.VM_Target = No_VM and then First_Compiled_File = No_File then - Executable_Stamp := File_Stamp (Executable); + Executable_Stamp := File_Stamp (Executable); if not Executable_Obsolete then Executable_Obsolete := @@ -5327,9 +5597,7 @@ package body Make is elsif Youngest_Obj_Stamp (1) = ' ' then Verbose_Msg - (Youngest_Obj_File, - "missing.", - Prefix => " "); + (Youngest_Obj_File, "missing.", Prefix => " "); elsif Youngest_Obj_Stamp > Executable_Stamp then Verbose_Msg @@ -5340,8 +5608,7 @@ package body Make is else Verbose_Msg - (Executable, "needs to be rebuild.", - Prefix => " "); + (Executable, "needs to be rebuilt", Prefix => " "); end if; end if; @@ -5402,8 +5669,7 @@ package body Make is -- Check if there are shared libraries, so that gnatbind is -- called with -shared. Check also if gnatbind is called with -- -shared, so that gnatlink is called with -shared-libgcc - -- for GCC version 3 and above, ensuring that the shared - -- version of libgcc will be used. + -- ensuring that the shared version of libgcc will be used. if Main_Project /= No_Project and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None @@ -5434,9 +5700,9 @@ package body Make is end if; -- If there are shared libraries, invoke gnatlink with - -- -shared-libgcc if GCC version is 3 or more. + -- -shared-libgcc. - if Shared_Libs and then GCC_Version >= 3 then + if Shared_Libs then Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access; end if; @@ -5477,7 +5743,7 @@ package body Make is -- file, if one was created. if not Debug.Debug_Flag_N - and then Mapping_Path /= No_Name + and then Mapping_Path /= No_Path then Delete_File (Get_Name_String (Mapping_Path), Discard); end if; @@ -5490,7 +5756,7 @@ package body Make is -- If -dn was not specified, delete the temporary mapping file, -- if one was created. - if not Debug.Debug_Flag_N and then Mapping_Path /= No_Name then + if not Debug.Debug_Flag_N and then Mapping_Path /= No_Path then Delete_File (Get_Name_String (Mapping_Path), Discard); end if; end Bind_Step; @@ -5498,13 +5764,13 @@ package body Make is if Do_Link_Step then Link_Step : declare - There_Are_Libraries : Boolean := False; Linker_Switches_Last : constant Integer := Linker_Switches.Last; - Path_Option : constant String_Access := - MLib.Linker_Library_Path_Option; - Current : Natural; - Proj2 : Project_Id; - Depth : Natural; + Path_Option : constant String_Access := + MLib.Linker_Library_Path_Option; + There_Are_Libraries : Boolean := False; + Current : Natural; + Proj2 : Project_Id; + Depth : Natural; begin if not Run_Path_Option then @@ -5530,8 +5796,7 @@ package body Make is -- Add this project to table Library_Projs There_Are_Libraries := True; - Depth := - Project_Tree.Projects.Table (Proj1).Depth; + Depth := Project_Tree.Projects.Table (Proj1).Depth; Library_Projs.Increment_Last; Current := Library_Projs.Last; @@ -5560,7 +5825,7 @@ package body Make is new String' (Get_Name_String (Project_Tree.Projects.Table - (Proj1).Library_Dir)); + (Proj1).Display_Library_Dir)); end if; end if; end loop; @@ -5574,7 +5839,7 @@ package body Make is Get_Name_String (Project_Tree.Projects.Table (Library_Projs.Table (Index)). - Library_Dir)); + Display_Library_Dir)); -- Add the -l switch @@ -5712,25 +5977,34 @@ package body Make is -- And invoke the linker + declare + Success : Boolean := False; begin Link (Main_ALI_File, Link_With_Shared_Libgcc.all & - Args (Args'First .. Last_Arg)); - Successful_Links.Increment_Last; - Successful_Links.Table (Successful_Links.Last) := - Main_ALI_File; + Args (Args'First .. Last_Arg), + Success); - exception - when Link_Failed => - if Osint.Number_Of_Files = 1 or not Keep_Going then - raise; + if Success then + Successful_Links.Increment_Last; + Successful_Links.Table (Successful_Links.Last) := + Main_ALI_File; - else - Write_Line ("*** link failed"); - Failed_Links.Increment_Last; - Failed_Links.Table (Failed_Links.Last) := - Main_ALI_File; + elsif Osint.Number_Of_Files = 1 or not Keep_Going then + Make_Failed ("*** link failed."); + + else + Set_Standard_Error; + Write_Line ("*** link failed"); + + if Commands_To_Stdout then + Set_Standard_Output; end if; + + Failed_Links.Increment_Last; + Failed_Links.Table (Failed_Links.Last) := + Main_ALI_File; + end if; end; end; @@ -5924,20 +6198,26 @@ package body Make is Write_Line (""" succeeded."); end loop; + Set_Standard_Error; + for Index in 1 .. Failed_Links.Last loop Write_Str ("Linking of """); Write_Str (Get_Name_String (Failed_Links.Table (Index))); Write_Line (""" failed."); end loop; + if Commands_To_Stdout then + Set_Standard_Output; + end if; + if Total_Compilation_Failures = 0 then - raise Compilation_Failed; + Report_Compilation_Failed; end if; end if; if Total_Compilation_Failures /= 0 then List_Bad_Compilations; - raise Compilation_Failed; + Report_Compilation_Failed; end if; -- Delete the temporary mapping file that was created if we are @@ -5948,24 +6228,9 @@ package body Make is Prj.Env.Delete_All_Path_Files (Project_Tree); end if; - Exit_Program (E_Success); - exception - when Bind_Failed => - Make_Failed ("*** bind failed."); - - when Compilation_Failed => - if not Debug.Debug_Flag_N then - Delete_Mapping_Files; - Prj.Env.Delete_All_Path_Files (Project_Tree); - end if; - - Exit_Program (E_Fatal); - - when Link_Failed => - Make_Failed ("*** link failed."); - when X : others => + Set_Standard_Error; Write_Line (Exception_Information (X)); Make_Failed ("INTERNAL ERROR. Please report."); end Gnatmake; @@ -5974,7 +6239,7 @@ package body Make is -- Hash -- ---------- - function Hash (F : Name_Id) return Header_Num is + function Hash (F : File_Name_Type) return Header_Num is begin return Header_Num (1 + F mod Max_Header); end Hash; @@ -5984,8 +6249,8 @@ package body Make is -------------------- function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is - D : constant Name_Id := Get_Directory (File); - B : constant Byte := Get_Name_Table_Byte (D); + D : constant File_Name_Type := Get_Directory (File); + B : constant Byte := Get_Name_Table_Byte (D); begin return (B and Ada_Lib_Dir) /= 0; end In_Ada_Lib_Dir; @@ -5994,7 +6259,7 @@ package body Make is -- Inform -- ------------ - procedure Inform (N : Name_Id := No_Name; Msg : String) is + procedure Inform (N : Name_Id; Msg : String) is begin Osint.Write_Program_Name; @@ -6010,6 +6275,19 @@ package body Make is Write_Eol; end Inform; + procedure Inform (N : File_Name_Type; Msg : String) is + begin + Inform (Name_Id (N), Msg); + end Inform; + + procedure Inform (Msg : String) is + begin + Osint.Write_Program_Name; + Write_Str (": "); + Write_Str (Msg); + Write_Eol; + end Inform; + ----------------------- -- Init_Mapping_File -- ----------------------- @@ -6018,8 +6296,7 @@ package body Make is (Project : Project_Id; File_Index : in out Natural) is - FD : File_Descriptor; - + FD : File_Descriptor; Status : Boolean; -- For call to Close @@ -6155,6 +6432,10 @@ package body Make is Scan_Make_Arg (Argument (Next_Arg), And_Save => True); end loop Scan_Args; + if Commands_To_Stdout then + Set_Standard_Output; + end if; + if Usage_Requested then Usage; end if; @@ -6209,7 +6490,7 @@ package body Make is if Verbose_Mode then Write_Eol; - Write_Str ("Parsing Project File """); + Write_Str ("Parsing project file """); Write_Str (Project_File_Name.all); Write_Str ("""."); Write_Eol; @@ -6237,9 +6518,11 @@ package body Make is Make_Failed ("""", Project_File_Name.all, """ processing failed"); end if; + Create_Mapping_File := True; + if Verbose_Mode then Write_Eol; - Write_Str ("Parsing of Project File """); + Write_Str ("Parsing of project file """); Write_Str (Project_File_Name.all); Write_Str (""" is finished."); Write_Eol; @@ -6297,8 +6580,7 @@ package body Make is -- Make sure no project object directory is recorded - Project_Object_Directory := No_Project; - + Project_Of_Current_Object_Directory := No_Project; end Initialize; ---------------------------- @@ -6312,7 +6594,7 @@ package body Make is is Put_In_Q : Boolean := Into_Q; Unit : Unit_Data; - Sfile : Name_Id; + Sfile : File_Name_Type; Extending : constant Boolean := Project_Tree.Projects.Table @@ -6359,12 +6641,12 @@ package body Make is Unit_Table.Last (Project_Tree.Units) loop Unit := Project_Tree.Units.Table (Id); - Sfile := No_Name; + Sfile := No_File; -- If there is a source for the body, and the body has not been -- locally removed, - if Unit.File_Names (Body_Part).Name /= No_Name + if Unit.File_Names (Body_Part).Name /= No_File and then Unit.File_Names (Body_Part).Path /= Slash then -- And it is a source for the specified project @@ -6374,7 +6656,7 @@ package body Make is -- If we don't have a spec, we cannot consider the source -- if it is a subunit - if Unit.File_Names (Specification).Name = No_Name then + if Unit.File_Names (Specification).Name = No_File then declare Src_Ind : Source_File_Index; @@ -6383,8 +6665,8 @@ package body Make is -- (Atree, Sinfo, ...). So, we pretend that it is a -- project file, and we use Sinput.P. - -- Source_File_Is_Subunit is just scanning through - -- the file until it finds one of the reserved words + -- Source_File_Is_Subunit is just scanning through the + -- file until it finds one of the reserved words -- separate, procedure, function, generic or package. -- Fortunately, these Ada reserved words are also -- reserved for project files. @@ -6397,18 +6679,18 @@ package body Make is -- If it is a subunit, discard it if Sinput.P.Source_File_Is_Subunit (Src_Ind) then - Sfile := No_Name; + Sfile := No_File; else - Sfile := Unit.File_Names (Body_Part).Name; + Sfile := Unit.File_Names (Body_Part).Display_Name; end if; end; else - Sfile := Unit.File_Names (Body_Part).Name; + Sfile := Unit.File_Names (Body_Part).Display_Name; end if; end if; - elsif Unit.File_Names (Specification).Name /= No_Name + elsif Unit.File_Names (Specification).Name /= No_File and then Unit.File_Names (Specification).Path /= Slash and then Check_Project (Unit.File_Names (Specification).Project) then @@ -6416,7 +6698,7 @@ package body Make is -- for the spec which has not been locally removed, then we take -- this one. - Sfile := Unit.File_Names (Specification).Name; + Sfile := Unit.File_Names (Specification).Display_Name; end if; -- If Put_In_Q is True, we insert into the Q @@ -6433,7 +6715,7 @@ package body Make is -- And of course, we only insert in the Q if the source is not -- marked. - if Sfile /= No_Name and then not Is_Marked (Sfile) then + if Sfile /= No_File and then not Is_Marked (Sfile) then if Verbose_Mode then Write_Str ("Adding """); Write_Str (Get_Name_String (Sfile)); @@ -6444,7 +6726,7 @@ package body Make is Mark (Sfile); end if; - elsif Sfile /= No_Name then + elsif Sfile /= No_File then -- If Put_In_Q is False, we add the source as it it were specified -- on the command line, and we set Put_In_Q to True, so that the @@ -6476,7 +6758,7 @@ package body Make is procedure Insert_Q (Source_File : File_Name_Type; - Source_Unit : Unit_Name_Type := No_Name; + Source_Unit : Unit_Name_Type := No_Unit_Name; Index : Int := 0) is begin @@ -6504,7 +6786,7 @@ package body Make is -- Is_In_Obsoleted -- --------------------- - function Is_In_Obsoleted (F : Name_Id) return Boolean is + function Is_In_Obsoleted (F : File_Name_Type) return Boolean is begin if F = No_File then return False; @@ -6512,10 +6794,11 @@ package body Make is else declare Name : constant String := Get_Name_String (F); - First : Natural := Name'Last; - F2 : Name_Id := F; + First : Natural; + F2 : File_Name_Type; begin + First := Name'Last; while First > Name'First and then Name (First - 1) /= Directory_Separator and then Name (First - 1) /= '/' @@ -6527,6 +6810,8 @@ package body Make is Name_Len := 0; Add_Str_To_Name_Buffer (Name (First .. Name'Last)); F2 := Name_Find; + else + F2 := F; end if; return Obsoleted.Get (F2); @@ -6551,8 +6836,8 @@ package body Make is Source_File_Name : constant String := Get_Name_String (Source_File); Saved_Verbosity : constant Verbosity := Current_Verbosity; - Project : Project_Id := No_Project; - Path_Name : Name_Id := No_Name; + Project : Project_Id := No_Project; + Path_Name : File_Name_Type := No_File; Data : Project_Data; begin @@ -6561,8 +6846,7 @@ package body Make is -- messages. Current_Verbosity := Default; - Prj.Env. - Get_Reference + Prj.Env.Get_Reference (Source_File_Name => Source_File_Name, Project => Project, In_Tree => Project_Tree, @@ -6580,7 +6864,7 @@ package body Make is Object_Directory : constant String := Normalize_Pathname (Get_Name_String - (Data.Object_Directory)); + (Data.Display_Object_Dir)); Olast : Natural := Object_Directory'Last; @@ -6620,9 +6904,12 @@ package body Make is -- Link -- ---------- - procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is + procedure Link + (ALI_File : File_Name_Type; + Args : Argument_List; + Success : out Boolean) + is Link_Args : Argument_List (1 .. Args'Length + 1); - Success : Boolean; begin Get_Name_String (ALI_File); @@ -6630,7 +6917,7 @@ package body Make is Link_Args (2 .. Args'Length + 1) := Args; - GNAT.OS_Lib.Normalize_Arguments (Link_Args); + System.OS_Lib.Normalize_Arguments (Link_Args); Display (Gnatlink.all, Link_Args); @@ -6638,11 +6925,7 @@ package body Make is Make_Failed ("error, unable to locate ", Gnatlink.all); end if; - GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); - - if not Success then - raise Link_Failed; - end if; + System.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); end Link; --------------------------- @@ -6667,9 +6950,9 @@ package body Make is ----------------- procedure List_Depend is - Lib_Name : Name_Id; - Obj_Name : Name_Id; - Src_Name : Name_Id; + Lib_Name : File_Name_Type; + Obj_Name : File_Name_Type; + Src_Name : File_Name_Type; Len : Natural; Line_Pos : Natural; @@ -6726,7 +7009,9 @@ package body Make is Write_Eol; end loop; - Set_Standard_Error; + if not Commands_To_Stdout then + Set_Standard_Error; + end if; end List_Depend; ----------------- @@ -6754,8 +7039,7 @@ package body Make is begin if On_Command_Line then declare - Real_Path : constant String := - Normalize_Pathname (Dir); + Real_Path : constant String := Normalize_Pathname (Dir); begin if Real_Path'Length = 0 then @@ -6772,9 +7056,9 @@ package body Make is declare Real_Path : constant String := Normalize_Pathname - (Dir, - Get_Name_String - (Project_Tree.Projects.Table (Main_Project).Directory)); + (Dir, Get_Name_String + (Project_Tree.Projects.Table + (Main_Project).Display_Directory)); begin if Real_Path'Length = 0 then @@ -6839,7 +7123,7 @@ package body Make is List := Project_Tree.Project_Lists.Table (List).Next; Recursive_Compute_Depth (Project => Proj, - Depth => Depth + 1); + Depth => Depth + 1); end loop; -- Visit a project being extended, if any @@ -6853,12 +7137,27 @@ package body Make is Project_Tree.Projects.Table (Project).Seen := False; end Recursive_Compute_Depth; + ------------------------------- + -- Report_Compilation_Failed -- + ------------------------------- + + procedure Report_Compilation_Failed is + begin + if not Debug.Debug_Flag_N then + Delete_Mapping_Files; + Prj.Env.Delete_All_Path_Files (Project_Tree); + end if; + + Exit_Program (E_Fatal); + end Report_Compilation_Failed; + ----------------------- -- Sigint_Intercpted -- ----------------------- procedure Sigint_Intercepted is begin + Set_Standard_Error; Write_Line ("*** Interrupted ***"); Delete_All_Temp_Files; OS_Exit (1); @@ -7297,7 +7596,7 @@ package body Make is then Unique_Compile_All_Projects := True; Unique_Compile := True; - Compile_Only := True; + Compile_Only := True; Do_Bind_Step := False; Do_Link_Step := False; @@ -7381,8 +7680,8 @@ package body Make is Operating_Mode := Check_Semantics; Check_Object_Consistency := False; Compile_Only := True; - Do_Bind_Step := False; - Do_Link_Step := False; + Do_Bind_Step := False; + Do_Link_Step := False; elsif Argv (2 .. Argv'Last) = "nostdlib" then @@ -7427,7 +7726,7 @@ package body Make is ----------------- function Switches_Of - (Source_File : Name_Id; + (Source_File : File_Name_Type; Source_File_Name : String; Source_Index : Int; Naming : Naming_Data; @@ -7455,7 +7754,7 @@ package body Make is begin Switches := Prj.Util.Value_Of - (Index => Source_File, + (Index => Name_Id (Source_File), Src_Index => Source_Index, In_Array => Switches_Array, In_Tree => Project_Tree); @@ -7580,6 +7879,19 @@ package body Make is Write_Eol; end Verbose_Msg; + procedure Verbose_Msg + (N1 : File_Name_Type; + S1 : String; + N2 : File_Name_Type := No_File; + S2 : String := ""; + Prefix : String := " -> "; + Minimum_Verbosity : Verbosity_Level_Type := Opt.Low) + is + begin + Verbose_Msg + (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity); + end Verbose_Msg; + begin -- Make sure that in case of failure, the temp files will be deleted diff --git a/gcc/ada/make.ads b/gcc/ada/make.ads index aba233d..1c92c99 100644 --- a/gcc/ada/make.ads +++ b/gcc/ada/make.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2006, 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- -- @@ -25,254 +25,12 @@ ------------------------------------------------------------------------------ -- The following package implements the facilities to recursively --- compile (a la make), bind and/or link a set of sources. This package --- gives the individual routines for performing such tasks as well as --- the routine gnatmake below that puts it all together. - -with Table; -with Types; use Types; - -with GNAT.OS_Lib; use GNAT.OS_Lib; +-- compile (a la make), bind and/or link a set of sources. package Make is - -- The 3 following packages are used to store gcc, gnatbind and gnatbl - -- switches passed on the gnatmake or gnatdist command line. - -- Note that the lower bounds definitely need to be 1 to match the - -- requirement that the argument array prepared for Spawn must have - -- a lower bound of 1. - - package Gcc_Switches is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Make.Gcc_Switches"); - - package Binder_Switches is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Make.Binder_Switches"); - - package Linker_Switches is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Make.Linker_Switches"); - - procedure Display_Commands (Display : Boolean := True); - -- The default behavior of Make commands (Compile_Sources, Bind, Link) - -- is to display them on stderr. This behavior can be changed repeatedly - -- by invoking this procedure. - - -- If a compilation, bind or link failed one of the following 3 exceptions - -- is raised. These need to be handled by the calling routines. - - Compilation_Failed : exception; - -- Raised by Compile_Sources if a compilation failed - - Bind_Failed : exception; - -- Raised by Bind below if the bind failed - - Link_Failed : exception; - -- Raised by Link below if the link failed - - procedure Bind (ALI_File : File_Name_Type; Args : Argument_List); - -- Binds ALI_File. Args are the arguments to pass to the binder. - -- Args must have a lower bound of 1. - - procedure Link (ALI_File : File_Name_Type; Args : Argument_List); - -- Links ALI_File. Args are the arguments to pass to the linker. - -- Args must have a lower bound of 1. - - procedure Initialize; - -- Performs default and package initialization. Therefore, - -- Compile_Sources can be called by an external unit. - - procedure Scan_Make_Arg (Argv : String; And_Save : Boolean); - -- Scan make arguments. Argv is a single argument to be processed - - procedure Extract_Failure - (File : out File_Name_Type; - Unit : out Unit_Name_Type; - Found : out Boolean); - -- Extracts the first failure report from Bad_Compilation table - - procedure Compile_Sources - (Main_Source : File_Name_Type; - Args : Argument_List; - First_Compiled_File : out Name_Id; - Most_Recent_Obj_File : out Name_Id; - Most_Recent_Obj_Stamp : out Time_Stamp_Type; - Main_Unit : out Boolean; - Compilation_Failures : out Natural; - Main_Index : Int := 0; - Check_Readonly_Files : Boolean := False; - Do_Not_Execute : Boolean := False; - Force_Compilations : Boolean := False; - Keep_Going : Boolean := False; - In_Place_Mode : Boolean := False; - Initialize_ALI_Data : Boolean := True; - Max_Process : Positive := 1); - -- Compile_Sources will recursively compile all the sources needed by - -- Main_Source. Before calling this routine make sure Namet has been - -- initialized. This routine can be called repeatedly with different - -- Main_Source file as long as all the source (-I flags), library - -- (-B flags) and ada library (-A flags) search paths between calls are - -- *exactly* the same. The default directory must also be the same. - -- - -- Args contains the arguments to use during the compilations. - -- The lower bound of Args must be 1. - -- - -- First_Compiled_File is set to the name of the first file that is - -- compiled or that needs to be compiled. This is set to No_Name if no - -- compilations were needed. - -- - -- Most_Recent_Obj_File is set to the full name of the most recent - -- object file found when no compilations are needed, that is when - -- First_Compiled_File is set to No_Name. When First_Compiled_File - -- is set then Most_Recent_Obj_File is set to No_Name. - -- - -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File. - -- - -- Main_Unit is set to True if Main_Source can be a main unit. - -- If Do_Not_Execute is False and First_Compiled_File /= No_Name - -- the value of Main_Unit is always False. - -- Is this used any more??? It is certainly not used by gnatmake??? - -- - -- Compilation_Failures is a count of compilation failures. This count - -- is used to extract compilation failure reports with Extract_Failure. - -- - -- Main_Index, when not zero, is the index of the main unit in source - -- file Main_Source which is a multi-unit source. - -- Zero indicates that Main_Source is a single unit source file. - -- - -- Check_Readonly_Files set it to True to compile source files - -- which library files are read-only. When compiling GNAT predefined - -- files the "-gnatg" flag is used. - -- - -- Do_Not_Execute set it to True to find out the first source that - -- needs to be recompiled, but without recompiling it. This file is - -- saved in First_Compiled_File. - -- - -- Force_Compilations forces all compilations no matter what but - -- recompiles read-only files only if Check_Readonly_Files - -- is set. - -- - -- Keep_Going when True keep compiling even in the presence of - -- compilation errors. - -- - -- In_Place_Mode when True save library/object files in their object - -- directory if they already exist; otherwise, in the source directory. - -- - -- Initialize_ALI_Data set it to True when you want to initialize ALI - -- data-structures. This is what you should do most of the time. - -- (especially the first time around when you call this routine). - -- This parameter is set to False to preserve previously recorded - -- ALI file data. - -- - -- Max_Process is the maximum number of processes that should be spawned - -- to carry out compilations. - -- - -- Flags in Package Opt Affecting Compile_Sources - -- ----------------------------------------------- - -- - -- Check_Object_Consistency set it to False to omit all consistency - -- checks between an .ali file and its corresponding object file. - -- When this flag is set to true, every time an .ali is read, - -- package Osint checks that the corresponding object file - -- exists and is more recent than the .ali. - -- - -- Use of Name Table Info - -- ---------------------- - -- - -- All file names manipulated by Compile_Sources are entered into the - -- Names table. The Byte field of a source file is used to mark it. - -- - -- Calling Compile_Sources Several Times - -- ------------------------------------- - -- - -- Upon return from Compile_Sources all the ALI data structures are left - -- intact for further browsing. HOWEVER upon entry to this routine ALI - -- data structures are re-initialized if parameter Initialize_ALI_Data - -- above is set to true. Typically this is what you want the first time - -- you call Compile_Sources. You should not load an ali file, call this - -- routine with flag Initialize_ALI_Data set to True and then expect - -- that ALI information to be around after the call. Note that the first - -- time you call Compile_Sources you better set Initialize_ALI_Data to - -- True unless you have called Initialize_ALI yourself. - -- - -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source) - -- ------------------------- - -- - -- 1. Insert Main_Source in a Queue (Q) and mark it. - -- - -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is - -- missing but its corresponding ali file is in an Ada library directory - -- (see below) then, remove unit.adb from the Q and goto step 4. - -- Otherwise, look at the files under the D (dependency) section of - -- unit.ali. If unit.ali does not exist or some of the time stamps do - -- not match, (re)compile unit.adb. - -- - -- An Ada library directory is a directory containing Ada specs, ali - -- and object files but no source files for the bodies. An Ada library - -- directory is communicated to gnatmake by means of some switch so that - -- gnatmake can skip the sources whole ali are in that directory. - -- There are two reasons for skipping the sources in this case. Firstly, - -- Ada libraries typically come without full sources but binding and - -- linking against those libraries is still possible. Secondly, it would - -- be very wasteful for gnatmake to systematically check the consistency - -- of every external Ada library used in a program. The binder is - -- already in charge of catching any potential inconsistencies. - -- - -- 3. Look into the W section of unit.ali and insert into the Q all - -- unmarked source files. Mark all files newly inserted in the Q. - -- Specifically, assuming that the W section looks like - -- - -- W types%s types.adb types.ali - -- W unchecked_deallocation%s - -- W xref_tab%s xref_tab.adb xref_tab.ali - -- - -- Then xref_tab.adb and types.adb are inserted in the Q if they are not - -- already marked. - -- Note that there is no file listed under W unchecked_deallocation%s - -- so no generic body should ever be explicitly compiled (unless the - -- Main_Source at the start was a generic body). - -- - -- 4. Repeat steps 2 and 3 above until the Q is empty - -- - -- Note that the above algorithm works because the units withed in - -- subunits are transitively included in the W section (with section) of - -- the main unit. Likewise the withed units in a generic body needed - -- during a compilation are also transitively included in the W section - -- of the originally compiled file. - procedure Gnatmake; - -- The driver of gnatmake. This routine puts it all together. - -- This utility can be used to automatically (re)compile (using - -- Compile_Sources), bind (using Bind) and link (using Link) a set of - -- ada sources. For more information on gnatmake and its precise usage - -- please refer to the gnat documentation. - -- - -- Flags in Package Opt Affecting Gnatmake - -- --------------------------------------- - -- - -- Check_Readonly_Files: True when -a present in command line - -- Check_Object_Consistency: Set to True by Gnatmake - -- Compile_Only: True when -c present in command line - -- Force_Compilations: True when -f present in command line - -- Maximum_Processes: Number of processes given by -jnum - -- Keep_Going: True when -k present in command line - -- List_Dependencies: True when -l present in command line - -- Do_Not_Execute True when -n present in command line - -- Quiet_Output: True when -q present in command line - -- Minimal_Recompilation: True when -m present in command line - -- Verbose_Mode: True when -v present in command line + -- The driver of gnatmake. For more information on gnatmake and its + -- precise usage please refer to the gnat documentation. end Make; diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index c3fd42a..8dd5f3f 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2007, 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- -- @@ -27,13 +27,14 @@ with Atree; use Atree; with Einfo; use Einfo; with Errout; use Errout; -with Targparm; use Targparm; +with Namet; use Namet; with Nlists; use Nlists; with Sem; use Sem; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; +with Targparm; use Targparm; package body Sem_Mech is @@ -274,6 +275,7 @@ package body Sem_Mech is when Convention_Assembler | Convention_C | + Convention_CIL | Convention_CPP | Convention_Java | Convention_Stdcall => diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 6f3ffe3..b24dfb0 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2007, 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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Csets; use Csets; -with Namet; use Namet; with Opt; use Opt; with Osint; use Osint; with Output; use Output; @@ -44,13 +43,14 @@ package body Targparm is BDC, -- Backend_Divide_Checks BOC, -- Backend_Overflow_Checks CLA, -- Command_Line_Args + CLI, -- CLI (.NET) CRT, -- Configurable_Run_Times - CSV, -- Compiler_System_Version D32, -- Duration_32_Bits DEN, -- Denorm EXS, -- Exit_Status_Supported FEL, -- Frontend_Layout FFO, -- Fractional_Fixed_Ops + JVM, -- JVM MOV, -- Machine_Overflows MRN, -- Machine_Rounds PAS, -- Preallocated_Stacks @@ -68,9 +68,6 @@ package body Targparm is ZCD, -- ZCX_By_Default ZCG); -- GCC_ZCX_Support - subtype Targparm_Tags_OK is Targparm_Tags range AAM .. ZCG; - -- Range excluding obsolete entries - Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False); -- Flag is set True if corresponding parameter is scanned @@ -80,13 +77,14 @@ package body Targparm is BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks"; BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks"; CLA_Str : aliased constant Source_Buffer := "Command_Line_Args"; + CLI_Str : aliased constant Source_Buffer := "CLI"; CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time"; - CSV_Str : aliased constant Source_Buffer := "Compiler_System_Version"; D32_Str : aliased constant Source_Buffer := "Duration_32_Bits"; DEN_Str : aliased constant Source_Buffer := "Denorm"; EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported"; FEL_Str : aliased constant Source_Buffer := "Frontend_Layout"; FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops"; + JVM_Str : aliased constant Source_Buffer := "JVM"; MOV_Str : aliased constant Source_Buffer := "Machine_Overflows"; MRN_Str : aliased constant Source_Buffer := "Machine_Rounds"; PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks"; @@ -113,13 +111,14 @@ package body Targparm is BDC_Str'Access, BOC_Str'Access, CLA_Str'Access, + CLI_Str'Access, CRT_Str'Access, - CSV_Str'Access, D32_Str'Access, DEN_Str'Access, EXS_Str'Access, FEL_Str'Access, FFO_Str'Access, + JVM_Str'Access, MOV_Str'Access, MRN_Str'Access, PAS_Str'Access, @@ -549,13 +548,22 @@ package body Targparm is when BDC => Backend_Divide_Checks_On_Target := Result; when BOC => Backend_Overflow_Checks_On_Target := Result; when CLA => Command_Line_Args_On_Target := Result; + when CLI => + if Result then + VM_Target := CLI_Target; + end if; + when CRT => Configurable_Run_Time_On_Target := Result; - when CSV => Compiler_System_Version := Result; when D32 => Duration_32_Bits_On_Target := Result; when DEN => Denorm_On_Target := Result; when EXS => Exit_Status_Supported_On_Target := Result; when FEL => Frontend_Layout_On_Target := Result; when FFO => Fractional_Fixed_Ops_On_Target := Result; + when JVM => + if Result then + VM_Target := JVM_Target; + end if; + when MOV => Machine_Overflows_On_Target := Result; when MRN => Machine_Rounds_On_Target := Result; when PAS => Preallocated_Stacks_On_Target := Result; @@ -614,27 +622,6 @@ package body Targparm is Multi_Unit_Index_Character := '$'; end if; - -- Check no missing target parameter settings (skip for compiler vsn) - - if not Compiler_System_Version then - for K in Targparm_Tags_OK loop - if not Targparm_Flags (K) then - Set_Standard_Error; - Write_Line - ("fatal error: system.ads is incorrectly formatted"); - Write_Str ("missing line for parameter: "); - - for J in Targparm_Str (K)'Range loop - Write_Char (Targparm_Str (K).all (J)); - end loop; - - Write_Eol; - Set_Standard_Output; - Fatal := True; - end if; - end loop; - end if; - if Fatal then raise Unrecoverable_Error; end if; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 465e6b7..7f17dd5 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2007, 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- -- @@ -77,6 +77,7 @@ -- only item in this category is whether type Address is private. with Rident; use Rident; +with Namet; use Namet; with Types; use Types; package Targparm is @@ -166,11 +167,11 @@ package Targparm is -------------------------- Executable_Extension_On_Target : Name_Id := No_Name; - -- Executable extension on the target. - -- This name is useful for setting the executable extension in a - -- dynamic way, e.g. depending on the run-time used, rather than - -- using a configure-time macro as done by Get_Target_Executable_Suffix. - -- If not set (No_Name), use GNAT.OS_Lib.Get_Target_Executable_Suffix. + -- Executable extension on the target. This name is useful for setting + -- the executable extension in a dynamic way, e.g. depending on the + -- run time used, rather than using a configure-time macro as done by + -- Get_Target_Executable_Suffix. If not set (No_Name), instead use + -- System.OS_Lib.Get_Target_Executable_Suffix. ----------------------- -- Target Parameters -- @@ -187,24 +188,14 @@ package Targparm is -- text buffer containing the source of the system package. -- The default values here are used if no value is found in system.ads. - -- This should normally happen only if the special version of system.ads - -- used by the compiler itself is in use. The default values are suitable - -- for use by the compiler itself in normal environments. This approach - -- allows the possibility of new versions of the compiler (possibly with - -- new system parameters added) being used to compile older versions of - -- the compiler sources. This is not guaranteed to work, but often will - -- and by setting appropriate default values, we make it more likely that - -- this can succeed. - - Compiler_System_Version : Boolean := True; - -- This is set False in all target dependent versions of System. In the - -- compiler default version, it is omitted entirely, meaning that the - -- above default value of True will be set. If the flag is False, then - -- the scanning circuits in the body of this package do an error check to - -- ensure that all parameters other than this one are specified and not - -- defaulted. If the parameter is set True, then this check is omitted, - -- and any parameters not present in system.ads are left set to their - -- default value as described above. + -- This should normally happen if the special version of system.ads used + -- by the compiler itself is in use or if the value is only relevant to + -- a particular target (e.g. OpenVMS, AAMP). The default values are + -- suitable for use in normal environments. This approach allows the + -- possibility of new versions of the compiler (possibly with new system + -- parameters added) being used to compile older versions of the compiler + -- sources, as well as avoiding duplicating values in all system-*.ads + -- files for flags that are used on a few platforms only. ---------------------------- -- Special Target Control -- @@ -220,6 +211,10 @@ package Targparm is OpenVMS_On_Target : Boolean := False; -- Set to True if target is OpenVMS + type Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target); + VM_Target : Virtual_Machine_Kind := No_VM; + -- Kind of virtual machine targetted + ------------------------------- -- Backend Arithmetic Checks -- ------------------------------- |