gcc/ada/mlib-prj.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            M L I B . P R J                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --              Copyright (C) 2001, Ada Core Technologies, Inc.             --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Ada.Characters.Handling;
  28
  29 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  30 with GNAT.OS_Lib;   use GNAT.OS_Lib;
  31 with MLib.Fil;
  32 with MLib.Tgt;
  33 with Opt;
  34 with Output;        use Output;
  35 with Osint;         use Osint;
  36 with Namet;         use Namet;
  37 with Table;
  38 with Types;         use Types;
  39
  40 package body MLib.Prj is
  41
  42    package Files  renames MLib.Fil;
  43    package Target renames MLib.Tgt;
  44
  45    --  List of objects to put inside the library
  46
  47    Object_Files : Argument_List_Access;
  48    package Objects is new Table.Table
  49      (Table_Name           => "Mlib.Prj.Objects",
  50       Table_Component_Type => String_Access,
  51       Table_Index_Type     => Natural,
  52       Table_Low_Bound      => 1,
  53       Table_Initial        => 50,
  54       Table_Increment      => 50);
  55
  56    --  List of non-Ada object files
  57
  58    Foreign_Objects : Argument_List_Access;
  59    package Foreigns is new Table.Table
  60      (Table_Name           => "Mlib.Prj.Foreigns",
  61       Table_Component_Type => String_Access,
  62       Table_Index_Type     => Natural,
  63       Table_Low_Bound      => 1,
  64       Table_Initial        => 20,
  65       Table_Increment      => 20);
  66
  67    --  List of ALI files
  68
  69    Ali_Files : Argument_List_Access;
  70    package Alis is new Table.Table
  71      (Table_Name           => "Mlib.Prj.Alis",
  72       Table_Component_Type => String_Access,
  73       Table_Index_Type     => Natural,
  74       Table_Low_Bound      => 1,
  75       Table_Initial        => 50,
  76       Table_Increment      => 50);
  77
  78    --  List of options set in the command line.
  79
  80    Options : Argument_List_Access;
  81    package Opts is new Table.Table
  82      (Table_Name           => "Mlib.Prj.Opts",
  83       Table_Component_Type => String_Access,
  84       Table_Index_Type     => Natural,
  85       Table_Low_Bound      => 1,
  86       Table_Initial        => 5,
  87       Table_Increment      => 5);
  88
  89    type Build_Mode_State is
  90      (None, Static, Dynamic, Relocatable);
  91
  92    procedure Check (Filename : String);
  93    --  Check if filename is a regular file. Fail if it is not.
  94
  95    procedure Check_Context;
  96    --  Check each object files in table Object_Files
  97    --  Fail if any of them is not a regular file
  98
  99    procedure Reset_Tables;
 100    --  Make sure that all the above tables are empty
 101    --  (Objects, Foreign_Objects, Ali_Files, Options)
 102
 103    -------------------
 104    -- Build_Library --
 105    -------------------
 106
 107    procedure Build_Library (For_Project : Project_Id) is
 108       Data : constant Project_Data := Projects.Table (For_Project);
 109
 110       Project_Name : constant String :=
 111                        Get_Name_String (Data.Name);
 112
 113       Lib_Filename : String_Access;
 114       Lib_Dirpath  : String_Access := new String'(".");
 115       DLL_Address  : String_Access := new String'(Target.Default_DLL_Address);
 116       Lib_Version  : String_Access := new String'("");
 117
 118       The_Build_Mode : Build_Mode_State := None;
 119
 120    begin
 121       Reset_Tables;
 122
 123       --  Fail if project is not a library project
 124
 125       if not Data.Library then
 126          Fail ("project """, Project_Name, """ has no library");
 127       end if;
 128
 129       Lib_Dirpath := new String'(Get_Name_String (Data.Library_Dir));
 130       Lib_Filename := new String'(Get_Name_String (Data.Library_Name));
 131
 132       case Data.Library_Kind is
 133          when Static =>
 134             The_Build_Mode := Static;
 135
 136          when Dynamic =>
 137             The_Build_Mode := Dynamic;
 138
 139          when Relocatable =>
 140             The_Build_Mode := Relocatable;
 141
 142             if Target.PIC_Option /= "" then
 143                Opts.Increment_Last;
 144                Opts.Table (Opts.Last) := new String'(Target.PIC_Option);
 145             end if;
 146       end case;
 147
 148       --  Get the library version, if any
 149
 150       if Data.Lib_Internal_Name /= No_Name then
 151          Lib_Version := new String'(Get_Name_String (Data.Lib_Internal_Name));
 152       end if;
 153
 154       --  Add the objects found in the object directory
 155
 156       declare
 157          Object_Dir : Dir_Type;
 158          Filename : String (1 .. 255);
 159          Last : Natural;
 160          Object_Dir_Path : constant String :=
 161            Get_Name_String (Data.Object_Directory);
 162       begin
 163          Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path);
 164
 165          --  For all entries in the object directory
 166
 167          loop
 168             Read (Object_Dir, Filename, Last);
 169
 170             exit when Last = 0;
 171
 172             --  Check if it is an object file
 173
 174             if Files.Is_Obj (Filename (1 .. Last)) then
 175                --  record this object file
 176
 177                Objects.Increment_Last;
 178                Objects.Table (Objects.Last) :=
 179                  new String' (Object_Dir_Path & Directory_Separator &
 180                               Filename (1 .. Last));
 181
 182                if Is_Regular_File
 183                  (Object_Dir_Path &
 184                   Files.Ext_To (Object_Dir_Path &
 185                                 Filename (1 .. Last), "ali"))
 186                then
 187                   --  Record the corresponding ali file
 188
 189                   Alis.Increment_Last;
 190                   Alis.Table (Alis.Last) :=
 191                     new String' (Object_Dir_Path &
 192                                  Files.Ext_To
 193                                  (Filename (1 .. Last), "ali"));
 194
 195                else
 196                   --  The object file is a foreign object file
 197
 198                   Foreigns.Increment_Last;
 199                   Foreigns.Table (Foreigns.Last) :=
 200                     new String'(Object_Dir_Path &
 201                                 Filename (1 .. Last));
 202
 203                end if;
 204             end if;
 205          end loop;
 206
 207          Close (Dir => Object_Dir);
 208
 209       exception
 210          when Directory_Error =>
 211             Fail ("cannot find object directory """,
 212                   Get_Name_String (Data.Object_Directory),
 213                   """");
 214       end;
 215
 216       --  We want to link some Ada files, so we need to link with
 217       --  the GNAT runtime (libgnat & libgnarl)
 218
 219       if The_Build_Mode = Dynamic or else The_Build_Mode = Relocatable then
 220          Opts.Increment_Last;
 221          Opts.Table (Opts.Last) := new String' ("-lgnarl");
 222          Opts.Increment_Last;
 223          Opts.Table (Opts.Last) := new String' ("-lgnat");
 224       end if;
 225
 226       Object_Files :=
 227         new Argument_List'(Argument_List (Objects.Table (1 .. Objects.Last)));
 228
 229       Foreign_Objects :=
 230         new Argument_List'(Argument_List
 231                            (Foreigns.Table (1 .. Foreigns.Last)));
 232
 233       Ali_Files :=
 234         new Argument_List'(Argument_List (Alis.Table (1 .. Alis.Last)));
 235
 236       Options :=
 237         new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last)));
 238
 239       --  We fail if there are no object to put in the library
 240       --  (Ada or foreign objects)
 241
 242       if Object_Files'Length = 0 then
 243          Fail ("no object files");
 244
 245       end if;
 246
 247       if not Opt.Quiet_Output then
 248          Write_Eol;
 249          Write_Str  ("building ");
 250          Write_Str (Ada.Characters.Handling.To_Lower
 251                     (Build_Mode_State'Image (The_Build_Mode)));
 252          Write_Str  (" library for project ");
 253          Write_Line (Project_Name);
 254          Write_Eol;
 255       end if;
 256
 257       --  We check that all object files are regular files
 258
 259       Check_Context;
 260
 261       --  And we call the procedure to build the library,
 262       --  depending on the build mode
 263
 264       case The_Build_Mode is
 265          when Dynamic | Relocatable =>
 266             Target.Build_Dynamic_Library
 267               (Ofiles        => Object_Files.all,
 268                Foreign       => Foreign_Objects.all,
 269                Afiles        => Ali_Files.all,
 270                Options       => Options.all,
 271                Lib_Filename  => Lib_Filename.all,
 272                Lib_Dir       => Lib_Dirpath.all,
 273                Lib_Address   => DLL_Address.all,
 274                Lib_Version   => Lib_Version.all,
 275                Relocatable   => The_Build_Mode = Relocatable);
 276
 277          when Static =>
 278             MLib.Build_Library
 279               (Object_Files.all,
 280                Ali_Files.all,
 281                Lib_Filename.all,
 282                Lib_Dirpath.all);
 283
 284          when None =>
 285             null;
 286       end case;
 287
 288       --  We need to copy the ALI files from the object directory
 289       --  to the library directory, so that the linker find them
 290       --  there, and does not need to look in the object directory
 291       --  where it would also find the object files; and we don't want
 292       --  that: we want the linker to use the library.
 293
 294       Target.Copy_ALI_Files
 295         (From => Projects.Table (For_Project).Object_Directory,
 296          To   => Projects.Table (For_Project).Library_Dir);
 297
 298    end Build_Library;
 299
 300    -----------
 301    -- Check --
 302    -----------
 303
 304    procedure Check (Filename : String) is
 305    begin
 306       if not Is_Regular_File (Filename) then
 307          Fail (Filename, " not found.");
 308
 309       end if;
 310    end Check;
 311
 312    -------------------
 313    -- Check_Context --
 314    -------------------
 315
 316    procedure Check_Context is
 317    begin
 318       --  check that each object file exist
 319
 320       for F in Object_Files'Range loop
 321          Check (Object_Files (F).all);
 322       end loop;
 323    end Check_Context;
 324
 325    ------------------
 326    -- Reset_Tables --
 327    ------------------
 328
 329    procedure Reset_Tables is
 330    begin
 331       Objects.Init;
 332       Foreigns.Init;
 333       Alis.Init;
 334       Opts.Init;
 335    end Reset_Tables;
 336
 337 end MLib.Prj;