gcc/ada/mlib-tgt-darwin.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             M L I B . T G T                              --
   6 --                             (Darwin Version)                             --
   7 --                                                                          --
   8 --                                 B o d y                                  --
   9 --                                                                          --
  10 --          Copyright (C) 2001-2006, Free Software Foundation, 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,  51  Franklin  Street,  Fifth  Floor, --
  21 -- Boston, MA 02110-1301, USA.                                              --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 --  This package provides a set of target dependent routines to build
  29 --  static, dynamic and shared libraries.
  30
  31 --  This is the Darwin version of the body
  32
  33 with MLib;     use MLib;
  34 with MLib.Fil;
  35 with MLib.Utl;
  36 with Namet;    use Namet;
  37 with Opt;      use Opt;
  38 with Output;   use Output;
  39 with Prj.Com;
  40
  41 with System;
  42
  43 package body MLib.Tgt is
  44
  45    Flat_Namespace : aliased String := "-Wl,-flat_namespace";
  46    --  Instruct the linker to build the shared library as a flat
  47    --  namespace image. The default is a two-level namespace image.
  48
  49    Shared_Libgcc : aliased String := "-shared-libgcc";
  50
  51    No_Shared_Libgcc_Options   : aliased Argument_List :=
  52                                   (1 => Flat_Namespace'Access);
  53    With_Shared_Libgcc_Options : aliased Argument_List :=
  54                                   (1 => Flat_Namespace'Access,
  55                                    2 => Shared_Libgcc'Access);
  56
  57    ---------------------
  58    -- Archive_Builder --
  59    ---------------------
  60
  61    function Archive_Builder return String is
  62    begin
  63       return "ar";
  64    end Archive_Builder;
  65
  66    -----------------------------
  67    -- Archive_Builder_Options --
  68    -----------------------------
  69
  70    function Archive_Builder_Options return String_List_Access is
  71    begin
  72       return new String_List'(1 => new String'("cr"));
  73    end Archive_Builder_Options;
  74
  75    -----------------
  76    -- Archive_Ext --
  77    -----------------
  78
  79    function Archive_Ext return  String is
  80    begin
  81       return "a";
  82    end Archive_Ext;
  83
  84    ---------------------
  85    -- Archive_Indexer --
  86    ---------------------
  87
  88    function Archive_Indexer return String is
  89    begin
  90       return "ranlib";
  91    end Archive_Indexer;
  92
  93    -----------------------------
  94    -- Archive_Indexer_Options --
  95    -----------------------------
  96
  97    function Archive_Indexer_Options return String_List_Access is
  98    begin
  99       return new String_List'(1 => new String'("-c"));
 100    end Archive_Indexer_Options;
 101
 102    ---------------------------
 103    -- Build_Dynamic_Library --
 104    ---------------------------
 105
 106    procedure Build_Dynamic_Library
 107      (Ofiles       : Argument_List;
 108       Foreign      : Argument_List;
 109       Afiles       : Argument_List;
 110       Options      : Argument_List;
 111       Options_2    : Argument_List;
 112       Interfaces   : Argument_List;
 113       Lib_Filename : String;
 114       Lib_Dir      : String;
 115       Symbol_Data  : Symbol_Record;
 116       Driver_Name  : Name_Id := No_Name;
 117       Lib_Version  : String  := "";
 118       Auto_Init    : Boolean := False)
 119    is
 120       pragma Unreferenced (Foreign);
 121       pragma Unreferenced (Afiles);
 122       pragma Unreferenced (Interfaces);
 123       pragma Unreferenced (Symbol_Data);
 124       pragma Unreferenced (Auto_Init);
 125
 126       Lib_File : constant String :=
 127                    Lib_Dir & Directory_Separator & "lib" &
 128                    Fil.Append_To (Lib_Filename, DLL_Ext);
 129
 130       Shared_Options : Argument_List_Access;
 131
 132       Symbolic_Link_Needed : Boolean := False;
 133
 134    begin
 135       if Opt.Verbose_Mode then
 136          Write_Str ("building relocatable shared library ");
 137          Write_Line (Lib_File);
 138       end if;
 139
 140       --  Invoke gcc with -shared-libgcc, but only for GCC 4 or higher
 141
 142       if GCC_Version >= 4 then
 143          Shared_Options := With_Shared_Libgcc_Options'Access;
 144       else
 145          Shared_Options := No_Shared_Libgcc_Options'Access;
 146       end if;
 147
 148       --  If specified, add automatic elaboration/finalization
 149
 150       if Lib_Version = "" then
 151          Utl.Gcc
 152            (Output_File => Lib_File,
 153             Objects     => Ofiles,
 154             Options     => Options & Shared_Options.all,
 155             Driver_Name => Driver_Name,
 156             Options_2   => Options_2);
 157
 158       else
 159
 160          if Is_Absolute_Path (Lib_Version) then
 161             Utl.Gcc
 162               (Output_File => Lib_Version,
 163                Objects     => Ofiles,
 164                Options     => Options & Shared_Options.all,
 165                Driver_Name => Driver_Name,
 166                Options_2   => Options_2);
 167             Symbolic_Link_Needed := Lib_Version /= Lib_File;
 168
 169          else
 170             Utl.Gcc
 171               (Output_File => Lib_Dir & Directory_Separator & Lib_Version,
 172                Objects     => Ofiles,
 173                Options     => Options & Shared_Options.all,
 174                Driver_Name => Driver_Name,
 175                Options_2   => Options_2);
 176             Symbolic_Link_Needed :=
 177               Lib_Dir & Directory_Separator & Lib_Version /= Lib_File;
 178          end if;
 179
 180          if Symbolic_Link_Needed then
 181             declare
 182                Success : Boolean;
 183                Oldpath : String (1 .. Lib_Version'Length + 1);
 184                Newpath : String (1 .. Lib_File'Length + 1);
 185
 186                Result : Integer;
 187                pragma Unreferenced (Result);
 188
 189                function Symlink
 190                  (Oldpath : System.Address;
 191                   Newpath : System.Address) return Integer;
 192                pragma Import (C, Symlink, "__gnat_symlink");
 193
 194             begin
 195                Oldpath (1 .. Lib_Version'Length) := Lib_Version;
 196                Oldpath (Oldpath'Last)            := ASCII.NUL;
 197                Newpath (1 .. Lib_File'Length)    := Lib_File;
 198                Newpath (Newpath'Last)            := ASCII.NUL;
 199
 200                Delete_File (Lib_File, Success);
 201
 202                Result := Symlink (Oldpath'Address, Newpath'Address);
 203             end;
 204          end if;
 205       end if;
 206    end Build_Dynamic_Library;
 207
 208    -------------
 209    -- DLL_Ext --
 210    -------------
 211
 212    function DLL_Ext return String is
 213    begin
 214       return "dylib";
 215    end DLL_Ext;
 216
 217    ----------------
 218    -- DLL_Prefix --
 219    ----------------
 220
 221    function DLL_Prefix return String is
 222    begin
 223       return "lib";
 224    end DLL_Prefix;
 225
 226    --------------------
 227    -- Dynamic_Option --
 228    --------------------
 229
 230    function Dynamic_Option return String is
 231    begin
 232       return "-dynamiclib";
 233    end Dynamic_Option;
 234
 235    -------------------
 236    -- Is_Object_Ext --
 237    -------------------
 238
 239    function Is_Object_Ext (Ext : String) return Boolean is
 240    begin
 241       return Ext = ".o";
 242    end Is_Object_Ext;
 243
 244    --------------
 245    -- Is_C_Ext --
 246    --------------
 247
 248    function Is_C_Ext (Ext : String) return Boolean is
 249    begin
 250       return Ext = ".c";
 251    end Is_C_Ext;
 252
 253    --------------------
 254    -- Is_Archive_Ext --
 255    --------------------
 256
 257    function Is_Archive_Ext (Ext : String) return Boolean is
 258    begin
 259       return Ext = ".dylib" or else Ext = ".a";
 260    end Is_Archive_Ext;
 261
 262    -------------
 263    -- Libgnat --
 264    -------------
 265
 266    function Libgnat return String is
 267    begin
 268       return "libgnat.a";
 269    end Libgnat;
 270
 271    ------------------------
 272    -- Library_Exists_For --
 273    ------------------------
 274
 275    function Library_Exists_For
 276      (Project : Project_Id;
 277       In_Tree : Project_Tree_Ref) return Boolean
 278    is
 279    begin
 280       if not In_Tree.Projects.Table (Project).Library then
 281          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
 282                        "for non library project");
 283          return False;
 284
 285       else
 286          declare
 287             Lib_Dir  : constant String :=
 288                          Get_Name_String
 289                            (In_Tree.Projects.Table (Project).Library_Dir);
 290             Lib_Name : constant String :=
 291                          Get_Name_String
 292                            (In_Tree.Projects.Table (Project).Library_Name);
 293
 294          begin
 295             if In_Tree.Projects.Table (Project).Library_Kind = Static then
 296                return Is_Regular_File
 297                  (Lib_Dir & Directory_Separator & "lib" &
 298                   Fil.Append_To (Lib_Name, Archive_Ext));
 299
 300             else
 301                return Is_Regular_File
 302                  (Lib_Dir & Directory_Separator & "lib" &
 303                   Fil.Append_To (Lib_Name, DLL_Ext));
 304             end if;
 305          end;
 306       end if;
 307    end Library_Exists_For;
 308
 309    ---------------------------
 310    -- Library_File_Name_For --
 311    ---------------------------
 312
 313    function Library_File_Name_For
 314      (Project : Project_Id;
 315       In_Tree : Project_Tree_Ref) return Name_Id
 316    is
 317    begin
 318       if not In_Tree.Projects.Table (Project).Library then
 319          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
 320                        "for non library project");
 321          return No_Name;
 322
 323       else
 324          declare
 325             Lib_Name : constant String :=
 326                          Get_Name_String
 327                            (In_Tree.Projects.Table (Project).Library_Name);
 328
 329          begin
 330             Name_Len := 3;
 331             Name_Buffer (1 .. Name_Len) := "lib";
 332
 333             if In_Tree.Projects.Table (Project).Library_Kind =
 334               Static then
 335                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
 336             else
 337                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
 338             end if;
 339
 340             return Name_Find;
 341          end;
 342       end if;
 343    end Library_File_Name_For;
 344
 345    ----------------
 346    -- Object_Ext --
 347    ----------------
 348
 349    function Object_Ext return String is
 350    begin
 351       return "o";
 352    end Object_Ext;
 353
 354    ----------------
 355    -- PIC_Option --
 356    ----------------
 357
 358    function PIC_Option return String is
 359    begin
 360       return "-fPIC";
 361    end PIC_Option;
 362
 363    -----------------------------------------------
 364    -- Standalone_Library_Auto_Init_Is_Supported --
 365    -----------------------------------------------
 366
 367    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
 368    begin
 369       return True;
 370    end Standalone_Library_Auto_Init_Is_Supported;
 371
 372    ---------------------------
 373    -- Support_For_Libraries --
 374    ---------------------------
 375
 376    function Support_For_Libraries return Library_Support is
 377    begin
 378       return Full;
 379    end Support_For_Libraries;
 380
 381 end MLib.Tgt;