1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2004, Ada Core Technologies, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with MLib.Fil; use MLib.Fil;
28 with MLib.Tgt; use MLib.Tgt;
30 with Namet; use Namet;
33 with Output; use Output;
37 package body MLib.Utl is
39 Initialized : Boolean := False;
41 Gcc_Name : constant String := "gcc";
42 Gcc_Exec : OS_Lib.String_Access;
44 Ar_Name : OS_Lib.String_Access;
45 Ar_Exec : OS_Lib.String_Access;
46 Ar_Options : OS_Lib.String_List_Access;
48 Ranlib_Name : OS_Lib.String_Access;
49 Ranlib_Exec : OS_Lib.String_Access := null;
50 Ranlib_Options : OS_Lib.String_List_Access := null;
53 -- Look for the tools in the path and record the full path for each one
59 procedure Ar (Output_File : String; Objects : Argument_List) is
60 Full_Output_File : constant String :=
61 Ext_To (Output_File, Archive_Ext);
63 Arguments : OS_Lib.Argument_List_Access;
67 Line_Length : Natural := 0;
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;
78 Delete_File (Full_Output_File);
80 if not Opt.Quiet_Output then
81 Write_Str (Ar_Name.all);
82 Line_Length := Ar_Name'Length;
84 for J in Arguments'Range loop
86 -- Make sure the Output buffer does not overflow
88 if Line_Length + 1 + Arguments (J)'Length >
89 Integer (Opt.Max_Line_Length)
96 Write_Str (Arguments (J).all);
97 Line_Length := Line_Length + 1 + Arguments (J)'Length;
103 OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
106 Fail (Ar_Name.all, " execution error.");
109 -- If we have found ranlib, run it over the library
111 if Ranlib_Exec /= null then
112 if not Opt.Quiet_Output then
113 Write_Str (Ranlib_Name.all);
115 Write_Line (Arguments (Ar_Options'Length + 1).all);
120 Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
124 Fail (Ranlib_Name.all, " execution error.");
133 procedure Delete_File (Filename : in String) is
134 File : constant String := Filename & ASCII.Nul;
138 OS_Lib.Delete_File (File'Address, Success);
140 if Opt.Verbose_Mode then
142 Write_Str ("deleted ");
145 Write_Str ("could not delete ");
148 Write_Line (Filename);
157 (Output_File : String;
158 Objects : Argument_List;
159 Options : Argument_List;
160 Options_2 : Argument_List;
161 Driver_Name : Name_Id := No_Name)
165 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
170 Out_Opt : constant OS_Lib.String_Access :=
172 Out_V : constant OS_Lib.String_Access :=
173 new String'(Output_File);
174 Lib_Dir : constant OS_Lib.String_Access :=
175 new String'("-L" & Lib_Directory);
176 Lib_Opt : constant OS_Lib.String_Access :=
177 new String'(Dynamic_Option);
179 Driver : String_Access;
183 if Driver_Name = No_Name then
187 Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
189 if Driver = null then
190 Fail (Get_Name_String (Driver_Name), " not found in path");
194 if Lib_Opt'Length /= 0 then
196 Arguments (A) := Lib_Opt;
200 Arguments (A) := Out_Opt;
203 Arguments (A) := Out_V;
206 Arguments (A) := Lib_Dir;
208 A := A + Options'Length;
209 Arguments (A - Options'Length + 1 .. A) := Options;
211 A := A + Objects'Length;
212 Arguments (A - Objects'Length + 1 .. A) := Objects;
214 A := A + Options_2'Length;
215 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
217 if not Opt.Quiet_Output then
218 Write_Str (Driver.all);
222 Write_Str (Arguments (J).all);
228 OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
231 if Driver_Name = No_Name then
232 Fail (Gcc_Name, " execution error");
235 Fail (Get_Name_String (Driver_Name), " execution error");
244 procedure Initialize is
246 if not Initialized then
251 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
253 if Gcc_Exec = null then
254 Fail (Gcc_Name, " not found in path");
256 elsif Opt.Verbose_Mode then
257 Write_Str ("found ");
258 Write_Line (Gcc_Exec.all);
263 Ar_Name := new String'(Archive_Builder);
264 Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
266 if Ar_Exec = null then
267 Fail (Ar_Name.all, " not found in path");
269 elsif Opt.Verbose_Mode then
270 Write_Str ("found ");
271 Write_Line (Ar_Exec.all);
274 Ar_Options := Archive_Builder_Options;
278 Ranlib_Name := new String'(Archive_Indexer);
280 if Ranlib_Name'Length > 0 then
281 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
283 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
284 Write_Str ("found ");
285 Write_Line (Ranlib_Exec.all);
289 Ranlib_Options := Archive_Indexer_Options;
297 function Lib_Directory return String is
298 Libgnat : constant String := Tgt.Libgnat;
301 Name_Len := Libgnat'Length;
302 Name_Buffer (1 .. Name_Len) := Libgnat;
303 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
307 return Name_Buffer (1 .. Name_Len - Libgnat'Length);