path: root/gcc/ada/mlib-prj.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                            M L I B . P R J                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--              Copyright (C) 2001, Ada Core Technologies, 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. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;

with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib;   use GNAT.OS_Lib;
with MLib.Fil;
with MLib.Tgt;
with Opt;
with Output;        use Output;
with Osint;         use Osint;
with Namet;         use Namet;
with Table;
with Types;         use Types;

package body MLib.Prj is

   package Files  renames MLib.Fil;
   package Target renames MLib.Tgt;

   --  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      => 50);

   --  List of non-Ada object files

   Foreign_Objects : Argument_List_Access;
   package Foreigns is new Table.Table
     (Table_Name           => "Mlib.Prj.Foreigns",
      Table_Component_Type => String_Access,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 20,
      Table_Increment      => 20);

   --  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      => 50);

   --  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      => 5);

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

   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 Reset_Tables;
   --  Make sure that all the above tables are empty
   --  (Objects, Foreign_Objects, Ali_Files, Options)

   -------------------
   -- Build_Library --
   -------------------

   procedure Build_Library (For_Project : Project_Id) is
      Data : constant Project_Data := Projects.Table (For_Project);

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

      Lib_Filename : String_Access;
      Lib_Dirpath  : String_Access := new String'(".");
      DLL_Address  : String_Access := new String'(Target.Default_DLL_Address);
      Lib_Version  : String_Access := new String'("");

      The_Build_Mode : Build_Mode_State := None;

   begin
      Reset_Tables;

      --  Fail if project is not a library project

      if not Data.Library then
         Fail ("project """, Project_Name, """ has no library");
      end if;

      Lib_Dirpath := new String'(Get_Name_String (Data.Library_Dir));
      Lib_Filename := new String'(Get_Name_String (Data.Library_Name));

      case Data.Library_Kind is
         when Static =>
            The_Build_Mode := Static;

         when Dynamic =>
            The_Build_Mode := Dynamic;

         when Relocatable =>
            The_Build_Mode := Relocatable;

            if Target.PIC_Option /= "" then
               Opts.Increment_Last;
               Opts.Table (Opts.Last) := new String'(Target.PIC_Option);
            end if;
      end case;

      --  Get the library version, if any

      if Data.Lib_Internal_Name /= No_Name then
         Lib_Version := new String'(Get_Name_String (Data.Lib_Internal_Name));
      end if;

      --  Add the objects found in the object directory

      declare
         Object_Dir : Dir_Type;
         Filename : String (1 .. 255);
         Last : Natural;
         Object_Dir_Path : constant String :=
           Get_Name_String (Data.Object_Directory);
      begin
         Open (Dir => Object_Dir, Dir_Name => 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 Files.Is_Obj (Filename (1 .. Last)) then
               --  record this object file

               Objects.Increment_Last;
               Objects.Table (Objects.Last) :=
                 new String' (Object_Dir_Path & Directory_Separator &
                              Filename (1 .. Last));

               if Is_Regular_File
                 (Object_Dir_Path &
                  Files.Ext_To (Object_Dir_Path &
                                Filename (1 .. Last), "ali"))
               then
                  --  Record the corresponding ali file

                  Alis.Increment_Last;
                  Alis.Table (Alis.Last) :=
                    new String' (Object_Dir_Path &
                                 Files.Ext_To
                                 (Filename (1 .. Last), "ali"));

               else
                  --  The object file is a foreign object file

                  Foreigns.Increment_Last;
                  Foreigns.Table (Foreigns.Last) :=
                    new String'(Object_Dir_Path &
                                Filename (1 .. Last));

               end if;
            end if;
         end loop;

         Close (Dir => Object_Dir);

      exception
         when Directory_Error =>
            Fail ("cannot find object directory """,
                  Get_Name_String (Data.Object_Directory),
                  """");
      end;

      --  We want to link some Ada files, so we need to link with
      --  the GNAT runtime (libgnat & libgnarl)

      if The_Build_Mode = Dynamic or else The_Build_Mode = Relocatable then
         Opts.Increment_Last;
         Opts.Table (Opts.Last) := new String' ("-lgnarl");
         Opts.Increment_Last;
         Opts.Table (Opts.Last) := new String' ("-lgnat");
      end if;

      Object_Files :=
        new Argument_List'(Argument_List (Objects.Table (1 .. Objects.Last)));

      Foreign_Objects :=
        new Argument_List'(Argument_List
                           (Foreigns.Table (1 .. Foreigns.Last)));

      Ali_Files :=
        new Argument_List'(Argument_List (Alis.Table (1 .. Alis.Last)));

      Options :=
        new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));

      --  We fail if there are no object to put in the library
      --  (Ada or foreign objects)

      if Object_Files'Length = 0 then
         Fail ("no object files");

      end if;

      if not Opt.Quiet_Output then
         Write_Eol;
         Write_Str  ("building ");
         Write_Str (Ada.Characters.Handling.To_Lower
                    (Build_Mode_State'Image (The_Build_Mode)));
         Write_Str  (" library for project ");
         Write_Line (Project_Name);
         Write_Eol;
      end if;

      --  We check that all object files are regular files

      Check_Context;

      --  And we call the procedure to build the library,
      --  depending on the build mode

      case The_Build_Mode is
         when Dynamic | Relocatable =>
            Target.Build_Dynamic_Library
              (Ofiles        => Object_Files.all,
               Foreign       => Foreign_Objects.all,
               Afiles        => Ali_Files.all,
               Options       => Options.all,
               Lib_Filename  => Lib_Filename.all,
               Lib_Dir       => Lib_Dirpath.all,
               Lib_Address   => DLL_Address.all,
               Lib_Version   => Lib_Version.all,
               Relocatable   => The_Build_Mode = Relocatable);

         when Static =>
            MLib.Build_Library
              (Object_Files.all,
               Ali_Files.all,
               Lib_Filename.all,
               Lib_Dirpath.all);

         when None =>
            null;
      end case;

      --  We need to copy the ALI files from the object directory
      --  to the library directory, so that the linker find them
      --  there, and does not need to look in the object directory
      --  where it would also find the object files; and we don't want
      --  that: we want the linker to use the library.

      Target.Copy_ALI_Files
        (From => Projects.Table (For_Project).Object_Directory,
         To   => Projects.Table (For_Project).Library_Dir);

   end Build_Library;

   -----------
   -- Check --
   -----------

   procedure Check (Filename : String) is
   begin
      if not Is_Regular_File (Filename) then
         Fail (Filename, " not found.");

      end if;
   end Check;

   -------------------
   -- Check_Context --
   -------------------

   procedure Check_Context is
   begin
      --  check that each object file exist

      for F in Object_Files'Range loop
         Check (Object_Files (F).all);
      end loop;
   end Check_Context;

   ------------------
   -- Reset_Tables --
   ------------------

   procedure Reset_Tables is
   begin
      Objects.Init;
      Foreigns.Init;
      Alis.Init;
      Opts.Init;
   end Reset_Tables;

end MLib.Prj;