Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                            M L I B . P R J                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--                     Copyright (C) 2001-2011, AdaCore                     --

--                                                                          --

-- 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 3,  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 COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with ALI;      use ALI;

with Gnatvsn;  use Gnatvsn;

with Makeutl;  use Makeutl;

with MLib.Fil; use MLib.Fil;

with MLib.Tgt; use MLib.Tgt;

with MLib.Utl; use MLib.Utl;

with Opt;

with Output;   use Output;

with Prj.Com;  use Prj.Com;

with Prj.Env;  use Prj.Env;

with Prj.Util; use Prj.Util;

with Sinput.P;

with Snames;   use Snames;

with Switch;   use Switch;

with Table;

with Targparm; use Targparm;

with Tempdir;

with Types;    use Types;

with Ada.Characters.Handling;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;

with GNAT.HTable;

with Interfaces.C_Streams;      use Interfaces.C_Streams;

with System;                    use System;

with System.Case_Util;          use System.Case_Util;

package body MLib.Prj is

   Prj_Add_Obj_Files : Types.Int;

   pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files");

   Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0;

   --  Indicates if object files in pragmas Linker_Options (found in the

   --  binder generated file) should be taken when linking a stand-alone

   --  library. False for Windows, True for other platforms.

   ALI_Suffix : constant String := ".ali";

   B_Start : String_Ptr := new String'("b~");

   --  Prefix of bind file, changed to b__ for VMS

   S_Osinte_Ads : File_Name_Type := No_File;

   --  Name_Id for "s-osinte.ads"

   S_Dec_Ads : File_Name_Type := No_File;

   --  Name_Id for "dec.ads"

   Arguments : String_List_Access := No_Argument;

   --  Used to accumulate arguments for the invocation of gnatbind and of the

   --  compiler. Also used to collect the interface ALI when copying the ALI

   --  files to the library directory.

   Argument_Number : Natural := 0;

   --  Index of the last argument in Arguments

   Initial_Argument_Max : constant := 10;

   --  Where does the magic constant 10 come from???

   No_Main_String        : aliased String         := "-n";

   No_Main               : constant String_Access := No_Main_String'Access;

   Output_Switch_String  : aliased String         := "-o";

   Output_Switch         : constant String_Access :=

                             Output_Switch_String'Access;

   Compile_Switch_String : aliased String         := "-c";

   Compile_Switch        : constant String_Access :=

                             Compile_Switch_String'Access;

   No_Warning_String     : aliased String         := "-gnatws";

   No_Warning            : constant String_Access := No_Warning_String'Access;

   Auto_Initialize : constant String := "-a";

   --  List of objects to put inside the library

   Object_Files : Argument_List_Access;

   package Objects is new Table.Table

     (Table_Name           => "Mlib.Prj.Objects",

      Table_Component_Type => String_Access,

      Table_Index_Type     => Natural,

      Table_Low_Bound      => 1,

      Table_Initial        => 50,

      Table_Increment      => 100);

   package Objects_Htable is new GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Boolean,

      No_Element => False,

      Key        => Name_Id,

      Hash       => Hash,

      Equal      => "=");

   --  List of ALI files

   Ali_Files : Argument_List_Access;

   package ALIs is new Table.Table

     (Table_Name           => "Mlib.Prj.Alis",

      Table_Component_Type => String_Access,

      Table_Index_Type     => Natural,

      Table_Low_Bound      => 1,

      Table_Initial        => 50,

      Table_Increment      => 100);

   --  List of options set in the command line

   Options : Argument_List_Access;

   package Opts is new Table.Table

     (Table_Name           => "Mlib.Prj.Opts",

      Table_Component_Type => String_Access,

      Table_Index_Type     => Natural,

      Table_Low_Bound      => 1,

      Table_Initial        => 5,

      Table_Increment      => 100);

   --  All the ALI file in the library

   package Library_ALIs is new GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Boolean,

      No_Element => False,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  The ALI files in the interface sets

   package Interface_ALIs is new GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Boolean,

      No_Element => False,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  The ALI files that have been processed to check if the corresponding

   --  library unit is in the interface set.

   package Processed_ALIs is new GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Boolean,

      No_Element => False,

      Key        => File_Name_Type,

      Hash       => Hash,

      Equal      => "=");

   --  The projects imported directly or indirectly

   package Processed_Projects is new GNAT.HTable.Simple_HTable

     (Header_Num => Header_Num,

      Element    => Boolean,

      No_Element => False,

      Key        => Name_Id,

      Hash       => Hash,

      Equal      => "=");

   --  The library projects imported directly or indirectly

   package Library_Projs is new Table.Table (

     Table_Component_Type => Project_Id,

     Table_Index_Type     => Integer,

     Table_Low_Bound      => 1,

     Table_Initial        => 10,

     Table_Increment      => 10,

     Table_Name           => "Make.Library_Projs");

   type Build_Mode_State is (None, Static, Dynamic, Relocatable);

   procedure Add_Argument (S : String);

   --  Add one argument to Arguments array, if array is full, double its size

   function ALI_File_Name (Source : String) return String;

   --  Return the ALI file name corresponding to a source

   procedure Check (Filename : String);

   --  Check if filename is a regular file. Fail if it is not

   procedure Check_Context;

   --  Check each object files in table Object_Files

   --  Fail if any of them is not a regular file

   procedure Copy_Interface_Sources

     (For_Project : Project_Id;

      In_Tree     : Project_Tree_Ref;

      Interfaces  : Argument_List;

      To_Dir      : Path_Name_Type);

   --  Copy the interface sources of a SAL to directory To_Dir

   procedure Display (Executable : String);

   --  Display invocation of gnatbind and of the compiler with the arguments

   --  in Arguments, except when Quiet_Output is True.

   function Index (S, Pattern : String) return Natural;

   --  Return the last occurrence of Pattern in S, or 0 if none

   procedure Process_Binder_File (Name : String);

   --  For Stand-Alone libraries, get the Linker Options in the binder

   --  generated file.

   procedure Reset_Tables;

   --  Make sure that all the above tables are empty

   --  (Objects, Ali_Files, Options).

   function SALs_Use_Constructors return Boolean;

   --  Indicate if Stand-Alone Libraries are automatically initialized using

   --  the constructor mechanism.

   ------------------

   -- Add_Argument --

   ------------------

   procedure Add_Argument (S : String) is

   begin

      if Argument_Number = Arguments'Last then

         declare

            New_Args : constant String_List_Access :=

              new String_List (1 .. 2 * Arguments'Last);

         begin

            --  Copy the String_Accesses and set them to null in Arguments

            --  so that they will not be deallocated by the call to

            --  Free (Arguments).

            New_Args (Arguments'Range) := Arguments.all;

            Arguments.all := (others => null);

            Free (Arguments);

            Arguments := New_Args;

         end;

      end if;

      Argument_Number := Argument_Number + 1;

      Arguments (Argument_Number) := new String'(S);

   end Add_Argument;

   -------------------

   -- ALI_File_Name --

   -------------------

   function ALI_File_Name (Source : String) return String is

   begin

      --  If the source name has an extension, then replace it with

      --  the ALI suffix.

      for Index in reverse Source'First + 1 .. Source'Last loop

         if Source (Index) = '.' then

            return Source (Source'First .. Index - 1) & ALI_Suffix;

         end if;

      end loop;

      --  If there is no dot, or if it is the first character, just add the

      --  ALI suffix.

      return Source & ALI_Suffix;

   end ALI_File_Name;

   -------------------

   -- Build_Library --

   -------------------

   procedure Build_Library

     (For_Project   : Project_Id;

      In_Tree       : Project_Tree_Ref;

      Gnatbind      : String;

      Gnatbind_Path : String_Access;

      Gcc           : String;

      Gcc_Path      : String_Access;

      Bind          : Boolean := True;

      Link          : Boolean := True)

   is

      Maximum_Size : Integer;

      pragma Import (C, Maximum_Size, "__gnat_link_max");

      --  Maximum number of bytes to put in an invocation of gnatbind

      Size : Integer;

      --  The number of bytes for the invocation of gnatbind

      Warning_For_Library : Boolean := False;

      --  Set True for first warning for a unit missing from the interface set

      Current_Proj : Project_Id;

      Libgnarl_Needed   : Yes_No_Unknown := For_Project.Libgnarl_Needed;

      --  Set True if library needs to be linked with libgnarl

      Libdecgnat_Needed : Boolean := False;

      --  On OpenVMS, set True if library needs to be linked with libdecgnat

      Object_Directory_Path : constant String :=

                                Get_Name_String

                                  (For_Project.Object_Directory.Display_Name);

      Standalone   : constant Boolean := For_Project.Standalone_Library /= No;

      Project_Name : constant String := Get_Name_String (For_Project.Name);

      Current_Dir  : constant String := Get_Current_Dir;

      Lib_Filename : String_Access;

      Lib_Dirpath  : String_Access;

      Lib_Version  : String_Access := new String'("");

      The_Build_Mode : Build_Mode_State := None;

      Success : Boolean := False;

      Library_Options : Variable_Value := Nil_Variable_Value;

      Driver_Name : Name_Id := No_Name;

      In_Main_Object_Directory : Boolean := True;

      Foreign_Sources : Boolean;

      Rpath : String_Access := null;

      --  Allocated only if Path Option is supported

      Rpath_Last : Natural := 0;

      --  Index of last valid character of Rpath

      Initial_Rpath_Length : constant := 200;

      --  Initial size of Rpath, when first allocated

      Path_Option : String_Access := Linker_Library_Path_Option;

      --  If null, Path Option is not supported. Not a constant so that it can

      --  be deallocated.

      First_ALI : File_Name_Type := No_File;

      --  Store the ALI file name of a source of the library (the first found)

      procedure Add_ALI_For (Source : File_Name_Type);

      --  Add name of the ALI file corresponding to Source to the Arguments

      procedure Add_Rpath (Path : String);

      --  Add a path name to Rpath

      function Check_Project (P : Project_Id) return Boolean;

      --  Returns True if P is For_Project or a project extended by For_Project

      procedure Check_Libs (ALI_File : String; Main_Project : Boolean);

      --  Set Libgnarl_Needed if the ALI_File indicates that there is a need

      --  to link with -lgnarl (this is the case when there is a dependency

      --  on s-osinte.ads). On OpenVMS, set Libdecgnat_Needed if the ALI file

      --  indicates that there is a need to link with -ldecgnat (this is the

      --  case when there is a dependency on dec.ads).

      procedure Process (The_ALI : File_Name_Type);

      --  Check if the closure of a library unit which is or should be in the

      --  interface set is also in the interface set. Issue a warning for each

      --  missing library unit.

      procedure Process_Imported_Libraries;

      --  Add the -L and -l switches for the imported Library Project Files,

      --  and, if Path Option is supported, the library directory path names

      --  to Rpath.

      -----------------

      -- Add_ALI_For --

      -----------------

      procedure Add_ALI_For (Source : File_Name_Type) is

         ALI    : constant String := ALI_File_Name (Get_Name_String (Source));

         ALI_Id : File_Name_Type;

      begin

         if Bind then

            Add_Argument (ALI);

         end if;

         Name_Len := 0;

         Add_Str_To_Name_Buffer (S => ALI);

         ALI_Id := Name_Find;

         --  Add the ALI file name to the library ALIs

         if Bind then

            Library_ALIs.Set (ALI_Id, True);

         end if;

         --  Set First_ALI, if not already done

         if First_ALI = No_File then

            First_ALI := ALI_Id;

         end if;

      end Add_ALI_For;

      ---------------

      -- Add_Rpath --

      ---------------

      procedure Add_Rpath (Path : String) is

         procedure Double;

         --  Double Rpath size

         ------------

         -- Double --

         ------------

         procedure Double is

            New_Rpath : constant String_Access :=

                          new String (1 .. 2 * Rpath'Length);

         begin

            New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last);

            Free (Rpath);

            Rpath := New_Rpath;

         end Double;

      --  Start of processing for Add_Rpath

      begin

         --  If first path, allocate initial Rpath

         if Rpath = null then

            Rpath := new String (1 .. Initial_Rpath_Length);

            Rpath_Last := 0;

         else

            --  Otherwise, add a path separator between two path names

            if Rpath_Last = Rpath'Last then

               Double;

            end if;

            Rpath_Last := Rpath_Last + 1;

            Rpath (Rpath_Last) := Path_Separator;

         end if;

         --  Increase Rpath size until it is large enough

         while Rpath_Last + Path'Length > Rpath'Last loop

            Double;

         end loop;

         --  Add the path name

         Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path;

         Rpath_Last := Rpath_Last + Path'Length;

      end Add_Rpath;

      -------------------

      -- Check_Project --

      -------------------

      function Check_Project (P : Project_Id) return Boolean is

      begin

         if P = For_Project then

            return True;

         elsif P /= No_Project then

            declare

               Proj : Project_Id;

            begin

               Proj := For_Project;

               while Proj.Extends /= No_Project loop

                  if P = Proj.Extends then

                     return True;

                  end if;

                  Proj := Proj.Extends;

               end loop;

            end;

         end if;

         return False;

      end Check_Project;

      ----------------

      -- Check_Libs --

      ----------------

      procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is

         Lib_File : File_Name_Type;

         Text     : Text_Buffer_Ptr;

         Id       : ALI.ALI_Id;

      begin

         if Libgnarl_Needed /= Yes

           or else

            (Main_Project

              and then OpenVMS_On_Target)

         then

            --  Scan the ALI file

            Name_Len := ALI_File'Length;

            Name_Buffer (1 .. Name_Len) := ALI_File;

            Lib_File := Name_Find;

            Text := Read_Library_Info (Lib_File, True);

            Id := ALI.Scan_ALI

                    (F          => Lib_File,

                     T          => Text,

                     Ignore_ED  => False,

                     Err        => True,

                     Read_Lines => "D");

            Free (Text);

            --  Look for s-osinte.ads in the dependencies

            for Index in ALI.ALIs.Table (Id).First_Sdep ..

                         ALI.ALIs.Table (Id).Last_Sdep

            loop

               if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then

                  Libgnarl_Needed := Yes;

                  if Main_Project then

                     For_Project.Libgnarl_Needed := Yes;

                  else

                     exit;

                  end if;

               elsif OpenVMS_On_Target then

                  if ALI.Sdep.Table (Index).Sfile = S_Dec_Ads then

                     Libdecgnat_Needed := True;

                  end if;

               end if;

            end loop;

         end if;

      end Check_Libs;

      -------------

      -- Process --

      -------------

      procedure Process (The_ALI : File_Name_Type) is

         Text       : Text_Buffer_Ptr;

         Idread     : ALI_Id;

         First_Unit : ALI.Unit_Id;

         Last_Unit  : ALI.Unit_Id;

         Unit_Data  : Unit_Record;

         Afile      : File_Name_Type;

      begin

         --  Nothing to do if the ALI file has already been processed.

         --  This happens if an interface imports another interface.

         if not Processed_ALIs.Get (The_ALI) then

            Processed_ALIs.Set (The_ALI, True);

            Text := Read_Library_Info (The_ALI);

            if Text /= null then

               Idread :=

                 Scan_ALI

                   (F         => The_ALI,

                    T         => Text,

                    Ignore_ED => False,

                    Err       => True);

               Free (Text);

               if Idread /= No_ALI_Id then

                  First_Unit := ALI.ALIs.Table (Idread).First_Unit;

                  Last_Unit  := ALI.ALIs.Table (Idread).Last_Unit;

                  --  Process both unit (spec and body) if the body is needed

                  --  by the spec (inline or generic). Otherwise, just process

                  --  the spec.

                  if First_Unit /= Last_Unit and then

                    not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL

                  then

                     First_Unit := Last_Unit;

                  end if;

                  for Unit in First_Unit .. Last_Unit loop

                     Unit_Data := ALI.Units.Table (Unit);

                     --  Check if each withed unit which is in the library is

                     --  also in the interface set, if it has not yet been

                     --  processed.

                     for W in Unit_Data.First_With .. Unit_Data.Last_With loop

                        Afile := Withs.Table (W).Afile;

                        if Afile /= No_File and then Library_ALIs.Get (Afile)

                          and then not Processed_ALIs.Get (Afile)

                        then

                           if not Interface_ALIs.Get (Afile) then

                              if not Warning_For_Library then

                                 Write_Str ("Warning: In library project """);

                                 Get_Name_String (Current_Proj.Name);

                                 To_Mixed (Name_Buffer (1 .. Name_Len));

                                 Write_Str (Name_Buffer (1 .. Name_Len));

                                 Write_Line ("""");

                                 Warning_For_Library := True;

                              end if;

                              Write_Str ("         Unit """);

                              Get_Name_String (Withs.Table (W).Uname);

                              To_Mixed (Name_Buffer (1 .. Name_Len - 2));

                              Write_Str (Name_Buffer (1 .. Name_Len - 2));

                              Write_Line (""" is not in the interface set");

                              Write_Str ("         but it is needed by ");

                              case Unit_Data.Utype is

                                 when Is_Spec =>

                                    Write_Str ("the spec of ");

                                 when Is_Body =>

                                    Write_Str ("the body of ");

                                 when others =>

                                    null;

                              end case;

                              Write_Str ("""");

                              Get_Name_String (Unit_Data.Uname);

                              To_Mixed (Name_Buffer (1 .. Name_Len - 2));

                              Write_Str (Name_Buffer (1 .. Name_Len - 2));

                              Write_Line ("""");

                           end if;

                           --  Now, process this unit

                           Process (Afile);

                        end if;

                     end loop;

                  end loop;

               end if;

            end if;

         end if;

      end Process;

      --------------------------------

      -- Process_Imported_Libraries --

      --------------------------------

      procedure Process_Imported_Libraries is

         Current : Project_Id;

         procedure Process_Project (Project : Project_Id);

         --  Process Project and its imported projects recursively.

         --  Add any library projects to table Library_Projs.

         ---------------------

         -- Process_Project --

         ---------------------

         procedure Process_Project (Project : Project_Id) is

            Imported : Project_List;

         begin

            --  Nothing to do if process has already been processed

            if not Processed_Projects.Get (Project.Name) then

               Processed_Projects.Set (Project.Name, True);

               --  Call Process_Project recursively for any imported project.

               --  We first process the imported projects to guarantee that

               --  we have a proper reverse order for the libraries.

               Imported := Project.Imported_Projects;

               while Imported /= null loop

                  if Imported.Project /= No_Project then

                     Process_Project (Imported.Project);

                  end if;

                  Imported := Imported.Next;

               end loop;

               --  If it is a library project, add it to Library_Projs

               if Project /= For_Project and then Project.Library then

                  Library_Projs.Increment_Last;

                  Library_Projs.Table (Library_Projs.Last) := Project;

                  --  Check if because of this library we need to use libgnarl

                  if Libgnarl_Needed = Unknown then

                     if Project.Libgnarl_Needed = Unknown

                       and then Project.Object_Directory /= No_Path_Information

                     then

                        --  Check if libgnarl is needed for this library

                        declare

                           Object_Dir_Path : constant String :=

                                               Get_Name_String

                                                 (Project.Object_Directory.

                                                    Display_Name);

                           Object_Dir      : Dir_Type;

                           Filename        : String (1 .. 255);

                           Last            : Natural;

                        begin

                           Open (Object_Dir, Object_Dir_Path);

                           --  For all entries in the object directory

                           loop

                              Read (Object_Dir, Filename, Last);

                              exit when Last = 0;

                              --  Check if it is an object file

                              if Is_Obj (Filename (1 .. Last)) then

                                 declare

                                    Object_Path : constant String :=

                                                    Normalize_Pathname

                                                      (Object_Dir_Path &

                                                       Directory_Separator &

                                                       Filename (1 .. Last));

                                    ALI_File    : constant String :=

                                                    Ext_To

                                                      (Object_Path, "ali");

                                 begin

                                    if Is_Regular_File (ALI_File) then

                                       --  Find out if for this ALI file,

                                       --  libgnarl is necessary.

                                       Check_Libs

                                         (ALI_File, Main_Project => False);

                                       if Libgnarl_Needed = Yes then

                                          Project.Libgnarl_Needed := Yes;

                                          For_Project.Libgnarl_Needed := Yes;

                                          exit;

                                       end if;

                                    end if;

                                 end;

                              end if;

                           end loop;

                           Close (Object_Dir);

                        end;

                     end if;

                     if Project.Libgnarl_Needed = Yes then

                        Libgnarl_Needed := Yes;

                        For_Project.Libgnarl_Needed := Yes;

                     end if;

                  end if;

               end if;

            end if;

         end Process_Project;

      --  Start of processing for Process_Imported_Libraries

      begin

         --  Build list of library projects imported directly or indirectly,

         --  in the reverse order.

         Process_Project (For_Project);

         --  Add the -L and -l switches and, if the Rpath option is supported,

         --  add the directory to the Rpath. As the library projects are in the

         --  wrong order, process from the last to the first.

         for Index in reverse 1 .. Library_Projs.Last loop

            Current := Library_Projs.Table (Index);

            Get_Name_String (Current.Library_Dir.Display_Name);

            Opts.Increment_Last;

            Opts.Table (Opts.Last) :=

              new String'("-L" & Name_Buffer (1 .. Name_Len));

            if Path_Option /= null then

               Add_Rpath (Name_Buffer (1 .. Name_Len));

            end if;

            Opts.Increment_Last;

            Opts.Table (Opts.Last) :=