--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
projects / gcc.git / commitdiff