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