340 lines
11 KiB
Ada
340 lines
11 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- M L I B . P R J --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision: 1.2 $
|
|
-- --
|
|
-- 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;
|