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