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