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