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, Ada Core Technologies, Inc.             --
  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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with MLib.Fil;
  28 with MLib.Tgt;
  29 with Namet;  use Namet;
  30 with Opt;
  31 with Osint;  use Osint;
  32 with Output; use Output;
  33
  34 package body MLib.Utl is
  35
  36    use GNAT;
  37
  38    package Files  renames MLib.Fil;
  39    package Target renames MLib.Tgt;
  40
  41    Initialized   : Boolean := False;
  42
  43    Gcc_Name      : constant String := "gcc";
  44    Gcc_Exec      : OS_Lib.String_Access;
  45
  46    Ar_Name       : constant String := "ar";
  47    Ar_Exec       : OS_Lib.String_Access;
  48
  49    Ranlib_Name   : constant String := "ranlib";
  50    Ranlib_Exec   : OS_Lib.String_Access;
  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       Create_Add_Opt : OS_Lib.String_Access := new String' ("cr");
  61
  62       Full_Output_File : constant String :=
  63                              Files.Ext_To (Output_File, Target.Archive_Ext);
  64
  65       Arguments : OS_Lib.Argument_List (1 .. 2 + Objects'Length);
  66       Success   : Boolean;
  67
  68    begin
  69       Initialize;
  70
  71       Arguments (1) := Create_Add_Opt; --  "ar cr ..."
  72       Arguments (2) := new String'(Full_Output_File);
  73       Arguments (3 .. Arguments'Last) := Objects;
  74
  75       Delete_File (Full_Output_File);
  76
  77       if not Opt.Quiet_Output then
  78          Write_Str (Ar_Name);
  79
  80          for J in Arguments'Range loop
  81             Write_Char (' ');
  82             Write_Str  (Arguments (J).all);
  83          end loop;
  84
  85          Write_Eol;
  86       end if;
  87
  88       OS_Lib.Spawn (Ar_Exec.all, Arguments, Success);
  89
  90       if not Success then
  91          Fail (Ar_Name, " execution error.");
  92       end if;
  93
  94       --  If we have found ranlib, run it over the library
  95
  96       if Ranlib_Exec /= null then
  97          if not Opt.Quiet_Output then
  98             Write_Str  (Ranlib_Name);
  99             Write_Char (' ');
 100             Write_Line (Arguments (2).all);
 101          end if;
 102
 103          OS_Lib.Spawn (Ranlib_Exec.all, (1 => Arguments (2)), Success);
 104
 105          if not Success then
 106             Fail (Ranlib_Name, " execution error.");
 107          end if;
 108       end if;
 109    end Ar;
 110
 111    -----------------
 112    -- Delete_File --
 113    -----------------
 114
 115    procedure Delete_File (Filename : in String) is
 116       File   : constant String := Filename & ASCII.Nul;
 117       Success : Boolean;
 118
 119    begin
 120       OS_Lib.Delete_File (File'Address, Success);
 121
 122       if Opt.Verbose_Mode then
 123          if Success then
 124             Write_Str ("deleted ");
 125
 126          else
 127             Write_Str ("could not delete ");
 128          end if;
 129
 130          Write_Line (Filename);
 131       end if;
 132    end Delete_File;
 133
 134    ---------
 135    -- Gcc --
 136    ---------
 137
 138    procedure Gcc
 139      (Output_File : String;
 140       Objects     : Argument_List;
 141       Options     : Argument_List)
 142    is
 143       Arguments : OS_Lib.Argument_List
 144                     (1 .. 7 + Objects'Length + Options'Length);
 145
 146       A         : Natural := 0;
 147       Success   : Boolean;
 148       Out_Opt   : OS_Lib.String_Access := new String' ("-o");
 149       Out_V     : OS_Lib.String_Access := new String' (Output_File);
 150       Lib_Dir   : OS_Lib.String_Access := new String' ("-L" & Lib_Directory);
 151       Lib_Opt   : OS_Lib.String_Access := new String' (Target.Dynamic_Option);
 152
 153    begin
 154       Initialize;
 155
 156       if Lib_Opt'Length /= 0 then
 157          A := A + 1;
 158          Arguments (A) := Lib_Opt;
 159       end if;
 160
 161       A := A + 1;
 162       Arguments (A) := Out_Opt;
 163
 164       A := A + 1;
 165       Arguments (A) := Out_V;
 166
 167       A := A + 1;
 168       Arguments (A) := Lib_Dir;
 169
 170       A := A + Options'Length;
 171       Arguments (A - Options'Length + 1 .. A) := Options;
 172
 173       A := A + Objects'Length;
 174       Arguments (A - Objects'Length + 1 .. A) := Objects;
 175
 176       if not Opt.Quiet_Output then
 177          Write_Str (Gcc_Exec.all);
 178
 179          for J in 1 .. A loop
 180             Write_Char (' ');
 181             Write_Str  (Arguments (J).all);
 182          end loop;
 183
 184          Write_Eol;
 185       end if;
 186
 187       OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
 188
 189       if not Success then
 190          Fail (Gcc_Name, " execution error");
 191       end if;
 192    end Gcc;
 193
 194    ----------------
 195    -- Initialize --
 196    ----------------
 197
 198    procedure Initialize is
 199       use type OS_Lib.String_Access;
 200
 201    begin
 202       if not Initialized then
 203          Initialized := True;
 204
 205          --  gcc
 206
 207          Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
 208
 209          if Gcc_Exec = null then
 210
 211             Fail (Gcc_Name, " not found in path");
 212
 213          elsif Opt.Verbose_Mode then
 214             Write_Str  ("found ");
 215             Write_Line (Gcc_Exec.all);
 216          end if;
 217
 218          --  ar
 219
 220          Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name);
 221
 222          if Ar_Exec = null then
 223
 224             Fail (Ar_Name, " not found in path");
 225
 226          elsif Opt.Verbose_Mode then
 227             Write_Str  ("found ");
 228             Write_Line (Ar_Exec.all);
 229          end if;
 230
 231          --  ranlib
 232
 233          Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name);
 234
 235          if Ranlib_Exec /= null and then Opt.Verbose_Mode then
 236             Write_Str ("found ");
 237             Write_Line (Ranlib_Exec.all);
 238          end if;
 239
 240       end if;
 241
 242    end Initialize;
 243
 244    -------------------
 245    -- Lib_Directory --
 246    -------------------
 247
 248    function Lib_Directory return String is
 249       Libgnat : constant String := Target.Libgnat;
 250
 251    begin
 252       Name_Len := Libgnat'Length;
 253       Name_Buffer (1 .. Name_Len) := Libgnat;
 254       Get_Name_String (Find_File (Name_Enter, Library));
 255
 256       --  Remove libgnat.a
 257
 258       return Name_Buffer (1 .. Name_Len - Libgnat'Length);
 259    end Lib_Directory;
 260
 261 end MLib.Utl;