gcc/ada/5lml-tgt.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             M L I B . T G T                              --
   6 --                           (GNU/Linux Version)                            --
   7 --                                                                          --
   8 --                                 B o d y                                  --
   9 --                                                                          --
  10 --                            $Revision$
  11 --                                                                          --
  12 --              Copyright (C) 2001, Ada Core Technologies, Inc.             --
  13 --                                                                          --
  14 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  15 -- terms of the  GNU General Public License as published  by the Free Soft- --
  16 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  17 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  18 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  19 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  20 -- for  more details.  You should have  received  a copy of the GNU General --
  21 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  22 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  23 -- MA 02111-1307, USA.                                                      --
  24 --                                                                          --
  25 -- GNAT was originally developed  by the GNAT team at  New York University. --
  26 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  27 --                                                                          --
  28 ------------------------------------------------------------------------------
  29
  30 --  This package provides a set of target dependent routines to build
  31 --  static, dynamic and shared libraries.
  32
  33 --  This is the GNU/Linux version of the body.
  34
  35 with Ada.Characters.Handling;   use Ada.Characters.Handling;
  36 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  37 with MLib.Fil;
  38 with MLib.Utl;
  39 with Namet;       use Namet;
  40 with Opt;
  41 with Osint;       use Osint;
  42 with Output;      use Output;
  43 with System;
  44
  45 package body MLib.Tgt is
  46
  47    use GNAT;
  48    use MLib;
  49
  50    --  ??? serious lack of comments below, all these declarations need to
  51    --  be commented, none are:
  52
  53    package Files renames MLib.Fil;
  54    package Tools renames MLib.Utl;
  55
  56    Args : Argument_List_Access := new Argument_List (1 .. 20);
  57    Last_Arg : Natural := 0;
  58
  59    Cp      : constant String_Access := Locate_Exec_On_Path ("cp");
  60    Force   : constant String_Access := new String'("-f");
  61
  62    procedure Add_Arg (Arg : String);
  63
  64    -------------
  65    -- Add_Arg --
  66    -------------
  67
  68    procedure Add_Arg (Arg : String) is
  69    begin
  70       if Last_Arg = Args'Last then
  71          declare
  72             New_Args : constant Argument_List_Access :=
  73                          new Argument_List (1 .. Args'Last * 2);
  74
  75          begin
  76             New_Args (Args'Range) := Args.all;
  77             Args := New_Args;
  78          end;
  79       end if;
  80
  81       Last_Arg := Last_Arg + 1;
  82       Args (Last_Arg) := new String'(Arg);
  83    end Add_Arg;
  84
  85    -----------------
  86    -- Archive_Ext --
  87    -----------------
  88
  89    function Archive_Ext return  String is
  90    begin
  91       return  "a";
  92    end Archive_Ext;
  93
  94    -----------------
  95    -- Base_Option --
  96    -----------------
  97
  98    function Base_Option return String is
  99    begin
 100       return "";
 101    end Base_Option;
 102
 103    ---------------------------
 104    -- Build_Dynamic_Library --
 105    ---------------------------
 106
 107    procedure Build_Dynamic_Library
 108      (Ofiles       : Argument_List;
 109       Foreign      : Argument_List;
 110       Afiles       : Argument_List;
 111       Options      : Argument_List;
 112       Lib_Filename : String;
 113       Lib_Dir      : String;
 114       Lib_Address  : String  := "";
 115       Lib_Version  : String  := "";
 116       Relocatable  : Boolean := False)
 117    is
 118       Lib_File : constant String :=
 119         Lib_Dir & Directory_Separator & "lib" &
 120         Files.Ext_To (Lib_Filename, DLL_Ext);
 121
 122       use type Argument_List;
 123       use type String_Access;
 124
 125       Version_Arg  : String_Access;
 126
 127       Symbolic_Link_Needed : Boolean := False;
 128
 129    begin
 130       if Opt.Verbose_Mode then
 131          Write_Str ("building relocatable shared library ");
 132          Write_Line (Lib_File);
 133       end if;
 134
 135       if Lib_Version = "" then
 136          Tools.Gcc
 137            (Output_File => Lib_File,
 138             Objects     => Ofiles,
 139             Options     => Options);
 140
 141       else
 142          Version_Arg := new String'("-Wl,-soname," & Lib_Version);
 143
 144          if Is_Absolute_Path (Lib_Version) then
 145             Tools.Gcc
 146               (Output_File => Lib_Version,
 147                Objects     => Ofiles,
 148                Options     => Options & Version_Arg);
 149             Symbolic_Link_Needed := Lib_Version /= Lib_File;
 150
 151          else
 152             Tools.Gcc
 153               (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
 154                Objects     => Ofiles,
 155                Options     => Options & Version_Arg);
 156             Symbolic_Link_Needed :=
 157               Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
 158          end if;
 159
 160          if Symbolic_Link_Needed then
 161             declare
 162                Success : Boolean;
 163                Oldpath : String (1 .. Lib_Version'Length + 1);
 164                Newpath : String (1 .. Lib_File'Length + 1);
 165                Result  : Integer;
 166
 167                function Symlink
 168                  (Oldpath : System.Address;
 169                   Newpath : System.Address)
 170                   return    Integer;
 171                pragma Import (C, Symlink, "__gnat_symlink");
 172
 173             begin
 174                Oldpath (1 .. Lib_Version'Length) := Lib_Version;
 175                Oldpath (Oldpath'Last)            := ASCII.NUL;
 176                Newpath (1 .. Lib_File'Length)    := Lib_File;
 177                Newpath (Newpath'Last)            := ASCII.NUL;
 178
 179                Delete_File (Lib_File, Success);
 180
 181                Result := Symlink (Oldpath'Address, Newpath'Address);
 182             end;
 183          end if;
 184       end if;
 185    end Build_Dynamic_Library;
 186
 187    --------------------
 188    -- Copy_ALI_Files --
 189    --------------------
 190
 191    procedure Copy_ALI_Files
 192      (From : Name_Id;
 193       To   : Name_Id)
 194    is
 195       Dir      : Dir_Type;
 196       Name     : String (1 .. 1_000);
 197       Last     : Natural;
 198       Success  : Boolean;
 199       From_Dir : constant String := Get_Name_String (From);
 200       To_Dir   : constant String_Access :=
 201                    new String'(Get_Name_String (To));
 202
 203    begin
 204       Last_Arg := 0;
 205       Open (Dir, From_Dir);
 206
 207       loop
 208          Read (Dir, Name, Last);
 209          exit when Last = 0;
 210          if Last > 4
 211
 212            and then
 213            To_Lower (Name (Last - 3 .. Last)) = ".ali"
 214          then
 215             Add_Arg (From_Dir & Directory_Separator & Name (1 .. Last));
 216          end if;
 217       end loop;
 218
 219       if Last_Arg /= 0 then
 220          if not Opt.Quiet_Output then
 221             Write_Str ("cp -f ");
 222
 223             for J in 1 .. Last_Arg loop
 224                Write_Str (Args (J).all);
 225                Write_Char (' ');
 226             end loop;
 227
 228             Write_Line (To_Dir.all);
 229          end if;
 230
 231          Spawn (Cp.all,
 232                 Force & Args (1 .. Last_Arg) & To_Dir,
 233                 Success);
 234
 235          if not Success then
 236             Fail ("could not copy ALI files to library dir");
 237          end if;
 238       end if;
 239    end Copy_ALI_Files;
 240
 241    -------------------------
 242    -- Default_DLL_Address --
 243    -------------------------
 244
 245    function Default_DLL_Address return String is
 246    begin
 247       return "";
 248    end Default_DLL_Address;
 249
 250    -------------
 251    -- DLL_Ext --
 252    -------------
 253
 254    function DLL_Ext return String is
 255    begin
 256       return "so";
 257    end DLL_Ext;
 258
 259    --------------------
 260    -- Dynamic_Option --
 261    --------------------
 262
 263    function Dynamic_Option return String is
 264    begin
 265       return  "-shared";
 266    end Dynamic_Option;
 267
 268    -------------------
 269    -- Is_Object_Ext --
 270    -------------------
 271
 272    function Is_Object_Ext (Ext : String) return Boolean is
 273    begin
 274       return Ext = ".o";
 275    end Is_Object_Ext;
 276
 277    --------------
 278    -- Is_C_Ext --
 279    --------------
 280
 281    function Is_C_Ext (Ext : String) return Boolean is
 282    begin
 283       return Ext = ".c";
 284    end Is_C_Ext;
 285
 286    --------------------
 287    -- Is_Archive_Ext --
 288    --------------------
 289
 290    function Is_Archive_Ext (Ext : String) return Boolean is
 291    begin
 292       return Ext = ".a" or else Ext = ".so";
 293    end Is_Archive_Ext;
 294
 295    -------------
 296    -- Libgnat --
 297    -------------
 298
 299    function Libgnat return String is
 300    begin
 301       return "libgnat.a";
 302    end Libgnat;
 303
 304    -----------------------------
 305    -- Libraries_Are_Supported --
 306    -----------------------------
 307
 308    function Libraries_Are_Supported return Boolean is
 309    begin
 310       return True;
 311    end Libraries_Are_Supported;
 312
 313    --------------------------------
 314    -- Linker_Library_Path_Option --
 315    --------------------------------
 316
 317    function Linker_Library_Path_Option
 318      (Directory : String)
 319       return      String_Access
 320    is
 321    begin
 322       return new String'("-Wl,-rpath," & Directory);
 323    end Linker_Library_Path_Option;
 324
 325    ----------------
 326    -- Object_Ext --
 327    ----------------
 328
 329    function Object_Ext return String is
 330    begin
 331       return  "o";
 332    end Object_Ext;
 333
 334    ----------------
 335    -- PIC_Option --
 336    ----------------
 337
 338    function PIC_Option return String is
 339    begin
 340       return  "-fPIC";
 341    end PIC_Option;
 342
 343 end MLib.Tgt;