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