gcc/ada/mlib-utl.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             M L I B . U T L                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                     Copyright (C) 2002-2006, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with MLib.Fil; use MLib.Fil;
  28 with MLib.Tgt; use MLib.Tgt;
  29
  30 with Namet;    use Namet;
  31 with Opt;
  32 with Osint;
  33 with Output;   use Output;
  34
  35 with GNAT;     use GNAT;
  36
  37 package body MLib.Utl is
  38
  39    Gcc_Name : constant String := Osint.Program_Name ("gcc").all;
  40    Gcc_Exec : OS_Lib.String_Access;
  41
  42    Ar_Name    : OS_Lib.String_Access;
  43    Ar_Exec    : OS_Lib.String_Access;
  44    Ar_Options : OS_Lib.String_List_Access;
  45
  46    Ranlib_Name    : OS_Lib.String_Access;
  47    Ranlib_Exec    : OS_Lib.String_Access := null;
  48    Ranlib_Options : OS_Lib.String_List_Access := null;
  49
  50    --------
  51    -- Ar --
  52    --------
  53
  54    procedure Ar (Output_File : String; Objects : Argument_List) is
  55       Full_Output_File : constant String :=
  56                              Ext_To (Output_File, Archive_Ext);
  57
  58       Arguments   : OS_Lib.Argument_List_Access;
  59       Success     : Boolean;
  60       Line_Length : Natural := 0;
  61
  62    begin
  63       if Ar_Exec = null then
  64          Ar_Name := Osint.Program_Name (Archive_Builder);
  65          Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
  66
  67          if Ar_Exec = null then
  68             Free (Ar_Name);
  69             Ar_Name := new String'(Archive_Builder);
  70             Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
  71          end if;
  72
  73          if Ar_Exec = null then
  74             Fail (Ar_Name.all, " not found in path");
  75
  76          elsif Opt.Verbose_Mode then
  77             Write_Str  ("found ");
  78             Write_Line (Ar_Exec.all);
  79          end if;
  80
  81          Ar_Options := Archive_Builder_Options;
  82
  83          --  ranlib
  84
  85          Ranlib_Name := Osint.Program_Name (Archive_Indexer);
  86
  87          if Ranlib_Name'Length > 0 then
  88             Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
  89
  90             if Ranlib_Exec = null then
  91                Free (Ranlib_Name);
  92                Ranlib_Name := new String'(Archive_Indexer);
  93                Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
  94             end if;
  95
  96             if Ranlib_Exec /= null and then Opt.Verbose_Mode then
  97                Write_Str ("found ");
  98                Write_Line (Ranlib_Exec.all);
  99             end if;
 100          end if;
 101
 102          Ranlib_Options := Archive_Indexer_Options;
 103       end if;
 104
 105       Arguments :=
 106         new String_List (1 .. 1 + Ar_Options'Length + Objects'Length);
 107       Arguments (1 .. Ar_Options'Length) := Ar_Options.all; --  "ar cr ..."
 108       Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
 109       Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects;
 110
 111       Delete_File (Full_Output_File);
 112
 113       if not Opt.Quiet_Output then
 114          Write_Str (Ar_Name.all);
 115          Line_Length := Ar_Name'Length;
 116
 117          for J in Arguments'Range loop
 118
 119             --  Make sure the Output buffer does not overflow
 120
 121             if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
 122                Write_Eol;
 123                Line_Length := 0;
 124             end if;
 125
 126             Write_Char (' ');
 127             Write_Str  (Arguments (J).all);
 128             Line_Length := Line_Length + 1 + Arguments (J)'Length;
 129          end loop;
 130
 131          Write_Eol;
 132       end if;
 133
 134       OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
 135
 136       if not Success then
 137          Fail (Ar_Name.all, " execution error.");
 138       end if;
 139
 140       --  If we have found ranlib, run it over the library
 141
 142       if Ranlib_Exec /= null then
 143          if not Opt.Quiet_Output then
 144             Write_Str  (Ranlib_Name.all);
 145             Write_Char (' ');
 146             Write_Line (Arguments (Ar_Options'Length + 1).all);
 147          end if;
 148
 149          OS_Lib.Spawn
 150            (Ranlib_Exec.all,
 151             Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
 152             Success);
 153
 154          if not Success then
 155             Fail (Ranlib_Name.all, " execution error.");
 156          end if;
 157       end if;
 158    end Ar;
 159
 160    -----------------
 161    -- Delete_File --
 162    -----------------
 163
 164    procedure Delete_File (Filename : String) is
 165       File    : constant String := Filename & ASCII.Nul;
 166       Success : Boolean;
 167
 168    begin
 169       OS_Lib.Delete_File (File'Address, Success);
 170
 171       if Opt.Verbose_Mode then
 172          if Success then
 173             Write_Str ("deleted ");
 174
 175          else
 176             Write_Str ("could not delete ");
 177          end if;
 178
 179          Write_Line (Filename);
 180       end if;
 181    end Delete_File;
 182
 183    ---------
 184    -- Gcc --
 185    ---------
 186
 187    procedure Gcc
 188      (Output_File : String;
 189       Objects     : Argument_List;
 190       Options     : Argument_List;
 191       Options_2   : Argument_List;
 192       Driver_Name : Name_Id := No_Name)
 193    is
 194       Arguments :
 195         OS_Lib.Argument_List
 196           (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
 197
 198       A       : Natural := 0;
 199       Success : Boolean;
 200
 201       Out_Opt : constant OS_Lib.String_Access :=
 202                   new String'("-o");
 203       Out_V   : constant OS_Lib.String_Access :=
 204                   new String'(Output_File);
 205       Lib_Dir : constant OS_Lib.String_Access :=
 206                   new String'("-L" & Lib_Directory);
 207       Lib_Opt : constant OS_Lib.String_Access :=
 208                   new String'(Dynamic_Option);
 209
 210       Driver    : String_Access;
 211
 212    begin
 213       if Driver_Name = No_Name then
 214          if Gcc_Exec = null then
 215             Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
 216
 217             if Gcc_Exec = null then
 218                Fail (Gcc_Name, " not found in path");
 219             end if;
 220          end if;
 221
 222          Driver := Gcc_Exec;
 223
 224       else
 225          Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
 226
 227          if Driver = null then
 228             Fail (Get_Name_String (Driver_Name), " not found in path");
 229          end if;
 230       end if;
 231
 232       if Lib_Opt'Length /= 0 then
 233          A := A + 1;
 234          Arguments (A) := Lib_Opt;
 235       end if;
 236
 237       A := A + 1;
 238       Arguments (A) := Out_Opt;
 239
 240       A := A + 1;
 241       Arguments (A) := Out_V;
 242
 243       A := A + 1;
 244       Arguments (A) := Lib_Dir;
 245
 246       A := A + Options'Length;
 247       Arguments (A - Options'Length + 1 .. A) := Options;
 248
 249       A := A + Objects'Length;
 250       Arguments (A - Objects'Length + 1 .. A) := Objects;
 251
 252       A := A + Options_2'Length;
 253       Arguments (A - Options_2'Length + 1 .. A) := Options_2;
 254
 255       if not Opt.Quiet_Output then
 256          Write_Str (Driver.all);
 257
 258          for J in 1 .. A loop
 259             Write_Char (' ');
 260             Write_Str  (Arguments (J).all);
 261          end loop;
 262
 263          Write_Eol;
 264       end if;
 265
 266       OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
 267
 268       if not Success then
 269          if Driver_Name = No_Name then
 270             Fail (Gcc_Name, " execution error");
 271
 272          else
 273             Fail (Get_Name_String (Driver_Name), " execution error");
 274          end if;
 275       end if;
 276    end Gcc;
 277
 278    -------------------
 279    -- Lib_Directory --
 280    -------------------
 281
 282    function Lib_Directory return String is
 283       Libgnat : constant String := Tgt.Libgnat;
 284
 285    begin
 286       Name_Len := Libgnat'Length;
 287       Name_Buffer (1 .. Name_Len) := Libgnat;
 288       Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
 289
 290       --  Remove libgnat.a
 291
 292       return Name_Buffer (1 .. Name_Len - Libgnat'Length);
 293    end Lib_Directory;
 294
 295 end MLib.Utl;