old-autovect-branch/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-2005, 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    Initialized : Boolean := False;
  40
  41    Gcc_Name : constant String := "gcc";
  42    Gcc_Exec : OS_Lib.String_Access;
  43
  44    Ar_Name    : OS_Lib.String_Access;
  45    Ar_Exec    : OS_Lib.String_Access;
  46    Ar_Options : OS_Lib.String_List_Access;
  47
  48    Ranlib_Name    : OS_Lib.String_Access;
  49    Ranlib_Exec    : OS_Lib.String_Access := null;
  50    Ranlib_Options : OS_Lib.String_List_Access := null;
  51
  52    procedure Initialize;
  53    --  Look for the tools in the path and record the full path for each one
  54
  55    --------
  56    -- Ar --
  57    --------
  58
  59    procedure Ar (Output_File : String; Objects : Argument_List) is
  60       Full_Output_File : constant String :=
  61                              Ext_To (Output_File, Archive_Ext);
  62
  63       Arguments : OS_Lib.Argument_List_Access;
  64
  65       Success   : Boolean;
  66
  67       Line_Length : Natural := 0;
  68
  69    begin
  70       Utl.Initialize;
  71
  72       Arguments :=
  73         new String_List (1 .. 1 + Ar_Options'Length + Objects'Length);
  74       Arguments (1 .. Ar_Options'Length) := Ar_Options.all; --  "ar cr ..."
  75       Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
  76       Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects;
  77
  78       Delete_File (Full_Output_File);
  79
  80       if not Opt.Quiet_Output then
  81          Write_Str (Ar_Name.all);
  82          Line_Length := Ar_Name'Length;
  83
  84          for J in Arguments'Range loop
  85
  86             --  Make sure the Output buffer does not overflow
  87
  88             if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
  89                Write_Eol;
  90                Line_Length := 0;
  91             end if;
  92
  93             Write_Char (' ');
  94             Write_Str  (Arguments (J).all);
  95             Line_Length := Line_Length + 1 + Arguments (J)'Length;
  96          end loop;
  97
  98          Write_Eol;
  99       end if;
 100
 101       OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
 102
 103       if not Success then
 104          Fail (Ar_Name.all, " execution error.");
 105       end if;
 106
 107       --  If we have found ranlib, run it over the library
 108
 109       if Ranlib_Exec /= null then
 110          if not Opt.Quiet_Output then
 111             Write_Str  (Ranlib_Name.all);
 112             Write_Char (' ');
 113             Write_Line (Arguments (Ar_Options'Length + 1).all);
 114          end if;
 115
 116          OS_Lib.Spawn
 117            (Ranlib_Exec.all,
 118             Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
 119             Success);
 120
 121          if not Success then
 122             Fail (Ranlib_Name.all, " execution error.");
 123          end if;
 124       end if;
 125    end Ar;
 126
 127    -----------------
 128    -- Delete_File --
 129    -----------------
 130
 131    procedure Delete_File (Filename : in String) is
 132       File   : constant String := Filename & ASCII.Nul;
 133       Success : Boolean;
 134
 135    begin
 136       OS_Lib.Delete_File (File'Address, Success);
 137
 138       if Opt.Verbose_Mode then
 139          if Success then
 140             Write_Str ("deleted ");
 141
 142          else
 143             Write_Str ("could not delete ");
 144          end if;
 145
 146          Write_Line (Filename);
 147       end if;
 148    end Delete_File;
 149
 150    ---------
 151    -- Gcc --
 152    ---------
 153
 154    procedure Gcc
 155      (Output_File : String;
 156       Objects     : Argument_List;
 157       Options     : Argument_List;
 158       Options_2   : Argument_List;
 159       Driver_Name : Name_Id := No_Name)
 160    is
 161       Arguments :
 162         OS_Lib.Argument_List
 163           (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
 164
 165       A       : Natural := 0;
 166       Success : Boolean;
 167
 168       Out_Opt : constant OS_Lib.String_Access :=
 169                   new String'("-o");
 170       Out_V   : constant OS_Lib.String_Access :=
 171                   new String'(Output_File);
 172       Lib_Dir : constant OS_Lib.String_Access :=
 173                   new String'("-L" & Lib_Directory);
 174       Lib_Opt : constant OS_Lib.String_Access :=
 175                   new String'(Dynamic_Option);
 176
 177       Driver  : String_Access;
 178    begin
 179       Utl.Initialize;
 180
 181       if Driver_Name = No_Name then
 182          Driver := Gcc_Exec;
 183
 184       else
 185          Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
 186
 187          if Driver = null then
 188             Fail (Get_Name_String (Driver_Name), " not found in path");
 189          end if;
 190       end if;
 191
 192       if Lib_Opt'Length /= 0 then
 193          A := A + 1;
 194          Arguments (A) := Lib_Opt;
 195       end if;
 196
 197       A := A + 1;
 198       Arguments (A) := Out_Opt;
 199
 200       A := A + 1;
 201       Arguments (A) := Out_V;
 202
 203       A := A + 1;
 204       Arguments (A) := Lib_Dir;
 205
 206       A := A + Options'Length;
 207       Arguments (A - Options'Length + 1 .. A) := Options;
 208
 209       A := A + Objects'Length;
 210       Arguments (A - Objects'Length + 1 .. A) := Objects;
 211
 212       A := A + Options_2'Length;
 213       Arguments (A - Options_2'Length + 1 .. A) := Options_2;
 214
 215       if not Opt.Quiet_Output then
 216          Write_Str (Driver.all);
 217
 218          for J in 1 .. A loop
 219             Write_Char (' ');
 220             Write_Str  (Arguments (J).all);
 221          end loop;
 222
 223          Write_Eol;
 224       end if;
 225
 226       OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
 227
 228       if not Success then
 229          if Driver_Name = No_Name then
 230             Fail (Gcc_Name, " execution error");
 231
 232          else
 233             Fail (Get_Name_String (Driver_Name), " execution error");
 234          end if;
 235       end if;
 236    end Gcc;
 237
 238    ----------------
 239    -- Initialize --
 240    ----------------
 241
 242    procedure Initialize is
 243    begin
 244       if not Initialized then
 245          Initialized := True;
 246
 247          --  gcc
 248
 249          Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
 250
 251          if Gcc_Exec = null then
 252             Fail (Gcc_Name, " not found in path");
 253
 254          elsif Opt.Verbose_Mode then
 255             Write_Str  ("found ");
 256             Write_Line (Gcc_Exec.all);
 257          end if;
 258
 259          --  ar
 260
 261          Ar_Name := new String'(Archive_Builder);
 262          Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
 263
 264          if Ar_Exec = null then
 265             Fail (Ar_Name.all, " not found in path");
 266
 267          elsif Opt.Verbose_Mode then
 268             Write_Str  ("found ");
 269             Write_Line (Ar_Exec.all);
 270          end if;
 271
 272          Ar_Options := Archive_Builder_Options;
 273
 274          --  ranlib
 275
 276          Ranlib_Name := new String'(Archive_Indexer);
 277
 278          if Ranlib_Name'Length > 0 then
 279             Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
 280
 281             if Ranlib_Exec /= null and then Opt.Verbose_Mode then
 282                Write_Str ("found ");
 283                Write_Line (Ranlib_Exec.all);
 284             end if;
 285          end if;
 286
 287          Ranlib_Options := Archive_Indexer_Options;
 288       end if;
 289    end Initialize;
 290
 291    -------------------
 292    -- Lib_Directory --
 293    -------------------
 294
 295    function Lib_Directory return String is
 296       Libgnat : constant String := Tgt.Libgnat;
 297
 298    begin
 299       Name_Len := Libgnat'Length;
 300       Name_Buffer (1 .. Name_Len) := Libgnat;
 301       Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
 302
 303       --  Remove libgnat.a
 304
 305       return Name_Buffer (1 .. Name_Len - Libgnat'Length);
 306    end Lib_Directory;
 307
 308 end MLib.Utl;