Skip to content

R
riscv-gcc-1
Commit d3cc6a32 by Arnaud Charlet
Options

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
parent 437bae3f
Showing with 635 additions and 572 deletions
gcc/ada/lib-writ.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,7 +33,6 @@ with Fname; use Fname; ...@@ -33,7 +33,6 @@ with Fname; use Fname;
with Fname.UF; use Fname.UF; with Fname.UF; use Fname.UF;
with Lib.Util; use Lib.Util; with Lib.Util; use Lib.Util;
with Lib.Xref; use Lib.Xref; with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Gnatvsn; use Gnatvsn; with Gnatvsn; use Gnatvsn;
with Opt; use Opt; with Opt; use Opt;
...@@ -45,6 +44,7 @@ with Rident; use Rident; ...@@ -45,6 +44,7 @@ with Rident; use Rident;
with Scn; use Scn; with Scn; use Scn;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Sinput; use Sinput; with Sinput; use Sinput;
with Snames; use Snames;
with Stringt; use Stringt; with Stringt; use Stringt;
with Tbuild; use Tbuild; with Tbuild; use Tbuild;
with Uname; use Uname; with Uname; use Uname;
...@@ -71,8 +71,8 @@ package body Lib.Writ is ...@@ -71,8 +71,8 @@ package body Lib.Writ is
Units.Increment_Last; Units.Increment_Last;
Units.Table (Units.Last) := Units.Table (Units.Last) :=
(Unit_File_Name => File_Name (S), (Unit_File_Name => File_Name (S),
Unit_Name => No_Name, Unit_Name => No_Unit_Name,
Expected_Unit => No_Name, Expected_Unit => No_Unit_Name,
Source_Index => S, Source_Index => S,
Cunit => Empty, Cunit => Empty,
Cunit_Entity => Empty, Cunit_Entity => Empty,
...@@ -427,8 +427,17 @@ package body Lib.Writ is ...@@ -427,8 +427,17 @@ package body Lib.Writ is
(Declaration_Node (Declaration_Node
(Body_Entity (Uent)))))) (Body_Entity (Uent))))))
then then
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"); Write_Info_Str (" EE");
end if; end if;
end if;
if Has_No_Elaboration_Code (Unode) then if Has_No_Elaboration_Code (Unode) then
Write_Info_Str (" NE"); Write_Info_Str (" NE");
...@@ -672,7 +681,7 @@ package body Lib.Writ is ...@@ -672,7 +681,7 @@ package body Lib.Writ is
-- For preproc. data and def. files, there is no Unit_Name, -- For preproc. data and def. files, there is no Unit_Name,
-- check for that first. -- 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) and then (With_Flags (J) or else Unit_Name (J) = Pname)
then then
Num_Withs := Num_Withs + 1; Num_Withs := Num_Withs + 1;
......
gcc/ada/make.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -54,15 +54,18 @@ with Sinput.P; ...@@ -54,15 +54,18 @@ with Sinput.P;
with Snames; use Snames; with Snames; use Snames;
with Switch; use Switch; with Switch; use Switch;
with Switch.M; use Switch.M; with Switch.M; use Switch.M;
with Targparm; with Targparm; use Targparm;
with Table;
with Tempdir; with Tempdir;
with Types; use Types;
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Command_Line; use Ada.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations; 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; with System.HTable;
package body Make is package body Make is
...@@ -123,7 +126,7 @@ package body Make is ...@@ -123,7 +126,7 @@ package body Make is
procedure Insert_Q procedure Insert_Q
(Source_File : File_Name_Type; (Source_File : File_Name_Type;
Source_Unit : Unit_Name_Type := No_Name; Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0); Index : Int := 0);
-- Inserts Source_File at the end of Q. Provide Source_Unit when possible -- Inserts Source_File at the end of Q. Provide Source_Unit when possible
-- for external use (gnatdist). Provide index for multi-unit sources. -- for external use (gnatdist). Provide index for multi-unit sources.
...@@ -176,13 +179,40 @@ package body Make is ...@@ -176,13 +179,40 @@ package body Make is
package Q is new Table.Table ( package Q is new Table.Table (
Table_Component_Type => Q_Record, Table_Component_Type => Q_Record,
Table_Index_Type => Natural, Table_Index_Type => Integer,
Table_Low_Bound => 0, Table_Low_Bound => 0,
Table_Initial => 4000, Table_Initial => 4000,
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Make.Q"); Table_Name => "Make.Q");
-- This is the actual 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 -- The following instantiations and variables are necessary to save what
-- is found on the command line, in case there is a project file specified. -- is found on the command line, in case there is a project file specified.
...@@ -279,7 +309,7 @@ package body Make is ...@@ -279,7 +309,7 @@ package body Make is
Main_Project : Prj.Project_Id := No_Project; Main_Project : Prj.Project_Id := No_Project;
-- The project id of the main project file, if any -- 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 -- The object directory of the project for the last compilation. Avoid
-- calling Change_Dir if the current working directory is already this -- calling Change_Dir if the current working directory is already this
-- directory -- directory
...@@ -399,30 +429,30 @@ package body Make is ...@@ -399,30 +429,30 @@ package body Make is
type Header_Num is range 1 .. Max_Header; type Header_Num is range 1 .. Max_Header;
-- Header_Num for the hash table Obsoleted below -- 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 -- Hash function for the hash table Obsoleted below
package Obsoleted is new System.HTable.Simple_HTable package Obsoleted is new System.HTable.Simple_HTable
(Header_Num => Header_Num, (Header_Num => Header_Num,
Element => Boolean, Element => Boolean,
No_Element => False, No_Element => False,
Key => Name_Id, Key => File_Name_Type,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- A hash table to keep all files that have been compiled, to detect -- A hash table to keep all files that have been compiled, to detect
-- if an executable is up to date or not. -- 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 -- Enter a file name, without directory information, into the hash table
-- Obsoleted. -- 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 -- Check if a file name, without directory information, has already been
-- entered into the hash table Obsoleted. -- entered into the hash table Obsoleted.
type Dependency is record type Dependency is record
This : Name_Id; This : File_Name_Type;
Depends_On : Name_Id; Depends_On : File_Name_Type;
end record; end record;
-- Components of table Dependencies below -- Components of table Dependencies below
...@@ -434,10 +464,7 @@ package body Make is ...@@ -434,10 +464,7 @@ package body Make is
Table_Increment => 100, Table_Increment => 100,
Table_Name => "Make.Dependencies"); Table_Name => "Make.Dependencies");
-- A table to keep dependencies, to be able to decide if an executable -- A table to keep dependencies, to be able to decide if an executable
-- is obsolete. -- is obsolete. More explanation needed ???
procedure Add_Dependency (S : Name_Id; On : Name_Id);
-- Add one entry in table Dependencies
---------------------------- ----------------------------
-- Arguments and Switches -- -- Arguments and Switches --
...@@ -485,8 +512,10 @@ package body Make is ...@@ -485,8 +512,10 @@ package body Make is
-- no additional ALI files should be scanned between the two calls (i.e. -- no additional ALI files should be scanned between the two calls (i.e.
-- between the call to Compile_Sources and List_Depend.) -- between the call to Compile_Sources and List_Depend.)
procedure Inform (N : Name_Id := No_Name; Msg : String); procedure Inform (N : Name_Id; Msg : String);
-- Prints out the program name followed by a colon, N and S 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; procedure List_Bad_Compilations;
-- Prints out the list of all files for which the compilation failed -- Prints out the list of all files for which the compilation failed
...@@ -498,6 +527,13 @@ package body Make is ...@@ -498,6 +527,13 @@ package body Make is
S2 : String := ""; S2 : String := "";
Prefix : String := " -> "; Prefix : String := " -> ";
Minimum_Verbosity : Verbosity_Level_Type := Opt.Low); 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 -- If the verbose flag (Verbose_Mode) is set and the verbosity level is
-- at least equal to Minimum_Verbosity, then print Prefix to standard -- 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 -- output followed by N1 and S1. If N2 /= No_Name then N2 is printed after
...@@ -511,6 +547,8 @@ package body Make is ...@@ -511,6 +547,8 @@ package body Make is
-- Set Usage_Needed to False. -- Set Usage_Needed to False.
procedure Debug_Msg (S : String; N : Name_Id); 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 -- If Debug.Debug_Flag_W is set outputs string S followed by name N
procedure Recursive_Compute_Depth procedure Recursive_Compute_Depth
...@@ -577,7 +615,7 @@ package body Make is ...@@ -577,7 +615,7 @@ package body Make is
-- compiler. -- compiler.
function Switches_Of function Switches_Of
(Source_File : Name_Id; (Source_File : File_Name_Type;
Source_File_Name : String; Source_File_Name : String;
Source_Index : Int; Source_Index : Int;
Naming : Naming_Data; Naming : Naming_Data;
...@@ -612,11 +650,11 @@ package body Make is ...@@ -612,11 +650,11 @@ package body Make is
-- Given by the command line. Will be used, if non null -- Given by the command line. Will be used, if non null
Gcc_Path : String_Access := 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 := 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 := 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. -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
-- Changed later if overridden on command line. -- Changed later if overridden on command line.
...@@ -721,14 +759,17 @@ package body Make is ...@@ -721,14 +759,17 @@ package body Make is
-- Displays Program followed by the arguments in Args if variable -- Displays Program followed by the arguments in Args if variable
-- Display_Executed_Programs is set. The lower bound of Args must be 1. -- 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 -- Mapping files
----------------- -----------------
type Temp_File_Names is type Temp_Path_Names is
array (Project_Id range <>, Positive range <>) of Name_Id; 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; type Indices is array (Project_Id range <>) of Natural;
...@@ -739,7 +780,7 @@ package body Make is ...@@ -739,7 +780,7 @@ package body Make is
type Free_Indices_Ptr is access Free_File_Indices; 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 -- For each project, the name ids of the temporary mapping files used
Last_Mapping_File_Names : Indices_Ptr; Last_Mapping_File_Names : Indices_Ptr;
...@@ -771,6 +812,186 @@ package body Make is ...@@ -771,6 +812,186 @@ package body Make is
procedure Delete_All_Temp_Files; procedure Delete_All_Temp_Files;
-- Delete all temp files (config files, mapping files, path 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 -- -- Add_Arguments --
------------------- -------------------
...@@ -797,16 +1018,6 @@ package body Make is ...@@ -797,16 +1018,6 @@ package body Make is
Last_Argument := Last_Argument + Args'Length; Last_Argument := Last_Argument + Args'Length;
end Add_Arguments; 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 -- -- Add_Library_Search_Dir --
---------------------------- ----------------------------
...@@ -817,15 +1028,13 @@ package body Make is ...@@ -817,15 +1028,13 @@ package body Make is
is is
begin begin
if On_Command_Line then if On_Command_Line then
Add_Lib_Search_Dir Add_Lib_Search_Dir (Normalize_Pathname (Path));
(Normalize_Pathname (Path));
else else
Get_Name_String Get_Name_String
(Project_Tree.Projects.Table (Main_Project).Directory); (Project_Tree.Projects.Table (Main_Project).Display_Directory);
Add_Lib_Search_Dir Add_Lib_Search_Dir
(Normalize_Pathname (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
(Path, Name_Buffer (1 .. Name_Len)));
end if; end if;
end Add_Library_Search_Dir; end Add_Library_Search_Dir;
...@@ -871,15 +1080,13 @@ package body Make is ...@@ -871,15 +1080,13 @@ package body Make is
is is
begin begin
if On_Command_Line then if On_Command_Line then
Add_Src_Search_Dir Add_Src_Search_Dir (Normalize_Pathname (Path));
(Normalize_Pathname (Path));
else else
Get_Name_String Get_Name_String
(Project_Tree.Projects.Table (Main_Project).Directory); (Project_Tree.Projects.Table (Main_Project).Display_Directory);
Add_Src_Search_Dir Add_Src_Search_Dir
(Normalize_Pathname (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
(Path, Name_Buffer (1 .. Name_Len)));
end if; end if;
end Add_Source_Search_Dir; end Add_Source_Search_Dir;
...@@ -1027,8 +1234,7 @@ package body Make is ...@@ -1027,8 +1234,7 @@ package body Make is
Switch_List := Switches.Values; Switch_List := Switches.Values;
while Switch_List /= Nil_String loop while Switch_List /= Nil_String loop
Element := Element := Project_Tree.String_Elements.Table (Switch_List);
Project_Tree.String_Elements.Table (Switch_List);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Name_Len > 0 then if Name_Len > 0 then
...@@ -1109,7 +1315,7 @@ package body Make is ...@@ -1109,7 +1315,7 @@ package body Make is
Bind_Last := Bind_Last + 1; Bind_Last := Bind_Last + 1;
Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len)); 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)); Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
...@@ -1117,11 +1323,11 @@ package body Make is ...@@ -1117,11 +1323,11 @@ package body Make is
Make_Failed ("error, unable to locate ", Gnatbind.all); Make_Failed ("error, unable to locate ", Gnatbind.all);
end if; end if;
GNAT.OS_Lib.Spawn System.OS_Lib.Spawn
(Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success); (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
if not Success then if not Success then
raise Bind_Failed; Make_Failed ("*** bind failed.");
end if; end if;
end Bind; end Bind;
...@@ -1131,6 +1337,7 @@ package body Make is ...@@ -1131,6 +1337,7 @@ package body Make is
procedure Change_To_Object_Directory (Project : Project_Id) is procedure Change_To_Object_Directory (Project : Project_Id) is
Actual_Project : Project_Id; Actual_Project : Project_Id;
Object_Directory : Path_Name_Type;
begin begin
-- For sources outside of any project, compilation occurs in the object -- For sources outside of any project, compilation occurs in the object
...@@ -1145,17 +1352,24 @@ package body Make is ...@@ -1145,17 +1352,24 @@ package body Make is
-- Nothing to do if the current working directory is already the correct -- Nothing to do if the current working directory is already the correct
-- object directory. -- object directory.
if Project_Object_Directory /= Actual_Project then if Project_Of_Current_Object_Directory /= Actual_Project then
Project_Object_Directory := Actual_Project; 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 -- Set the working directory to the object directory of the actual
-- project. -- project.
Change_Dir if Verbose_Mode then
(Get_Name_String Write_Str ("Changing to object directory of """);
(Project_Tree.Projects.Table Write_Name
(Actual_Project).Object_Directory)); (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; end if;
exception exception
...@@ -1209,7 +1423,7 @@ package body Make is ...@@ -1209,7 +1423,7 @@ package body Make is
function New_Spec (Uname : Unit_Name_Type) return Boolean; function New_Spec (Uname : Unit_Name_Type) return Boolean;
-- Uname is the name of the spec or body of some ada unit. This -- 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 -- 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. -- Spec_File_Name above is set to the name of this spec file.
-------------- --------------
...@@ -1310,7 +1524,7 @@ package body Make is ...@@ -1310,7 +1524,7 @@ package body Make is
-- appear in the Sdep section of Lib_File, New_Spec contains the file -- appear in the Sdep section of Lib_File, New_Spec contains the file
-- name of this new spec. -- name of this new spec.
Source_Name : Name_Id; Source_Name : File_Name_Type;
Text : Text_Buffer_Ptr; Text : Text_Buffer_Ptr;
Prev_Switch : String_Access; Prev_Switch : String_Access;
...@@ -1733,7 +1947,7 @@ package body Make is ...@@ -1733,7 +1947,7 @@ package body Make is
-- Process linker options from the ALI files -- Process linker options from the ALI files
for Opt in 1 .. Linker_Options.Last loop 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; end loop;
-- Process options given on the command line -- Process options given on the command line
...@@ -1831,8 +2045,7 @@ package body Make is ...@@ -1831,8 +2045,7 @@ package body Make is
while Data.Extended_By /= No_Project loop while Data.Extended_By /= No_Project loop
Arguments_Project := Data.Extended_By; Arguments_Project := Data.Extended_By;
Data := Data := Project_Tree.Projects.Table (Arguments_Project);
Project_Tree.Projects.Table (Arguments_Project);
end loop; end loop;
-- If building a dynamic or relocatable library, compile with -- If building a dynamic or relocatable library, compile with
...@@ -1856,8 +2069,8 @@ package body Make is ...@@ -1856,8 +2069,8 @@ package body Make is
Data; Data;
end if; end if;
-- We now look for package Compiler -- We now look for package Compiler and get the switches from
-- and get the switches from this package. -- this package.
Compiler_Package := Compiler_Package :=
Prj.Util.Value_Of Prj.Util.Value_Of
...@@ -1867,11 +2080,12 @@ package body Make is ...@@ -1867,11 +2080,12 @@ package body Make is
if Compiler_Package /= No_Package then if Compiler_Package /= No_Package then
-- If package Gnatmake.Compiler exists, we get -- If package Gnatmake.Compiler exists, we get the specific
-- the specific switches for the current source, -- switches for the current source, or the global switches,
-- or the global switches, if any. -- if any.
Switches := Switches_Of Switches :=
Switches_Of
(Source_File => Source_File, (Source_File => Source_File,
Source_File_Name => Source_File_Name, Source_File_Name => Source_File_Name,
Source_Index => Source_Index, Source_Index => Source_Index,
...@@ -1978,8 +2192,8 @@ package body Make is ...@@ -1978,8 +2192,8 @@ package body Make is
procedure Compile_Sources procedure Compile_Sources
(Main_Source : File_Name_Type; (Main_Source : File_Name_Type;
Args : Argument_List; Args : Argument_List;
First_Compiled_File : out Name_Id; First_Compiled_File : out File_Name_Type;
Most_Recent_Obj_File : out Name_Id; Most_Recent_Obj_File : out File_Name_Type;
Most_Recent_Obj_Stamp : out Time_Stamp_Type; Most_Recent_Obj_Stamp : out Time_Stamp_Type;
Main_Unit : out Boolean; Main_Unit : out Boolean;
Compilation_Failures : out Natural; Compilation_Failures : out Natural;
...@@ -2035,6 +2249,9 @@ package body Make is ...@@ -2035,6 +2249,9 @@ package body Make is
Sfile : File_Name_Type; Sfile : File_Name_Type;
-- Contains the source file of the units withed by Source_File -- 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 : ALI_Id;
-- ALI Id of the current ALI file -- ALI Id of the current ALI file
...@@ -2097,14 +2314,14 @@ package body Make is ...@@ -2097,14 +2314,14 @@ package body Make is
-- Collect arguments from project file (if any) and compile -- Collect arguments from project file (if any) and compile
function Compile function Compile
(S : Name_Id; (S : File_Name_Type;
L : Name_Id; L : File_Name_Type;
Source_Index : Int; Source_Index : Int;
Args : Argument_List) return Process_Id; Args : Argument_List) return Process_Id;
-- Compiles S using Args. If S is a GNAT predefined source -- Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is
-- "-gnatpg" is added to Args. Non blocking call. L corresponds to the -- added to Args. Non blocking call. L corresponds to the expected
-- expected library file name. Process_Id of the process spawned to -- library file name. Process_Id of the process spawned to execute the
-- execute the compile. -- compilation.
package Good_ALI is new Table.Table ( package Good_ALI is new Table.Table (
Table_Component_Type => ALI_Id, Table_Component_Type => ALI_Id,
...@@ -2172,7 +2389,7 @@ package body Make is ...@@ -2172,7 +2389,7 @@ package body Make is
procedure Await_Compile procedure Await_Compile
(Sfile : out File_Name_Type; (Sfile : out File_Name_Type;
Afile : out File_Name_Type; Afile : out File_Name_Type;
Uname : out File_Name_Type; Uname : out Unit_Name_Type;
OK : out Boolean) OK : out Boolean)
is is
Pid : Process_Id; Pid : Process_Id;
...@@ -2183,7 +2400,7 @@ package body Make is ...@@ -2183,7 +2400,7 @@ package body Make is
Sfile := No_File; Sfile := No_File;
Afile := No_File; Afile := No_File;
Uname := No_Name; Uname := No_Unit_Name;
OK := False; OK := False;
-- The loop here is a work-around for a problem on VMS; in some -- The loop here is a work-around for a problem on VMS; in some
...@@ -2262,7 +2479,7 @@ package body Make is ...@@ -2262,7 +2479,7 @@ package body Make is
if not Targparm.Suppress_Standard_Library_On_Target then if not Targparm.Suppress_Standard_Library_On_Target then
declare declare
Sfile : Name_Id; Sfile : File_Name_Type;
Add_It : Boolean := True; Add_It : Boolean := True;
begin begin
...@@ -2350,8 +2567,7 @@ package body Make is ...@@ -2350,8 +2567,7 @@ package body Make is
if not Project_Tree.Projects.Table if not Project_Tree.Projects.Table
(Arguments_Project).Externally_Built (Arguments_Project).Externally_Built
then then
Prj.Env.Set_Ada_Paths Prj.Env.Set_Ada_Paths (Arguments_Project, Project_Tree, True);
(Arguments_Project, Project_Tree, True);
if not Unique_Compile if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
...@@ -2395,6 +2611,11 @@ package body Make is ...@@ -2395,6 +2611,11 @@ package body Make is
Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index, Pid := Compile (Arguments_Path_Name, Lib_File, Source_Index,
Arguments (1 .. Last_Argument)); 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; Process_Created := True;
end if; end if;
...@@ -2417,8 +2638,8 @@ package body Make is ...@@ -2417,8 +2638,8 @@ package body Make is
------------- -------------
function Compile function Compile
(S : Name_Id; (S : File_Name_Type;
L : Name_Id; L : File_Name_Type;
Source_Index : Int; Source_Index : Int;
Args : Argument_List) return Process_Id Args : Argument_List) return Process_Id
is is
...@@ -2427,7 +2648,7 @@ package body Make is ...@@ -2427,7 +2648,7 @@ package body Make is
Comp_Last : Integer; Comp_Last : Integer;
Arg_Index : 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 -- Returns True if Name is the name of an ada source file
-- (i.e. suffix is .ads or .adb) -- (i.e. suffix is .ads or .adb)
...@@ -2435,7 +2656,7 @@ package body Make is ...@@ -2435,7 +2656,7 @@ package body Make is
-- Ada_File_Name -- -- 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 begin
Get_Name_String (Name); Get_Name_String (Name);
return return
...@@ -2552,9 +2773,9 @@ package body Make is ...@@ -2552,9 +2773,9 @@ package body Make is
end; end;
end if; end if;
if Source_Index /= 0 or else if Source_Index /= 0
L /= Strip_Directory (L) or else or else L /= Strip_Directory (L)
Object_Directory_Path /= null or else Object_Directory_Path /= null
then then
-- Build -o argument -- Build -o argument
...@@ -2596,7 +2817,8 @@ package body Make is ...@@ -2596,7 +2817,8 @@ package body Make is
Comp_Last := Comp_Last + 1; Comp_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len)); 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_Last := Comp_Last + 1;
Comp_Args (Comp_Last) := new String'("-gnatez"); Comp_Args (Comp_Last) := new String'("-gnatez");
...@@ -2608,7 +2830,7 @@ package body Make is ...@@ -2608,7 +2830,7 @@ package body Make is
end if; end if;
return return
GNAT.OS_Lib.Non_Blocking_Spawn System.OS_Lib.Non_Blocking_Spawn
(Gcc_Path.all, Comp_Args (Args'First .. Comp_Last)); (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
end Compile; end Compile;
...@@ -2697,7 +2919,6 @@ package body Make is ...@@ -2697,7 +2919,6 @@ package body Make is
-- Package and Queue initializations -- Package and Queue initializations
Good_ALI.Init; Good_ALI.Init;
Output.Set_Standard_Error;
if First_Q_Initialization then if First_Q_Initialization then
Init_Q; Init_Q;
...@@ -2877,9 +3098,9 @@ package body Make is ...@@ -2877,9 +3098,9 @@ package body Make is
-- Check that switch -x has been used if a source -- Check that switch -x has been used if a source
-- outside of project files need to be compiled. -- outside of project files need to be compiled.
if Main_Project /= No_Project and then if Main_Project /= No_Project
Arguments_Project = No_Project and then and then Arguments_Project = No_Project
not External_Unit_Compilation_Allowed and then not External_Unit_Compilation_Allowed
then then
Make_Failed ("external source (", Make_Failed ("external source (",
Get_Name_String (Source_File), Get_Name_String (Source_File),
...@@ -2929,6 +3150,7 @@ package body Make is ...@@ -2929,6 +3150,7 @@ package body Make is
if Process_Created then if Process_Created then
if Pid = Invalid_Pid then if Pid = Invalid_Pid then
Record_Failure (Full_Source_File, Source_Unit); Record_Failure (Full_Source_File, Source_Unit);
else else
Add_Process Add_Process
(Pid, (Pid,
...@@ -3078,7 +3300,49 @@ package body Make is ...@@ -3078,7 +3300,49 @@ package body Make is
Units.Table (J).First_With .. Units.Table (J).Last_With Units.Table (J).First_With .. Units.Table (J).Last_With
loop loop
Sfile := Withs.Table (K).Sfile; 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 if Is_In_Obsoleted (Sfile) then
Executable_Obsolete := True; Executable_Obsolete := True;
...@@ -3101,8 +3365,7 @@ package body Make is ...@@ -3101,8 +3365,7 @@ package body Make is
Debug_Msg ("Skipping internal file:", Sfile); Debug_Msg ("Skipping internal file:", Sfile);
else else
Insert_Q Insert_Q (Sfile, Uname, Source_Index);
(Sfile, Withs.Table (K).Uname, Source_Index);
Mark (Sfile, Source_Index); Mark (Sfile, Source_Index);
end if; end if;
end if; end if;
...@@ -3244,7 +3507,7 @@ package body Make is ...@@ -3244,7 +3507,7 @@ package body Make is
Last : Natural := 0; Last : Natural := 0;
function Absolute_Path function Absolute_Path
(Path : Name_Id; (Path : File_Name_Type;
Project : Project_Id) return String; Project : Project_Id) return String;
-- Returns an absolute path for a configuration pragmas file -- Returns an absolute path for a configuration pragmas file
...@@ -3253,7 +3516,7 @@ package body Make is ...@@ -3253,7 +3516,7 @@ package body Make is
------------------- -------------------
function Absolute_Path function Absolute_Path
(Path : Name_Id; (Path : File_Name_Type;
Project : Project_Id) return String Project : Project_Id) return String
is is
begin begin
...@@ -3271,7 +3534,7 @@ package body Make is ...@@ -3271,7 +3534,7 @@ package body Make is
Parent_Directory : constant String := Parent_Directory : constant String :=
Get_Name_String Get_Name_String
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Project).Directory); (Project).Display_Directory);
begin begin
if Parent_Directory (Parent_Directory'Last) = if Parent_Directory (Parent_Directory'Last) =
...@@ -3294,7 +3557,7 @@ package body Make is ...@@ -3294,7 +3557,7 @@ package body Make is
(For_Project, Main_Project, Project_Tree); (For_Project, Main_Project, Project_Tree);
if Project_Tree.Projects.Table if Project_Tree.Projects.Table
(For_Project).Config_File_Name /= No_Name (For_Project).Config_File_Name /= No_Path
then then
Temporary_Config_File := Temporary_Config_File :=
Project_Tree.Projects.Table (For_Project).Config_File_Temp; Project_Tree.Projects.Table (For_Project).Config_File_Temp;
...@@ -3334,7 +3597,9 @@ package body Make is ...@@ -3334,7 +3597,9 @@ package body Make is
declare declare
Path : constant String := Path : constant String :=
Absolute_Path Absolute_Path
(Global_Attribute.Value, Global_Attribute.Project); (File_Name_Type (Global_Attribute.Value),
Global_Attribute.Project);
begin begin
if not Is_Regular_File (Path) then if not Is_Regular_File (Path) then
Make_Failed Make_Failed
...@@ -3371,7 +3636,9 @@ package body Make is ...@@ -3371,7 +3636,9 @@ package body Make is
declare declare
Path : constant String := Path : constant String :=
Absolute_Path Absolute_Path
(Local_Attribute.Value, Local_Attribute.Project); (File_Name_Type (Local_Attribute.Value),
Local_Attribute.Project);
begin begin
if not Is_Regular_File (Path) then if not Is_Regular_File (Path) then
Make_Failed Make_Failed
...@@ -3402,6 +3669,16 @@ package body Make is ...@@ -3402,6 +3669,16 @@ package body Make is
end if; end if;
end Debug_Msg; 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 -- -- Delete_All_Temp_Files --
--------------------------- ---------------------------
...@@ -3472,7 +3749,7 @@ package body Make is ...@@ -3472,7 +3749,7 @@ package body Make is
Project_Tree.Projects.Table (Project). Project_Tree.Projects.Table (Project).
Config_Checked := False; Config_Checked := False;
Project_Tree.Projects.Table (Project). Project_Tree.Projects.Table (Project).
Config_File_Name := No_Name; Config_File_Name := No_Path;
Project_Tree.Projects.Table (Project). Project_Tree.Projects.Table (Project).
Config_File_Temp := False; Config_File_Temp := False;
end if; end if;
...@@ -3489,10 +3766,6 @@ package body Make is ...@@ -3489,10 +3766,6 @@ package body Make is
pragma Assert (Args'First = 1); pragma Assert (Args'First = 1);
if Display_Executed_Programs then if Display_Executed_Programs then
if Commands_To_Stdout then
Set_Standard_Output;
end if;
Write_Str (Program); Write_Str (Program);
for J in Args'Range loop for J in Args'Range loop
...@@ -3540,7 +3813,6 @@ package body Make is ...@@ -3540,7 +3813,6 @@ package body Make is
end loop; end loop;
Write_Eol; Write_Eol;
Set_Standard_Error;
end if; end if;
end Display; end Display;
...@@ -3580,12 +3852,13 @@ package body Make is ...@@ -3580,12 +3852,13 @@ package body Make is
-- Enter_Into_Obsoleted -- -- 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); Name : constant String := Get_Name_String (F);
First : Natural := Name'Last; First : Natural;
F2 : Name_Id := F; F2 : File_Name_Type;
begin begin
First := Name'Last;
while First > Name'First while First > Name'First
and then Name (First - 1) /= Directory_Separator and then Name (First - 1) /= Directory_Separator
and then Name (First - 1) /= '/' and then Name (First - 1) /= '/'
...@@ -3597,28 +3870,14 @@ package body Make is ...@@ -3597,28 +3870,14 @@ package body Make is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Name (First .. Name'Last)); Add_Str_To_Name_Buffer (Name (First .. Name'Last));
F2 := Name_Find; F2 := Name_Find;
else
F2 := F;
end if; end if;
Debug_Msg ("New entry in Obsoleted table:", F2); Debug_Msg ("New entry in Obsoleted table:", F2);
Obsoleted.Set (F2, True); Obsoleted.Set (F2, True);
end Enter_Into_Obsoleted; 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 -- -- Extract_From_Q --
-------------------- --------------------
...@@ -3690,7 +3949,7 @@ package body Make is ...@@ -3690,7 +3949,7 @@ package body Make is
-- Set to True when there are Stand-Alone Libraries, so that gnatbind -- Set to True when there are Stand-Alone Libraries, so that gnatbind
-- is invoked with the -F switch to force checking of elaboration flags. -- 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 -- The path name of the mapping file
Discard : Boolean; Discard : Boolean;
...@@ -3808,6 +4067,7 @@ package body Make is ...@@ -3808,6 +4067,7 @@ package body Make is
if Normed_Path /= Proj_Path then if Normed_Path /= Proj_Path then
if Verbose_Mode then if Verbose_Mode then
Set_Standard_Error;
Write_Str (Normed_Path); Write_Str (Normed_Path);
Write_Str (" /= "); Write_Str (" /= ");
Write_Line (Proj_Path); Write_Line (Proj_Path);
...@@ -3863,10 +4123,10 @@ package body Make is ...@@ -3863,10 +4123,10 @@ package body Make is
Mapping_FD : File_Descriptor := Invalid_FD; Mapping_FD : File_Descriptor := Invalid_FD;
-- A File Descriptor for an eventual mapping file -- 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 -- 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 -- The file name of the ALI file
ALI_Project : Project_Id := No_Project; ALI_Project : Project_Id := No_Project;
...@@ -3889,49 +4149,46 @@ package body Make is ...@@ -3889,49 +4149,46 @@ package body Make is
Unit_Table.Last (Project_Tree.Units) Unit_Table.Last (Project_Tree.Units)
loop loop
declare declare
Unit : constant Unit_Data := Unit : constant Unit_Data := Project_Tree.Units.Table (J);
Project_Tree.Units.Table (J);
begin begin
if Unit.Name /= No_Name then if Unit.Name /= No_Name then
-- If there is a body, put it in the mapping -- 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 and then Unit.File_Names (Body_Part).Project
/= No_Project /= No_Project
then then
Get_Name_String (Unit.Name); Get_Name_String (Unit.Name);
Name_Buffer Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%b";
(Name_Len + 1 .. Name_Len + 2) := "%b";
Name_Len := Name_Len + 2; Name_Len := Name_Len + 2;
ALI_Unit := Name_Find; ALI_Unit := Name_Find;
ALI_Name := ALI_Name :=
Lib_File_Name Lib_File_Name
(Unit.File_Names (Body_Part).Name); (Unit.File_Names (Body_Part).Display_Name);
ALI_Project := ALI_Project :=
Unit.File_Names (Body_Part).Project; Unit.File_Names (Body_Part).Project;
-- Otherwise, if there is a spec, put it -- Otherwise, if there is a spec, put it
-- in the mapping. -- in the mapping.
elsif Unit.File_Names (Specification).Name elsif Unit.File_Names (Specification).Name /= No_File
/= No_Name and then Unit.File_Names (Specification).Project /=
and then Unit.File_Names No_Project
(Specification).Project
/= No_Project
then then
Get_Name_String (Unit.Name); Get_Name_String (Unit.Name);
Name_Buffer Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "%s";
(Name_Len + 1 .. Name_Len + 2) := "%s";
Name_Len := Name_Len + 2; Name_Len := Name_Len + 2;
ALI_Unit := Name_Find; ALI_Unit := Name_Find;
ALI_Name := Lib_File_Name ALI_Name :=
(Unit.File_Names (Specification).Name); Lib_File_Name
(Unit.File_Names (Specification).Display_Name);
ALI_Project := ALI_Project :=
Unit.File_Names (Specification).Project; Unit.File_Names (Specification).Project;
else else
ALI_Name := No_Name; ALI_Name := No_File;
end if; end if;
-- If we have something to put in the mapping -- If we have something to put in the mapping
...@@ -3942,7 +4199,7 @@ package body Make is ...@@ -3942,7 +4199,7 @@ package body Make is
-- ended project obj dir as well as in the -- ended project obj dir as well as in the
-- extending project obj dir. -- extending project obj dir.
if ALI_Name /= No_Name if ALI_Name /= No_File
and then and then
Project_Tree.Projects.Table Project_Tree.Projects.Table
(ALI_Project).Extended_By = No_Project (ALI_Project).Extended_By = No_Project
...@@ -4021,7 +4278,7 @@ package body Make is ...@@ -4021,7 +4278,7 @@ package body Make is
exit when not OK; exit when not OK;
-- Third line it the ALI path name. -- Third line it the ALI path name
Bytes := Bytes :=
Write Write
...@@ -4081,17 +4338,6 @@ package body Make is ...@@ -4081,17 +4338,6 @@ package body Make is
Failed_Links.Set_Last (0); Failed_Links.Set_Last (0);
Successful_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 -- Special case when switch -B was specified
if Build_Bind_And_Link_Full_Project then if Build_Bind_And_Link_Full_Project then
...@@ -4389,7 +4635,7 @@ package body Make is ...@@ -4389,7 +4635,7 @@ package body Make is
Do_Not_Execute := True; Do_Not_Execute := True;
end if; 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. -- abbreviated file) without any directory information.
Main_Source_File := Next_Main_Source; Main_Source_File := Next_Main_Source;
...@@ -4439,11 +4685,11 @@ package body Make is ...@@ -4439,11 +4685,11 @@ package body Make is
if Main_Project /= No_Project then if Main_Project /= No_Project then
if Project_Tree.Projects.Table if Project_Tree.Projects.Table
(Main_Project).Object_Directory /= No_Name (Main_Project).Object_Directory /= No_Path
then then
-- Change current directory to object directory of main project -- 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); Change_To_Object_Directory (Main_Project);
end if; end if;
...@@ -4466,7 +4712,8 @@ package body Make is ...@@ -4466,7 +4712,8 @@ package body Make is
not Unique_Compile); not Unique_Compile);
The_Packages : constant Package_Id := 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 := Builder_Package : constant Prj.Package_Id :=
Prj.Util.Value_Of Prj.Util.Value_Of
...@@ -4655,12 +4902,36 @@ package body Make is ...@@ -4655,12 +4902,36 @@ package body Make is
begin begin
Targparm.Get_Target_Parameters; Targparm.Get_Target_Parameters;
exception exception
when Unrecoverable_Error => when Unrecoverable_Error =>
Make_Failed ("*** make failed."); Make_Failed ("*** make failed.");
end; 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); Display_Commands (not Quiet_Output);
Check_Steps; Check_Steps;
...@@ -4684,14 +4955,13 @@ package body Make is ...@@ -4684,14 +4955,13 @@ package body Make is
and then (not Project_Tree.Projects.Table and then (not Project_Tree.Projects.Table
(Proj).Externally_Built); (Proj).Externally_Built);
if Project_Tree.Projects.Table if Project_Tree.Projects.Table (Proj).Need_To_Build_Lib then
(Proj).Need_To_Build_Lib
then
-- If there is no object directory, then it will be -- If there is no object directory, then it will be
-- impossible to build the library. So fail immediately. -- impossible to build the library. So fail immediately.
if Project_Tree.Projects.Table if Project_Tree.Projects.Table (Proj).Object_Directory =
(Proj).Object_Directory = No_Name No_Path
then then
Make_Failed Make_Failed
("no object files to build library for project """, ("no object files to build library for project """,
...@@ -4865,9 +5135,9 @@ package body Make is ...@@ -4865,9 +5135,9 @@ package body Make is
Gnatlink := Saved_Gnatlink; Gnatlink := Saved_Gnatlink;
end if; end if;
Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all);
Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); Gnatbind_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); Gnatlink_Path := System.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
-- If we have specified -j switch both from the project file -- If we have specified -j switch both from the project file
-- and on the command line, the one from the command line takes -- and on the command line, the one from the command line takes
...@@ -4881,7 +5151,7 @@ package body Make is ...@@ -4881,7 +5151,7 @@ package body Make is
-- number of compilation processed, for each possible project. -- number of compilation processed, for each possible project.
The_Mapping_File_Names := The_Mapping_File_Names :=
new Temp_File_Names new Temp_Path_Names
(No_Project .. Project_Table.Last (Project_Tree.Projects), (No_Project .. Project_Table.Last (Project_Tree.Projects),
1 .. Saved_Maximum_Processes); 1 .. Saved_Maximum_Processes);
Last_Mapping_File_Names := Last_Mapping_File_Names :=
...@@ -4972,7 +5242,7 @@ package body Make is ...@@ -4972,7 +5242,7 @@ package body Make is
if not Is_Absolute_Path (Exec_File_Name) then if not Is_Absolute_Path (Exec_File_Name) then
Get_Name_String (Project_Tree.Projects.Table Get_Name_String (Project_Tree.Projects.Table
(Main_Project).Exec_Directory); (Main_Project).Display_Exec_Dir);
if if
Name_Buffer (Name_Len) /= Directory_Separator Name_Buffer (Name_Len) /= Directory_Separator
...@@ -4997,8 +5267,8 @@ package body Make is ...@@ -4997,8 +5267,8 @@ package body Make is
Recursive_Compilation_Step : declare Recursive_Compilation_Step : declare
Args : Argument_List (1 .. Gcc_Switches.Last); Args : Argument_List (1 .. Gcc_Switches.Last);
First_Compiled_File : Name_Id; First_Compiled_File : File_Name_Type;
Youngest_Obj_File : Name_Id; Youngest_Obj_File : File_Name_Type;
Youngest_Obj_Stamp : Time_Stamp_Type; Youngest_Obj_Stamp : Time_Stamp_Type;
Executable_Stamp : Time_Stamp_Type; Executable_Stamp : Time_Stamp_Type;
...@@ -5047,7 +5317,7 @@ package body Make is ...@@ -5047,7 +5317,7 @@ package body Make is
goto Next_Main; goto Next_Main;
else else
List_Bad_Compilations; List_Bad_Compilations;
raise Compilation_Failed; Report_Compilation_Failed;
end if; end if;
end if; end if;
...@@ -5269,7 +5539,7 @@ package body Make is ...@@ -5269,7 +5539,7 @@ package body Make is
-- since there is currently no simple way to check the -- since there is currently no simple way to check the
-- up-to-date status of objects -- up-to-date status of objects
if not Hostparm.Java_VM if Targparm.VM_Target = No_VM
and then First_Compiled_File = No_File and then First_Compiled_File = No_File
then then
Executable_Stamp := File_Stamp (Executable); Executable_Stamp := File_Stamp (Executable);
...@@ -5327,9 +5597,7 @@ package body Make is ...@@ -5327,9 +5597,7 @@ package body Make is
elsif Youngest_Obj_Stamp (1) = ' ' then elsif Youngest_Obj_Stamp (1) = ' ' then
Verbose_Msg Verbose_Msg
(Youngest_Obj_File, (Youngest_Obj_File, "missing.", Prefix => " ");
"missing.",
Prefix => " ");
elsif Youngest_Obj_Stamp > Executable_Stamp then elsif Youngest_Obj_Stamp > Executable_Stamp then
Verbose_Msg Verbose_Msg
...@@ -5340,8 +5608,7 @@ package body Make is ...@@ -5340,8 +5608,7 @@ package body Make is
else else
Verbose_Msg Verbose_Msg
(Executable, "needs to be rebuild.", (Executable, "needs to be rebuilt", Prefix => " ");
Prefix => " ");
end if; end if;
end if; end if;
...@@ -5402,8 +5669,7 @@ package body Make is ...@@ -5402,8 +5669,7 @@ package body Make is
-- Check if there are shared libraries, so that gnatbind is -- Check if there are shared libraries, so that gnatbind is
-- called with -shared. Check also if gnatbind is called with -- called with -shared. Check also if gnatbind is called with
-- -shared, so that gnatlink is called with -shared-libgcc -- -shared, so that gnatlink is called with -shared-libgcc
-- for GCC version 3 and above, ensuring that the shared -- ensuring that the shared version of libgcc will be used.
-- version of libgcc will be used.
if Main_Project /= No_Project if Main_Project /= No_Project
and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
...@@ -5434,9 +5700,9 @@ package body Make is ...@@ -5434,9 +5700,9 @@ package body Make is
end if; end if;
-- If there are shared libraries, invoke gnatlink with -- 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; Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
end if; end if;
...@@ -5477,7 +5743,7 @@ package body Make is ...@@ -5477,7 +5743,7 @@ package body Make is
-- file, if one was created. -- file, if one was created.
if not Debug.Debug_Flag_N if not Debug.Debug_Flag_N
and then Mapping_Path /= No_Name and then Mapping_Path /= No_Path
then then
Delete_File (Get_Name_String (Mapping_Path), Discard); Delete_File (Get_Name_String (Mapping_Path), Discard);
end if; end if;
...@@ -5490,7 +5756,7 @@ package body Make is ...@@ -5490,7 +5756,7 @@ package body Make is
-- If -dn was not specified, delete the temporary mapping file, -- If -dn was not specified, delete the temporary mapping file,
-- if one was created. -- 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); Delete_File (Get_Name_String (Mapping_Path), Discard);
end if; end if;
end Bind_Step; end Bind_Step;
...@@ -5498,10 +5764,10 @@ package body Make is ...@@ -5498,10 +5764,10 @@ package body Make is
if Do_Link_Step then if Do_Link_Step then
Link_Step : declare Link_Step : declare
There_Are_Libraries : Boolean := False;
Linker_Switches_Last : constant Integer := Linker_Switches.Last; Linker_Switches_Last : constant Integer := Linker_Switches.Last;
Path_Option : constant String_Access := Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option; MLib.Linker_Library_Path_Option;
There_Are_Libraries : Boolean := False;
Current : Natural; Current : Natural;
Proj2 : Project_Id; Proj2 : Project_Id;
Depth : Natural; Depth : Natural;
...@@ -5530,8 +5796,7 @@ package body Make is ...@@ -5530,8 +5796,7 @@ package body Make is
-- Add this project to table Library_Projs -- Add this project to table Library_Projs
There_Are_Libraries := True; There_Are_Libraries := True;
Depth := Depth := Project_Tree.Projects.Table (Proj1).Depth;
Project_Tree.Projects.Table (Proj1).Depth;
Library_Projs.Increment_Last; Library_Projs.Increment_Last;
Current := Library_Projs.Last; Current := Library_Projs.Last;
...@@ -5560,7 +5825,7 @@ package body Make is ...@@ -5560,7 +5825,7 @@ package body Make is
new String' new String'
(Get_Name_String (Get_Name_String
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Proj1).Library_Dir)); (Proj1).Display_Library_Dir));
end if; end if;
end if; end if;
end loop; end loop;
...@@ -5574,7 +5839,7 @@ package body Make is ...@@ -5574,7 +5839,7 @@ package body Make is
Get_Name_String Get_Name_String
(Project_Tree.Projects.Table (Project_Tree.Projects.Table
(Library_Projs.Table (Index)). (Library_Projs.Table (Index)).
Library_Dir)); Display_Library_Dir));
-- Add the -l switch -- Add the -l switch
...@@ -5712,21 +5977,30 @@ package body Make is ...@@ -5712,21 +5977,30 @@ package body Make is
-- And invoke the linker -- And invoke the linker
declare
Success : Boolean := False;
begin begin
Link (Main_ALI_File, Link (Main_ALI_File,
Link_With_Shared_Libgcc.all & Link_With_Shared_Libgcc.all &
Args (Args'First .. Last_Arg)); Args (Args'First .. Last_Arg),
Success);
if Success then
Successful_Links.Increment_Last; Successful_Links.Increment_Last;
Successful_Links.Table (Successful_Links.Last) := Successful_Links.Table (Successful_Links.Last) :=
Main_ALI_File; Main_ALI_File;
exception elsif Osint.Number_Of_Files = 1 or not Keep_Going then
when Link_Failed => Make_Failed ("*** link failed.");
if Osint.Number_Of_Files = 1 or not Keep_Going then
raise;
else else
Set_Standard_Error;
Write_Line ("*** link failed"); Write_Line ("*** link failed");
if Commands_To_Stdout then
Set_Standard_Output;
end if;
Failed_Links.Increment_Last; Failed_Links.Increment_Last;
Failed_Links.Table (Failed_Links.Last) := Failed_Links.Table (Failed_Links.Last) :=
Main_ALI_File; Main_ALI_File;
...@@ -5924,20 +6198,26 @@ package body Make is ...@@ -5924,20 +6198,26 @@ package body Make is
Write_Line (""" succeeded."); Write_Line (""" succeeded.");
end loop; end loop;
Set_Standard_Error;
for Index in 1 .. Failed_Links.Last loop for Index in 1 .. Failed_Links.Last loop
Write_Str ("Linking of """); Write_Str ("Linking of """);
Write_Str (Get_Name_String (Failed_Links.Table (Index))); Write_Str (Get_Name_String (Failed_Links.Table (Index)));
Write_Line (""" failed."); Write_Line (""" failed.");
end loop; end loop;
if Commands_To_Stdout then
Set_Standard_Output;
end if;
if Total_Compilation_Failures = 0 then if Total_Compilation_Failures = 0 then
raise Compilation_Failed; Report_Compilation_Failed;
end if; end if;
end if; end if;
if Total_Compilation_Failures /= 0 then if Total_Compilation_Failures /= 0 then
List_Bad_Compilations; List_Bad_Compilations;
raise Compilation_Failed; Report_Compilation_Failed;
end if; end if;
-- Delete the temporary mapping file that was created if we are -- Delete the temporary mapping file that was created if we are
...@@ -5948,24 +6228,9 @@ package body Make is ...@@ -5948,24 +6228,9 @@ package body Make is
Prj.Env.Delete_All_Path_Files (Project_Tree); Prj.Env.Delete_All_Path_Files (Project_Tree);
end if; end if;
Exit_Program (E_Success);
exception 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 => when X : others =>
Set_Standard_Error;
Write_Line (Exception_Information (X)); Write_Line (Exception_Information (X));
Make_Failed ("INTERNAL ERROR. Please report."); Make_Failed ("INTERNAL ERROR. Please report.");
end Gnatmake; end Gnatmake;
...@@ -5974,7 +6239,7 @@ package body Make is ...@@ -5974,7 +6239,7 @@ package body Make is
-- Hash -- -- Hash --
---------- ----------
function Hash (F : Name_Id) return Header_Num is function Hash (F : File_Name_Type) return Header_Num is
begin begin
return Header_Num (1 + F mod Max_Header); return Header_Num (1 + F mod Max_Header);
end Hash; end Hash;
...@@ -5984,7 +6249,7 @@ package body Make is ...@@ -5984,7 +6249,7 @@ package body Make is
-------------------- --------------------
function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
D : constant Name_Id := Get_Directory (File); D : constant File_Name_Type := Get_Directory (File);
B : constant Byte := Get_Name_Table_Byte (D); B : constant Byte := Get_Name_Table_Byte (D);
begin begin
return (B and Ada_Lib_Dir) /= 0; return (B and Ada_Lib_Dir) /= 0;
...@@ -5994,7 +6259,7 @@ package body Make is ...@@ -5994,7 +6259,7 @@ package body Make is
-- Inform -- -- Inform --
------------ ------------
procedure Inform (N : Name_Id := No_Name; Msg : String) is procedure Inform (N : Name_Id; Msg : String) is
begin begin
Osint.Write_Program_Name; Osint.Write_Program_Name;
...@@ -6010,6 +6275,19 @@ package body Make is ...@@ -6010,6 +6275,19 @@ package body Make is
Write_Eol; Write_Eol;
end Inform; 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 -- -- Init_Mapping_File --
----------------------- -----------------------
...@@ -6019,7 +6297,6 @@ package body Make is ...@@ -6019,7 +6297,6 @@ package body Make is
File_Index : in out Natural) File_Index : in out Natural)
is is
FD : File_Descriptor; FD : File_Descriptor;
Status : Boolean; Status : Boolean;
-- For call to Close -- For call to Close
...@@ -6155,6 +6432,10 @@ package body Make is ...@@ -6155,6 +6432,10 @@ package body Make is
Scan_Make_Arg (Argument (Next_Arg), And_Save => True); Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
end loop Scan_Args; end loop Scan_Args;
if Commands_To_Stdout then
Set_Standard_Output;
end if;
if Usage_Requested then if Usage_Requested then
Usage; Usage;
end if; end if;
...@@ -6209,7 +6490,7 @@ package body Make is ...@@ -6209,7 +6490,7 @@ package body Make is
if Verbose_Mode then if Verbose_Mode then
Write_Eol; Write_Eol;
Write_Str ("Parsing Project File """); Write_Str ("Parsing project file """);
Write_Str (Project_File_Name.all); Write_Str (Project_File_Name.all);
Write_Str ("""."); Write_Str (""".");
Write_Eol; Write_Eol;
...@@ -6237,9 +6518,11 @@ package body Make is ...@@ -6237,9 +6518,11 @@ package body Make is
Make_Failed ("""", Project_File_Name.all, """ processing failed"); Make_Failed ("""", Project_File_Name.all, """ processing failed");
end if; end if;
Create_Mapping_File := True;
if Verbose_Mode then if Verbose_Mode then
Write_Eol; Write_Eol;
Write_Str ("Parsing of Project File """); Write_Str ("Parsing of project file """);
Write_Str (Project_File_Name.all); Write_Str (Project_File_Name.all);
Write_Str (""" is finished."); Write_Str (""" is finished.");
Write_Eol; Write_Eol;
...@@ -6297,8 +6580,7 @@ package body Make is ...@@ -6297,8 +6580,7 @@ package body Make is
-- Make sure no project object directory is recorded -- Make sure no project object directory is recorded
Project_Object_Directory := No_Project; Project_Of_Current_Object_Directory := No_Project;
end Initialize; end Initialize;
---------------------------- ----------------------------
...@@ -6312,7 +6594,7 @@ package body Make is ...@@ -6312,7 +6594,7 @@ package body Make is
is is
Put_In_Q : Boolean := Into_Q; Put_In_Q : Boolean := Into_Q;
Unit : Unit_Data; Unit : Unit_Data;
Sfile : Name_Id; Sfile : File_Name_Type;
Extending : constant Boolean := Extending : constant Boolean :=
Project_Tree.Projects.Table Project_Tree.Projects.Table
...@@ -6359,12 +6641,12 @@ package body Make is ...@@ -6359,12 +6641,12 @@ package body Make is
Unit_Table.Last (Project_Tree.Units) Unit_Table.Last (Project_Tree.Units)
loop loop
Unit := Project_Tree.Units.Table (Id); 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 -- If there is a source for the body, and the body has not been
-- locally removed, -- 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 and then Unit.File_Names (Body_Part).Path /= Slash
then then
-- And it is a source for the specified project -- And it is a source for the specified project
...@@ -6374,7 +6656,7 @@ package body Make is ...@@ -6374,7 +6656,7 @@ package body Make is
-- If we don't have a spec, we cannot consider the source -- If we don't have a spec, we cannot consider the source
-- if it is a subunit -- if it is a subunit
if Unit.File_Names (Specification).Name = No_Name then if Unit.File_Names (Specification).Name = No_File then
declare declare
Src_Ind : Source_File_Index; Src_Ind : Source_File_Index;
...@@ -6383,8 +6665,8 @@ package body Make is ...@@ -6383,8 +6665,8 @@ package body Make is
-- (Atree, Sinfo, ...). So, we pretend that it is a -- (Atree, Sinfo, ...). So, we pretend that it is a
-- project file, and we use Sinput.P. -- project file, and we use Sinput.P.
-- Source_File_Is_Subunit is just scanning through -- Source_File_Is_Subunit is just scanning through the
-- the file until it finds one of the reserved words -- file until it finds one of the reserved words
-- separate, procedure, function, generic or package. -- separate, procedure, function, generic or package.
-- Fortunately, these Ada reserved words are also -- Fortunately, these Ada reserved words are also
-- reserved for project files. -- reserved for project files.
...@@ -6397,18 +6679,18 @@ package body Make is ...@@ -6397,18 +6679,18 @@ package body Make is
-- If it is a subunit, discard it -- If it is a subunit, discard it
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
Sfile := No_Name; Sfile := No_File;
else else
Sfile := Unit.File_Names (Body_Part).Name; Sfile := Unit.File_Names (Body_Part).Display_Name;
end if; end if;
end; end;
else else
Sfile := Unit.File_Names (Body_Part).Name; Sfile := Unit.File_Names (Body_Part).Display_Name;
end if; end if;
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 Unit.File_Names (Specification).Path /= Slash
and then Check_Project (Unit.File_Names (Specification).Project) and then Check_Project (Unit.File_Names (Specification).Project)
then then
...@@ -6416,7 +6698,7 @@ package body Make is ...@@ -6416,7 +6698,7 @@ package body Make is
-- for the spec which has not been locally removed, then we take -- for the spec which has not been locally removed, then we take
-- this one. -- this one.
Sfile := Unit.File_Names (Specification).Name; Sfile := Unit.File_Names (Specification).Display_Name;
end if; end if;
-- If Put_In_Q is True, we insert into the Q -- If Put_In_Q is True, we insert into the Q
...@@ -6433,7 +6715,7 @@ package body Make is ...@@ -6433,7 +6715,7 @@ package body Make is
-- And of course, we only insert in the Q if the source is not -- And of course, we only insert in the Q if the source is not
-- marked. -- 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 if Verbose_Mode then
Write_Str ("Adding """); Write_Str ("Adding """);
Write_Str (Get_Name_String (Sfile)); Write_Str (Get_Name_String (Sfile));
...@@ -6444,7 +6726,7 @@ package body Make is ...@@ -6444,7 +6726,7 @@ package body Make is
Mark (Sfile); Mark (Sfile);
end if; 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 -- 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 -- on the command line, and we set Put_In_Q to True, so that the
...@@ -6476,7 +6758,7 @@ package body Make is ...@@ -6476,7 +6758,7 @@ package body Make is
procedure Insert_Q procedure Insert_Q
(Source_File : File_Name_Type; (Source_File : File_Name_Type;
Source_Unit : Unit_Name_Type := No_Name; Source_Unit : Unit_Name_Type := No_Unit_Name;
Index : Int := 0) Index : Int := 0)
is is
begin begin
...@@ -6504,7 +6786,7 @@ package body Make is ...@@ -6504,7 +6786,7 @@ package body Make is
-- Is_In_Obsoleted -- -- 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 begin
if F = No_File then if F = No_File then
return False; return False;
...@@ -6512,10 +6794,11 @@ package body Make is ...@@ -6512,10 +6794,11 @@ package body Make is
else else
declare declare
Name : constant String := Get_Name_String (F); Name : constant String := Get_Name_String (F);
First : Natural := Name'Last; First : Natural;
F2 : Name_Id := F; F2 : File_Name_Type;
begin begin
First := Name'Last;
while First > Name'First while First > Name'First
and then Name (First - 1) /= Directory_Separator and then Name (First - 1) /= Directory_Separator
and then Name (First - 1) /= '/' and then Name (First - 1) /= '/'
...@@ -6527,6 +6810,8 @@ package body Make is ...@@ -6527,6 +6810,8 @@ package body Make is
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Name (First .. Name'Last)); Add_Str_To_Name_Buffer (Name (First .. Name'Last));
F2 := Name_Find; F2 := Name_Find;
else
F2 := F;
end if; end if;
return Obsoleted.Get (F2); return Obsoleted.Get (F2);
...@@ -6552,7 +6837,7 @@ package body Make is ...@@ -6552,7 +6837,7 @@ package body Make is
Get_Name_String (Source_File); Get_Name_String (Source_File);
Saved_Verbosity : constant Verbosity := Current_Verbosity; Saved_Verbosity : constant Verbosity := Current_Verbosity;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
Path_Name : Name_Id := No_Name; Path_Name : File_Name_Type := No_File;
Data : Project_Data; Data : Project_Data;
begin begin
...@@ -6561,8 +6846,7 @@ package body Make is ...@@ -6561,8 +6846,7 @@ package body Make is
-- messages. -- messages.
Current_Verbosity := Default; Current_Verbosity := Default;
Prj.Env. Prj.Env.Get_Reference
Get_Reference
(Source_File_Name => Source_File_Name, (Source_File_Name => Source_File_Name,
Project => Project, Project => Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
...@@ -6580,7 +6864,7 @@ package body Make is ...@@ -6580,7 +6864,7 @@ package body Make is
Object_Directory : constant String := Object_Directory : constant String :=
Normalize_Pathname Normalize_Pathname
(Get_Name_String (Get_Name_String
(Data.Object_Directory)); (Data.Display_Object_Dir));
Olast : Natural := Object_Directory'Last; Olast : Natural := Object_Directory'Last;
...@@ -6620,9 +6904,12 @@ package body Make is ...@@ -6620,9 +6904,12 @@ package body Make is
-- Link -- -- 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); Link_Args : Argument_List (1 .. Args'Length + 1);
Success : Boolean;
begin begin
Get_Name_String (ALI_File); Get_Name_String (ALI_File);
...@@ -6630,7 +6917,7 @@ package body Make is ...@@ -6630,7 +6917,7 @@ package body Make is
Link_Args (2 .. Args'Length + 1) := Args; 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); Display (Gnatlink.all, Link_Args);
...@@ -6638,11 +6925,7 @@ package body Make is ...@@ -6638,11 +6925,7 @@ package body Make is
Make_Failed ("error, unable to locate ", Gnatlink.all); Make_Failed ("error, unable to locate ", Gnatlink.all);
end if; end if;
GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); System.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
if not Success then
raise Link_Failed;
end if;
end Link; end Link;
--------------------------- ---------------------------
...@@ -6667,9 +6950,9 @@ package body Make is ...@@ -6667,9 +6950,9 @@ package body Make is
----------------- -----------------
procedure List_Depend is procedure List_Depend is
Lib_Name : Name_Id; Lib_Name : File_Name_Type;
Obj_Name : Name_Id; Obj_Name : File_Name_Type;
Src_Name : Name_Id; Src_Name : File_Name_Type;
Len : Natural; Len : Natural;
Line_Pos : Natural; Line_Pos : Natural;
...@@ -6726,7 +7009,9 @@ package body Make is ...@@ -6726,7 +7009,9 @@ package body Make is
Write_Eol; Write_Eol;
end loop; end loop;
if not Commands_To_Stdout then
Set_Standard_Error; Set_Standard_Error;
end if;
end List_Depend; end List_Depend;
----------------- -----------------
...@@ -6754,8 +7039,7 @@ package body Make is ...@@ -6754,8 +7039,7 @@ package body Make is
begin begin
if On_Command_Line then if On_Command_Line then
declare declare
Real_Path : constant String := Real_Path : constant String := Normalize_Pathname (Dir);
Normalize_Pathname (Dir);
begin begin
if Real_Path'Length = 0 then if Real_Path'Length = 0 then
...@@ -6772,9 +7056,9 @@ package body Make is ...@@ -6772,9 +7056,9 @@ package body Make is
declare declare
Real_Path : constant String := Real_Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Dir, (Dir, Get_Name_String
Get_Name_String (Project_Tree.Projects.Table
(Project_Tree.Projects.Table (Main_Project).Directory)); (Main_Project).Display_Directory));
begin begin
if Real_Path'Length = 0 then if Real_Path'Length = 0 then
...@@ -6853,12 +7137,27 @@ package body Make is ...@@ -6853,12 +7137,27 @@ package body Make is
Project_Tree.Projects.Table (Project).Seen := False; Project_Tree.Projects.Table (Project).Seen := False;
end Recursive_Compute_Depth; 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 -- -- Sigint_Intercpted --
----------------------- -----------------------
procedure Sigint_Intercepted is procedure Sigint_Intercepted is
begin begin
Set_Standard_Error;
Write_Line ("*** Interrupted ***"); Write_Line ("*** Interrupted ***");
Delete_All_Temp_Files; Delete_All_Temp_Files;
OS_Exit (1); OS_Exit (1);
...@@ -7427,7 +7726,7 @@ package body Make is ...@@ -7427,7 +7726,7 @@ package body Make is
----------------- -----------------
function Switches_Of function Switches_Of
(Source_File : Name_Id; (Source_File : File_Name_Type;
Source_File_Name : String; Source_File_Name : String;
Source_Index : Int; Source_Index : Int;
Naming : Naming_Data; Naming : Naming_Data;
...@@ -7455,7 +7754,7 @@ package body Make is ...@@ -7455,7 +7754,7 @@ package body Make is
begin begin
Switches := Switches :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Index => Source_File, (Index => Name_Id (Source_File),
Src_Index => Source_Index, Src_Index => Source_Index,
In_Array => Switches_Array, In_Array => Switches_Array,
In_Tree => Project_Tree); In_Tree => Project_Tree);
...@@ -7580,6 +7879,19 @@ package body Make is ...@@ -7580,6 +7879,19 @@ package body Make is
Write_Eol; Write_Eol;
end Verbose_Msg; 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 begin
-- Make sure that in case of failure, the temp files will be deleted -- Make sure that in case of failure, the temp files will be deleted
......
gcc/ada/make.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,254 +25,12 @@ ...@@ -25,254 +25,12 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- The following package implements the facilities to recursively -- The following package implements the facilities to recursively
-- compile (a la make), bind and/or link a set of sources. This package -- compile (a la make), bind and/or link a set of sources.
-- 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;
package Make is 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; procedure Gnatmake;
-- The driver of gnatmake. This routine puts it all together. -- The driver of gnatmake. For more information on gnatmake and its
-- This utility can be used to automatically (re)compile (using -- precise usage please refer to the gnat documentation.
-- 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
end Make; end Make;
gcc/ada/sem_mech.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -27,13 +27,14 @@ ...@@ -27,13 +27,14 @@
with Atree; use Atree; with Atree; use Atree;
with Einfo; use Einfo; with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Targparm; use Targparm; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Sem; use Sem; with Sem; use Sem;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Snames; use Snames; with Snames; use Snames;
with Stand; use Stand; with Stand; use Stand;
with Targparm; use Targparm;
package body Sem_Mech is package body Sem_Mech is
...@@ -274,6 +275,7 @@ package body Sem_Mech is ...@@ -274,6 +275,7 @@ package body Sem_Mech is
when Convention_Assembler | when Convention_Assembler |
Convention_C | Convention_C |
Convention_CIL |
Convention_CPP | Convention_CPP |
Convention_Java | Convention_Java |
Convention_Stdcall => Convention_Stdcall =>
......
gcc/ada/targparm.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -25,7 +25,6 @@ ...@@ -25,7 +25,6 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Csets; use Csets; with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
...@@ -44,13 +43,14 @@ package body Targparm is ...@@ -44,13 +43,14 @@ package body Targparm is
BDC, -- Backend_Divide_Checks BDC, -- Backend_Divide_Checks
BOC, -- Backend_Overflow_Checks BOC, -- Backend_Overflow_Checks
CLA, -- Command_Line_Args CLA, -- Command_Line_Args
CLI, -- CLI (.NET)
CRT, -- Configurable_Run_Times CRT, -- Configurable_Run_Times
CSV, -- Compiler_System_Version
D32, -- Duration_32_Bits D32, -- Duration_32_Bits
DEN, -- Denorm DEN, -- Denorm
EXS, -- Exit_Status_Supported EXS, -- Exit_Status_Supported
FEL, -- Frontend_Layout FEL, -- Frontend_Layout
FFO, -- Fractional_Fixed_Ops FFO, -- Fractional_Fixed_Ops
JVM, -- JVM
MOV, -- Machine_Overflows MOV, -- Machine_Overflows
MRN, -- Machine_Rounds MRN, -- Machine_Rounds
PAS, -- Preallocated_Stacks PAS, -- Preallocated_Stacks
...@@ -68,9 +68,6 @@ package body Targparm is ...@@ -68,9 +68,6 @@ package body Targparm is
ZCD, -- ZCX_By_Default ZCD, -- ZCX_By_Default
ZCG); -- GCC_ZCX_Support 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); Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
-- Flag is set True if corresponding parameter is scanned -- Flag is set True if corresponding parameter is scanned
...@@ -80,13 +77,14 @@ package body Targparm is ...@@ -80,13 +77,14 @@ package body Targparm is
BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks"; BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks"; BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
CLA_Str : aliased constant Source_Buffer := "Command_Line_Args"; 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"; 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"; D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
DEN_Str : aliased constant Source_Buffer := "Denorm"; DEN_Str : aliased constant Source_Buffer := "Denorm";
EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported"; EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
FEL_Str : aliased constant Source_Buffer := "Frontend_Layout"; FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops"; FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
JVM_Str : aliased constant Source_Buffer := "JVM";
MOV_Str : aliased constant Source_Buffer := "Machine_Overflows"; MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
MRN_Str : aliased constant Source_Buffer := "Machine_Rounds"; MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks"; PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
...@@ -113,13 +111,14 @@ package body Targparm is ...@@ -113,13 +111,14 @@ package body Targparm is
BDC_Str'Access, BDC_Str'Access,
BOC_Str'Access, BOC_Str'Access,
CLA_Str'Access, CLA_Str'Access,
CLI_Str'Access,
CRT_Str'Access, CRT_Str'Access,
CSV_Str'Access,
D32_Str'Access, D32_Str'Access,
DEN_Str'Access, DEN_Str'Access,
EXS_Str'Access, EXS_Str'Access,
FEL_Str'Access, FEL_Str'Access,
FFO_Str'Access, FFO_Str'Access,
JVM_Str'Access,
MOV_Str'Access, MOV_Str'Access,
MRN_Str'Access, MRN_Str'Access,
PAS_Str'Access, PAS_Str'Access,
...@@ -549,13 +548,22 @@ package body Targparm is ...@@ -549,13 +548,22 @@ package body Targparm is
when BDC => Backend_Divide_Checks_On_Target := Result; when BDC => Backend_Divide_Checks_On_Target := Result;
when BOC => Backend_Overflow_Checks_On_Target := Result; when BOC => Backend_Overflow_Checks_On_Target := Result;
when CLA => Command_Line_Args_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 CRT => Configurable_Run_Time_On_Target := Result;
when CSV => Compiler_System_Version := Result;
when D32 => Duration_32_Bits_On_Target := Result; when D32 => Duration_32_Bits_On_Target := Result;
when DEN => Denorm_On_Target := Result; when DEN => Denorm_On_Target := Result;
when EXS => Exit_Status_Supported_On_Target := Result; when EXS => Exit_Status_Supported_On_Target := Result;
when FEL => Frontend_Layout_On_Target := Result; when FEL => Frontend_Layout_On_Target := Result;
when FFO => Fractional_Fixed_Ops_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 MOV => Machine_Overflows_On_Target := Result;
when MRN => Machine_Rounds_On_Target := Result; when MRN => Machine_Rounds_On_Target := Result;
when PAS => Preallocated_Stacks_On_Target := Result; when PAS => Preallocated_Stacks_On_Target := Result;
...@@ -614,27 +622,6 @@ package body Targparm is ...@@ -614,27 +622,6 @@ package body Targparm is
Multi_Unit_Index_Character := '$'; Multi_Unit_Index_Character := '$';
end if; 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 if Fatal then
raise Unrecoverable_Error; raise Unrecoverable_Error;
end if; end if;
......
gcc/ada/targparm.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -77,6 +77,7 @@ ...@@ -77,6 +77,7 @@
-- only item in this category is whether type Address is private. -- only item in this category is whether type Address is private.
with Rident; use Rident; with Rident; use Rident;
with Namet; use Namet;
with Types; use Types; with Types; use Types;
package Targparm is package Targparm is
...@@ -166,11 +167,11 @@ package Targparm is ...@@ -166,11 +167,11 @@ package Targparm is
-------------------------- --------------------------
Executable_Extension_On_Target : Name_Id := No_Name; Executable_Extension_On_Target : Name_Id := No_Name;
-- Executable extension on the target. -- Executable extension on the target. This name is useful for setting
-- This name is useful for setting the executable extension in a -- the executable extension in a dynamic way, e.g. depending on the
-- dynamic way, e.g. depending on the run-time used, rather than -- run time used, rather than using a configure-time macro as done by
-- using a configure-time macro as done by Get_Target_Executable_Suffix. -- Get_Target_Executable_Suffix. If not set (No_Name), instead use
-- If not set (No_Name), use GNAT.OS_Lib.Get_Target_Executable_Suffix. -- System.OS_Lib.Get_Target_Executable_Suffix.
----------------------- -----------------------
-- Target Parameters -- -- Target Parameters --
...@@ -187,24 +188,14 @@ package Targparm is ...@@ -187,24 +188,14 @@ package Targparm is
-- text buffer containing the source of the system package. -- text buffer containing the source of the system package.
-- The default values here are used if no value is found in system.ads. -- 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 -- This should normally happen if the special version of system.ads used
-- used by the compiler itself is in use. The default values are suitable -- by the compiler itself is in use or if the value is only relevant to
-- for use by the compiler itself in normal environments. This approach -- a particular target (e.g. OpenVMS, AAMP). The default values are
-- allows the possibility of new versions of the compiler (possibly with -- suitable for use in normal environments. This approach allows the
-- new system parameters added) being used to compile older versions of -- possibility of new versions of the compiler (possibly with new system
-- the compiler sources. This is not guaranteed to work, but often will -- parameters added) being used to compile older versions of the compiler
-- and by setting appropriate default values, we make it more likely that -- sources, as well as avoiding duplicating values in all system-*.ads
-- this can succeed. -- files for flags that are used on a few platforms only.
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.
---------------------------- ----------------------------
-- Special Target Control -- -- Special Target Control --
...@@ -220,6 +211,10 @@ package Targparm is ...@@ -220,6 +211,10 @@ package Targparm is
OpenVMS_On_Target : Boolean := False; OpenVMS_On_Target : Boolean := False;
-- Set to True if target is OpenVMS -- 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 -- -- Backend Arithmetic Checks --
------------------------------- -------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment