gcc/ada/mlib-tgt.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             M L I B . T G T                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2001-2007, AdaCore                     --
  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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with MLib.Fil;
  27 with Prj.Com;
  28
  29 with MLib.Tgt.Specific;
  30 pragma Warnings (Off, MLib.Tgt.Specific);
  31 --  MLib.Tgt.Specific is with'ed only for elaboration purposes
  32
  33 package body MLib.Tgt is
  34
  35    ---------------------
  36    -- Archive_Builder --
  37    ---------------------
  38
  39    function Archive_Builder return String is
  40    begin
  41       return Archive_Builder_Ptr.all;
  42    end Archive_Builder;
  43
  44    -----------------------------
  45    -- Archive_Builder_Default --
  46    -----------------------------
  47
  48    function Archive_Builder_Default return String is
  49    begin
  50       return "ar";
  51    end Archive_Builder_Default;
  52
  53    -----------------------------
  54    -- Archive_Builder_Options --
  55    -----------------------------
  56
  57    function Archive_Builder_Options return String_List_Access is
  58    begin
  59       return Archive_Builder_Options_Ptr.all;
  60    end Archive_Builder_Options;
  61
  62    -------------------------------------
  63    -- Archive_Builder_Options_Default --
  64    -------------------------------------
  65
  66    function Archive_Builder_Options_Default return String_List_Access is
  67    begin
  68       return new String_List'(1 => new String'("cr"));
  69    end Archive_Builder_Options_Default;
  70
  71    ------------------------------------
  72    -- Archive_Builder_Append_Options --
  73    ------------------------------------
  74
  75    function Archive_Builder_Append_Options return String_List_Access is
  76    begin
  77       return Archive_Builder_Append_Options_Ptr.all;
  78    end Archive_Builder_Append_Options;
  79
  80    --------------------------------------------
  81    -- Archive_Builder_Append_Options_Default --
  82    --------------------------------------------
  83
  84    function Archive_Builder_Append_Options_Default return String_List_Access is
  85    begin
  86       return new String_List'(1 => new String'("q"));
  87    end Archive_Builder_Append_Options_Default;
  88
  89    -----------------
  90    -- Archive_Ext --
  91    -----------------
  92
  93    function Archive_Ext return String is
  94    begin
  95       return Archive_Ext_Ptr.all;
  96    end Archive_Ext;
  97
  98    -------------------------
  99    -- Archive_Ext_Default --
 100    -------------------------
 101
 102    function Archive_Ext_Default return String is
 103    begin
 104       return "a";
 105    end Archive_Ext_Default;
 106
 107    ---------------------
 108    -- Archive_Indexer --
 109    ---------------------
 110
 111    function Archive_Indexer return String is
 112    begin
 113       return Archive_Indexer_Ptr.all;
 114    end Archive_Indexer;
 115
 116    -----------------------------
 117    -- Archive_Indexer_Default --
 118    -----------------------------
 119
 120    function Archive_Indexer_Default return String is
 121    begin
 122       return "ranlib";
 123    end Archive_Indexer_Default;
 124
 125    -----------------------------
 126    -- Archive_Indexer_Options --
 127    -----------------------------
 128
 129    function Archive_Indexer_Options return String_List_Access is
 130    begin
 131       return Archive_Indexer_Options_Ptr.all;
 132    end Archive_Indexer_Options;
 133
 134    -------------------------------------
 135    -- Archive_Indexer_Options_Default --
 136    -------------------------------------
 137
 138    function Archive_Indexer_Options_Default return String_List_Access is
 139    begin
 140       return new String_List (1 .. 0);
 141    end Archive_Indexer_Options_Default;
 142
 143    ---------------------------
 144    -- Build_Dynamic_Library --
 145    ---------------------------
 146
 147    procedure Build_Dynamic_Library
 148      (Ofiles       : Argument_List;
 149       Options      : Argument_List;
 150       Interfaces   : Argument_List;
 151       Lib_Filename : String;
 152       Lib_Dir      : String;
 153       Symbol_Data  : Symbol_Record;
 154       Driver_Name  : Name_Id := No_Name;
 155       Lib_Version  : String  := "";
 156       Auto_Init    : Boolean := False)
 157    is
 158    begin
 159       Build_Dynamic_Library_Ptr
 160         (Ofiles,
 161          Options,
 162          Interfaces,
 163          Lib_Filename,
 164          Lib_Dir,
 165          Symbol_Data,
 166          Driver_Name,
 167          Lib_Version,
 168          Auto_Init);
 169    end Build_Dynamic_Library;
 170
 171    ------------------------------
 172    -- Default_Symbol_File_Name --
 173    ------------------------------
 174
 175    function Default_Symbol_File_Name return String is
 176    begin
 177       return Default_Symbol_File_Name_Ptr.all;
 178    end Default_Symbol_File_Name;
 179
 180    --------------------------------------
 181    -- Default_Symbol_File_Name_Default --
 182    --------------------------------------
 183
 184    function Default_Symbol_File_Name_Default return String is
 185    begin
 186       return "";
 187    end Default_Symbol_File_Name_Default;
 188
 189    -------------
 190    -- DLL_Ext --
 191    -------------
 192
 193    function DLL_Ext return String is
 194    begin
 195       return DLL_Ext_Ptr.all;
 196    end DLL_Ext;
 197
 198    ---------------------
 199    -- DLL_Ext_Default --
 200    ---------------------
 201
 202    function DLL_Ext_Default return String is
 203    begin
 204       return "so";
 205    end DLL_Ext_Default;
 206
 207    ----------------
 208    -- DLL_Prefix --
 209    ----------------
 210
 211    function DLL_Prefix return String is
 212    begin
 213       return DLL_Prefix_Ptr.all;
 214    end DLL_Prefix;
 215
 216    ------------------------
 217    -- DLL_Prefix_Default --
 218    ------------------------
 219
 220    function DLL_Prefix_Default return String is
 221    begin
 222       return "lib";
 223    end DLL_Prefix_Default;
 224
 225    --------------------
 226    -- Dynamic_Option --
 227    --------------------
 228
 229    function Dynamic_Option return String is
 230    begin
 231       return Dynamic_Option_Ptr.all;
 232    end Dynamic_Option;
 233
 234    ----------------------------
 235    -- Dynamic_Option_Default --
 236    ----------------------------
 237
 238    function Dynamic_Option_Default return String is
 239    begin
 240       return "-shared";
 241    end Dynamic_Option_Default;
 242
 243    -------------------
 244    -- Is_Object_Ext --
 245    -------------------
 246
 247    function Is_Object_Ext (Ext : String) return Boolean is
 248    begin
 249       return Is_Object_Ext_Ptr (Ext);
 250    end Is_Object_Ext;
 251
 252    ---------------------------
 253    -- Is_Object_Ext_Default --
 254    ---------------------------
 255
 256    function Is_Object_Ext_Default (Ext : String) return Boolean is
 257    begin
 258       return Ext = ".o";
 259    end Is_Object_Ext_Default;
 260
 261    --------------
 262    -- Is_C_Ext --
 263    --------------
 264
 265    function Is_C_Ext (Ext : String) return Boolean is
 266    begin
 267       return Is_C_Ext_Ptr (Ext);
 268    end Is_C_Ext;
 269
 270    ----------------------
 271    -- Is_C_Ext_Default --
 272    ----------------------
 273
 274    function Is_C_Ext_Default (Ext : String) return Boolean is
 275    begin
 276       return Ext = ".c";
 277    end Is_C_Ext_Default;
 278
 279    --------------------
 280    -- Is_Archive_Ext --
 281    --------------------
 282
 283    function Is_Archive_Ext (Ext : String) return Boolean is
 284    begin
 285       return Is_Archive_Ext_Ptr (Ext);
 286    end Is_Archive_Ext;
 287
 288    ----------------------------
 289    -- Is_Archive_Ext_Default --
 290    ----------------------------
 291
 292    function Is_Archive_Ext_Default (Ext : String) return Boolean is
 293    begin
 294       return Ext = ".a";
 295    end Is_Archive_Ext_Default;
 296
 297    -------------
 298    -- Libgnat --
 299    -------------
 300
 301    function Libgnat return String is
 302    begin
 303       return Libgnat_Ptr.all;
 304    end Libgnat;
 305
 306    ---------------------
 307    -- Libgnat_Default --
 308    ---------------------
 309
 310    function Libgnat_Default return String is
 311    begin
 312       return "libgnat.a";
 313    end Libgnat_Default;
 314
 315    ------------------------
 316    -- Library_Exists_For --
 317    ------------------------
 318
 319    function Library_Exists_For
 320      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
 321    is
 322    begin
 323       return Library_Exists_For_Ptr (Project, In_Tree);
 324    end Library_Exists_For;
 325
 326    --------------------------------
 327    -- Library_Exists_For_Default --
 328    --------------------------------
 329
 330    function Library_Exists_For_Default
 331      (Project : Project_Id; In_Tree : Project_Tree_Ref) return Boolean
 332    is
 333    begin
 334       if not In_Tree.Projects.Table (Project).Library then
 335          Prj.Com.Fail ("INTERNAL ERROR: Library_Exists_For called " &
 336                        "for non library project");
 337          return False;
 338
 339       else
 340          declare
 341             Lib_Dir  : constant String :=
 342                          Get_Name_String
 343                            (In_Tree.Projects.Table (Project).Library_Dir);
 344             Lib_Name : constant String :=
 345                          Get_Name_String
 346                            (In_Tree.Projects.Table (Project).Library_Name);
 347
 348          begin
 349             if In_Tree.Projects.Table (Project).Library_Kind = Static then
 350                return Is_Regular_File
 351                  (Lib_Dir & Directory_Separator & "lib" &
 352                   Fil.Append_To (Lib_Name, Archive_Ext));
 353
 354             else
 355                return Is_Regular_File
 356                  (Lib_Dir & Directory_Separator & DLL_Prefix &
 357                   Fil.Append_To (Lib_Name, DLL_Ext));
 358             end if;
 359          end;
 360       end if;
 361    end Library_Exists_For_Default;
 362
 363    ---------------------------
 364    -- Library_File_Name_For --
 365    ---------------------------
 366
 367    function Library_File_Name_For
 368      (Project : Project_Id;
 369       In_Tree : Project_Tree_Ref) return File_Name_Type
 370    is
 371    begin
 372       return Library_File_Name_For_Ptr (Project, In_Tree);
 373    end Library_File_Name_For;
 374
 375    -----------------------------------
 376    -- Library_File_Name_For_Default --
 377    -----------------------------------
 378
 379    function Library_File_Name_For_Default
 380      (Project : Project_Id;
 381       In_Tree : Project_Tree_Ref) return File_Name_Type
 382    is
 383    begin
 384       if not In_Tree.Projects.Table (Project).Library then
 385          Prj.Com.Fail ("INTERNAL ERROR: Library_File_Name_For called " &
 386                        "for non library project");
 387          return No_File;
 388
 389       else
 390          declare
 391             Lib_Name : constant String :=
 392                          Get_Name_String
 393                            (In_Tree.Projects.Table (Project).Library_Name);
 394
 395          begin
 396             if In_Tree.Projects.Table (Project).Library_Kind =
 397                  Static
 398             then
 399                Name_Len := 3;
 400                Name_Buffer (1 .. Name_Len) := "lib";
 401                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, Archive_Ext));
 402             else
 403                Name_Len := 0;
 404                Add_Str_To_Name_Buffer (DLL_Prefix);
 405                Add_Str_To_Name_Buffer (Fil.Append_To (Lib_Name, DLL_Ext));
 406             end if;
 407
 408             return Name_Find;
 409          end;
 410       end if;
 411    end Library_File_Name_For_Default;
 412
 413    --------------------------------------
 414    -- Library_Major_Minor_Id_Supported --
 415    --------------------------------------
 416
 417    function Library_Major_Minor_Id_Supported return Boolean is
 418    begin
 419       return Library_Major_Minor_Id_Supported_Ptr.all;
 420    end Library_Major_Minor_Id_Supported;
 421
 422    ----------------------------------------------
 423    -- Library_Major_Minor_Id_Supported_Default --
 424    ----------------------------------------------
 425
 426    function Library_Major_Minor_Id_Supported_Default return Boolean is
 427    begin
 428       return True;
 429    end Library_Major_Minor_Id_Supported_Default;
 430
 431    ----------------
 432    -- Object_Ext --
 433    ----------------
 434
 435    function Object_Ext return String is
 436    begin
 437       return Object_Ext_Ptr.all;
 438    end Object_Ext;
 439
 440    ------------------------
 441    -- Object_Ext_Default --
 442    ------------------------
 443
 444    function Object_Ext_Default return String is
 445    begin
 446       return "o";
 447    end Object_Ext_Default;
 448
 449    ----------------
 450    -- PIC_Option --
 451    ----------------
 452
 453    function PIC_Option return String is
 454    begin
 455       return PIC_Option_Ptr.all;
 456    end PIC_Option;
 457
 458    ------------------------
 459    -- PIC_Option_Default --
 460    ------------------------
 461
 462    function PIC_Option_Default return String is
 463    begin
 464       return "-fPIC";
 465    end PIC_Option_Default;
 466
 467    -----------------------------------------------
 468    -- Standalone_Library_Auto_Init_Is_Supported --
 469    -----------------------------------------------
 470
 471    function Standalone_Library_Auto_Init_Is_Supported return Boolean is
 472    begin
 473       return Standalone_Library_Auto_Init_Is_Supported_Ptr.all;
 474    end Standalone_Library_Auto_Init_Is_Supported;
 475
 476    -------------------------------------------------------
 477    -- Standalone_Library_Auto_Init_Is_Supported_Default --
 478    -------------------------------------------------------
 479
 480    function Standalone_Library_Auto_Init_Is_Supported_Default return Boolean is
 481    begin
 482       return True;
 483    end Standalone_Library_Auto_Init_Is_Supported_Default;
 484
 485    ---------------------------
 486    -- Support_For_Libraries --
 487    ---------------------------
 488
 489    function Support_For_Libraries return Library_Support is
 490    begin
 491       return Support_For_Libraries_Ptr.all;
 492    end Support_For_Libraries;
 493
 494    -----------------------------------
 495    -- Support_For_Libraries_Default --
 496    -----------------------------------
 497
 498    function Support_For_Libraries_Default return Library_Support is
 499    begin
 500       return Full;
 501    end Support_For_Libraries_Default;
 502
 503 end MLib.Tgt;