* makeutl.ads, makeutl.adb: New files.
From-SVN: r80868
This commit is contained in:
Vincent Celier
Arnaud Charlet
parent
8e48104da7
commit
8f9df7d802
3 changed files with 477 additions and 0 deletions
|
|
@ -91,6 +91,8 @@
|
|||
(Gnatmake): Move sorting of linker options to function
|
||||
Makeutl.Linker_Options_Switches.
|
||||
|
||||
* makeutl.ads, makeutl.adb: New files.
|
||||
|
||||
* Makefile.in: Add makeutl.o to the object files for gnatmake
|
||||
|
||||
* makeusg.adb: Add line for new switch -eL.
|
||||
|
|
|
|||
387
gcc/ada/makeutl.adb
Normal file
387
gcc/ada/makeutl.adb
Normal file
|
|
@ -0,0 +1,387 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- M A K E U T L --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
||||
-- MA 02111-1307, USA. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Namet; use Namet;
|
||||
with Prj; use Prj;
|
||||
with Prj.Ext;
|
||||
with Prj.Util;
|
||||
with Snames; use Snames;
|
||||
with Table;
|
||||
with Types; use Types;
|
||||
|
||||
package body Makeutl is
|
||||
|
||||
type Linker_Options_Data is record
|
||||
Project : Project_Id;
|
||||
Options : String_List_Id;
|
||||
end record;
|
||||
|
||||
Linker_Option_Initial_Count : constant := 20;
|
||||
|
||||
Linker_Options_Buffer : String_List_Access :=
|
||||
new String_List (1 .. Linker_Option_Initial_Count);
|
||||
|
||||
Last_Linker_Option : Natural := 0;
|
||||
|
||||
package Linker_Opts is new Table.Table (
|
||||
Table_Component_Type => Linker_Options_Data,
|
||||
Table_Index_Type => Integer,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 10,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Make.Linker_Opts");
|
||||
|
||||
procedure Add_Linker_Option (Option : String);
|
||||
|
||||
-----------------------
|
||||
-- Add_Linker_Option --
|
||||
-----------------------
|
||||
|
||||
procedure Add_Linker_Option (Option : String) is
|
||||
begin
|
||||
if Option'Length > 0 then
|
||||
if Last_Linker_Option = Linker_Options_Buffer'Last then
|
||||
declare
|
||||
New_Buffer : constant String_List_Access :=
|
||||
new String_List
|
||||
(1 .. Linker_Options_Buffer'Last +
|
||||
Linker_Option_Initial_Count);
|
||||
begin
|
||||
New_Buffer (Linker_Options_Buffer'Range) :=
|
||||
Linker_Options_Buffer.all;
|
||||
Linker_Options_Buffer.all := (others => null);
|
||||
Free (Linker_Options_Buffer);
|
||||
Linker_Options_Buffer := New_Buffer;
|
||||
end;
|
||||
end if;
|
||||
|
||||
Last_Linker_Option := Last_Linker_Option + 1;
|
||||
Linker_Options_Buffer (Last_Linker_Option) := new String'(Option);
|
||||
end if;
|
||||
end Add_Linker_Option;
|
||||
|
||||
----------------------------
|
||||
-- Is_External_Assignment --
|
||||
----------------------------
|
||||
|
||||
function Is_External_Assignment (Argv : String) return Boolean is
|
||||
Start : Positive := 3;
|
||||
Finish : Natural := Argv'Last;
|
||||
Equal_Pos : Natural;
|
||||
|
||||
begin
|
||||
if Argv'Last < 5 then
|
||||
return False;
|
||||
|
||||
elsif Argv (3) = '"' then
|
||||
if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then
|
||||
return False;
|
||||
else
|
||||
Start := 4;
|
||||
Finish := Argv'Last - 1;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Equal_Pos := Start;
|
||||
|
||||
while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop
|
||||
Equal_Pos := Equal_Pos + 1;
|
||||
end loop;
|
||||
|
||||
if Equal_Pos = Start
|
||||
or else Equal_Pos >= Finish
|
||||
then
|
||||
return False;
|
||||
|
||||
else
|
||||
Prj.Ext.Add
|
||||
(External_Name => Argv (Start .. Equal_Pos - 1),
|
||||
Value => Argv (Equal_Pos + 1 .. Finish));
|
||||
return True;
|
||||
end if;
|
||||
end Is_External_Assignment;
|
||||
|
||||
-----------------------------
|
||||
-- Linker_Options_Switches --
|
||||
-----------------------------
|
||||
|
||||
function Linker_Options_Switches
|
||||
(Project : Project_Id)
|
||||
return String_List
|
||||
is
|
||||
|
||||
----------------------------------
|
||||
-- Recursive_Add_Linker_Options --
|
||||
----------------------------------
|
||||
|
||||
procedure Recursive_Add_Linker_Options (Proj : Project_Id);
|
||||
|
||||
procedure Recursive_Add_Linker_Options (Proj : Project_Id) is
|
||||
Data : Project_Data;
|
||||
Linker_Package : Package_Id;
|
||||
Options : Variable_Value;
|
||||
Imported : Project_List;
|
||||
begin
|
||||
if Proj /= No_Project then
|
||||
Data := Projects.Table (Proj);
|
||||
|
||||
if not Data.Seen then
|
||||
Projects.Table (Proj).Seen := True;
|
||||
Imported := Data.Imported_Projects;
|
||||
|
||||
while Imported /= Empty_Project_List loop
|
||||
Recursive_Add_Linker_Options
|
||||
(Project_Lists.Table (Imported).Project);
|
||||
Imported := Project_Lists.Table (Imported).Next;
|
||||
end loop;
|
||||
|
||||
if Proj /= Project then
|
||||
Linker_Package :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Linker,
|
||||
In_Packages => Data.Decl.Packages);
|
||||
Options :=
|
||||
Prj.Util.Value_Of
|
||||
(Name => Name_Ada,
|
||||
Attribute_Or_Array_Name => Name_Linker_Options,
|
||||
In_Package => Linker_Package);
|
||||
|
||||
-- If attribute is present, add the project with
|
||||
-- the attribute to table Linker_Opts.
|
||||
|
||||
if Options /= Nil_Variable_Value then
|
||||
Linker_Opts.Increment_Last;
|
||||
Linker_Opts.Table (Linker_Opts.Last) :=
|
||||
(Project => Proj, Options => Options.Values);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end Recursive_Add_Linker_Options;
|
||||
|
||||
begin
|
||||
Linker_Opts.Init;
|
||||
|
||||
for Index in 1 .. Projects.Last loop
|
||||
Projects.Table (Index).Seen := False;
|
||||
end loop;
|
||||
|
||||
Recursive_Add_Linker_Options (Project);
|
||||
|
||||
Last_Linker_Option := 0;
|
||||
|
||||
for Index in reverse 1 .. Linker_Opts.Last loop
|
||||
declare
|
||||
Options : String_List_Id := Linker_Opts.Table (Index).Options;
|
||||
Proj : constant Project_Id :=
|
||||
Linker_Opts.Table (Index).Project;
|
||||
Option : Name_Id;
|
||||
|
||||
begin
|
||||
-- If Dir_Path has not been computed for this project, do it now
|
||||
|
||||
if Projects.Table (Proj).Dir_Path = null then
|
||||
Projects.Table (Proj).Dir_Path :=
|
||||
new String'
|
||||
(Get_Name_String (Projects.Table (Proj). Directory));
|
||||
end if;
|
||||
|
||||
while Options /= Nil_String loop
|
||||
Option := String_Elements.Table (Options).Value;
|
||||
Options := String_Elements.Table (Options).Next;
|
||||
Add_Linker_Option (Get_Name_String (Option));
|
||||
|
||||
-- Object files and -L switches specified with
|
||||
-- relative paths and must be converted to
|
||||
-- absolute paths.
|
||||
|
||||
Test_If_Relative_Path
|
||||
(Switch =>
|
||||
Linker_Options_Buffer (Last_Linker_Option),
|
||||
Parent => Projects.Table (Proj).Dir_Path,
|
||||
Including_L_Switch => True);
|
||||
end loop;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
return Linker_Options_Buffer (1 .. Last_Linker_Option);
|
||||
end Linker_Options_Switches;
|
||||
|
||||
-----------
|
||||
-- Mains --
|
||||
-----------
|
||||
|
||||
package body Mains is
|
||||
|
||||
package Names is new Table.Table
|
||||
(Table_Component_Type => File_Name_Type,
|
||||
Table_Index_Type => Integer,
|
||||
Table_Low_Bound => 1,
|
||||
Table_Initial => 10,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Makeutl.Mains.Names");
|
||||
-- The table that stores the mains
|
||||
|
||||
Current : Natural := 0;
|
||||
-- The index of the last main retrieved from the table
|
||||
|
||||
--------------
|
||||
-- Add_Main --
|
||||
--------------
|
||||
|
||||
procedure Add_Main (Name : String) is
|
||||
begin
|
||||
Name_Len := 0;
|
||||
Add_Str_To_Name_Buffer (Name);
|
||||
Names.Increment_Last;
|
||||
Names.Table (Names.Last) := Name_Find;
|
||||
end Add_Main;
|
||||
|
||||
------------
|
||||
-- Delete --
|
||||
------------
|
||||
|
||||
procedure Delete is
|
||||
begin
|
||||
Names.Set_Last (0);
|
||||
Reset;
|
||||
end Delete;
|
||||
|
||||
---------------
|
||||
-- Next_Main --
|
||||
---------------
|
||||
|
||||
function Next_Main return String is
|
||||
begin
|
||||
if Current >= Names.Last then
|
||||
return "";
|
||||
|
||||
else
|
||||
Current := Current + 1;
|
||||
return Get_Name_String (Names.Table (Current));
|
||||
end if;
|
||||
end Next_Main;
|
||||
|
||||
---------------------
|
||||
-- Number_Of_Mains --
|
||||
---------------------
|
||||
|
||||
function Number_Of_Mains return Natural is
|
||||
begin
|
||||
return Names.Last;
|
||||
end Number_Of_Mains;
|
||||
|
||||
-----------
|
||||
-- Reset --
|
||||
-----------
|
||||
|
||||
procedure Reset is
|
||||
begin
|
||||
Current := 0;
|
||||
end Reset;
|
||||
|
||||
end Mains;
|
||||
|
||||
---------------------------
|
||||
-- Test_If_Relative_Path --
|
||||
---------------------------
|
||||
|
||||
procedure Test_If_Relative_Path
|
||||
(Switch : in out String_Access;
|
||||
Parent : String_Access;
|
||||
Including_L_Switch : Boolean := True)
|
||||
is
|
||||
begin
|
||||
if Switch /= null then
|
||||
|
||||
declare
|
||||
Sw : String (1 .. Switch'Length);
|
||||
Start : Positive;
|
||||
|
||||
begin
|
||||
Sw := Switch.all;
|
||||
|
||||
if Sw (1) = '-' then
|
||||
if Sw'Length >= 3
|
||||
and then (Sw (2) = 'A'
|
||||
or else Sw (2) = 'I'
|
||||
or else (Including_L_Switch and then Sw (2) = 'L'))
|
||||
then
|
||||
Start := 3;
|
||||
|
||||
if Sw = "-I-" then
|
||||
return;
|
||||
end if;
|
||||
|
||||
elsif Sw'Length >= 4
|
||||
and then (Sw (2 .. 3) = "aL"
|
||||
or else Sw (2 .. 3) = "aO"
|
||||
or else Sw (2 .. 3) = "aI")
|
||||
then
|
||||
Start := 4;
|
||||
|
||||
else
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Because relative path arguments to --RTS= may be relative
|
||||
-- to the search directory prefix, those relative path
|
||||
-- arguments are not converted.
|
||||
|
||||
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
|
||||
if Parent = null or else Parent'Length = 0 then
|
||||
Do_Fail
|
||||
("relative search path switches (""",
|
||||
Sw,
|
||||
""") are not allowed");
|
||||
|
||||
else
|
||||
Switch :=
|
||||
new String'
|
||||
(Sw (1 .. Start - 1) &
|
||||
Parent.all &
|
||||
Directory_Separator &
|
||||
Sw (Start .. Sw'Last));
|
||||
end if;
|
||||
end if;
|
||||
|
||||
else
|
||||
if not Is_Absolute_Path (Sw) then
|
||||
if Parent = null or else Parent'Length = 0 then
|
||||
Do_Fail
|
||||
("relative paths (""", Sw, """) are not allowed");
|
||||
|
||||
else
|
||||
Switch :=
|
||||
new String'(Parent.all & Directory_Separator & Sw);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end Test_If_Relative_Path;
|
||||
|
||||
end Makeutl;
|
||||
88
gcc/ada/makeutl.ads
Normal file
88
gcc/ada/makeutl.ads
Normal file
|
|
@ -0,0 +1,88 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- M A K E U T L --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004 Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
||||
-- for more details. You should have received a copy of the GNU General --
|
||||
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
||||
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
||||
-- MA 02111-1307, USA. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||
with Osint;
|
||||
with Prj; use Prj;
|
||||
|
||||
package Makeutl is
|
||||
|
||||
type Fail_Proc is access procedure
|
||||
(S1 : String; S2 : String := ""; S3 : String := "");
|
||||
Do_Fail : Fail_Proc := Osint.Fail'Access;
|
||||
|
||||
|
||||
function Is_External_Assignment (Argv : String) return Boolean;
|
||||
-- Verify that an external assignment switch is syntactically correct.
|
||||
-- Correct forms are
|
||||
-- -Xname=value
|
||||
-- -X"name=other value"
|
||||
-- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
|
||||
-- When this function returns True, the external assignment has
|
||||
-- been entered by a call to Prj.Ext.Add, so that in a project
|
||||
-- file, External ("name") will return "value".
|
||||
|
||||
-- Package Mains is used to store the mains specified on the command line
|
||||
-- and to retrieve them when a project file is used, to verify that the
|
||||
-- files exist and that they belong to a project file.
|
||||
|
||||
function Linker_Options_Switches (Project : Project_Id) return String_List;
|
||||
|
||||
package Mains is
|
||||
|
||||
-- Mains are stored in a table. An index is used to retrieve the mains
|
||||
-- from the table.
|
||||
|
||||
procedure Add_Main (Name : String);
|
||||
-- Add one main to the table
|
||||
|
||||
procedure Delete;
|
||||
-- Empty the table
|
||||
|
||||
procedure Reset;
|
||||
-- Reset the index to the beginning of the table
|
||||
|
||||
function Next_Main return String;
|
||||
-- Increase the index and return the next main.
|
||||
-- If table is exhausted, return an empty string.
|
||||
|
||||
function Number_Of_Mains return Natural;
|
||||
-- Returns the number of mains added with Add_Main since the last call
|
||||
-- to Delete.
|
||||
|
||||
end Mains;
|
||||
|
||||
procedure Test_If_Relative_Path
|
||||
(Switch : in out String_Access;
|
||||
Parent : String_Access;
|
||||
Including_L_Switch : Boolean := True);
|
||||
-- Test if Switch is a relative search path switch.
|
||||
-- If it is, fail if Parent is null, otherwise prepend the path with
|
||||
-- Parent. This subprogram is only called when using project files.
|
||||
-- For gnatbind switches, Including_L_Switch is False, because the
|
||||
-- argument of the -L switch is not a path.
|
||||
|
||||
end Makeutl;
|
||||
Loading…
Add table
Reference in a new issue