1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2003, 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;
52 -- Look for the tools in the path and record the full path for each one
58 procedure Ar (Output_File : String; Objects : Argument_List) is
59 Full_Output_File : constant String :=
60 Ext_To (Output_File, Archive_Ext);
62 Arguments : OS_Lib.Argument_List_Access;
66 Line_Length : Natural := 0;
67 Max_Line_Length : constant := 200; -- arbitrary
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
85 -- Make sure the Output buffer does not overflow
87 if Line_Length + 1 + Arguments (J)'Length > Max_Line_Length then
93 Write_Str (Arguments (J).all);
94 Line_Length := Line_Length + 1 + Arguments (J)'Length;
100 OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
103 Fail (Ar_Name.all, " execution error.");
106 -- If we have found ranlib, run it over the library
108 if Ranlib_Exec /= null then
109 if not Opt.Quiet_Output then
110 Write_Str (Ranlib_Name.all);
112 Write_Line (Arguments (Ar_Options'Length + 1).all);
117 (1 => Arguments (Ar_Options'Length + 1)),
121 Fail (Ranlib_Name.all, " execution error.");
130 procedure Delete_File (Filename : in String) is
131 File : constant String := Filename & ASCII.Nul;
135 OS_Lib.Delete_File (File'Address, Success);
137 if Opt.Verbose_Mode then
139 Write_Str ("deleted ");
142 Write_Str ("could not delete ");
145 Write_Line (Filename);
154 (Output_File : String;
155 Objects : Argument_List;
156 Options : Argument_List;
157 Driver_Name : Name_Id := No_Name;
158 Options_2 : Argument_List := No_Argument_List)
162 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
167 Out_Opt : constant OS_Lib.String_Access :=
169 Out_V : constant OS_Lib.String_Access :=
170 new String'(Output_File);
171 Lib_Dir : constant OS_Lib.String_Access :=
172 new String'("-L" & Lib_Directory);
173 Lib_Opt : constant OS_Lib.String_Access :=
174 new String'(Dynamic_Option);
176 Driver : String_Access;
180 if Driver_Name = No_Name then
184 Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
186 if Driver = null then
187 Fail (Get_Name_String (Driver_Name), " not found in path");
191 if Lib_Opt'Length /= 0 then
193 Arguments (A) := Lib_Opt;
197 Arguments (A) := Out_Opt;
200 Arguments (A) := Out_V;
203 Arguments (A) := Lib_Dir;
205 A := A + Options'Length;
206 Arguments (A - Options'Length + 1 .. A) := Options;
208 A := A + Objects'Length;
209 Arguments (A - Objects'Length + 1 .. A) := Objects;
211 A := A + Options_2'Length;
212 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
214 if not Opt.Quiet_Output then
215 Write_Str (Driver.all);
219 Write_Str (Arguments (J).all);
225 OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
228 if Driver_Name = No_Name then
229 Fail (Gcc_Name, " execution error");
232 Fail (Get_Name_String (Driver_Name), " execution error");
241 procedure Initialize is
243 if not Initialized then
248 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
250 if Gcc_Exec = null then
251 Fail (Gcc_Name, " not found in path");
253 elsif Opt.Verbose_Mode then
254 Write_Str ("found ");
255 Write_Line (Gcc_Exec.all);
260 Ar_Name := new String'(Archive_Builder);
261 Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
263 if Ar_Exec = null then
264 Fail (Ar_Name.all, " not found in path");
266 elsif Opt.Verbose_Mode then
267 Write_Str ("found ");
268 Write_Line (Ar_Exec.all);
271 Ar_Options := Archive_Builder_Options;
275 Ranlib_Name := new String'(Archive_Indexer);
277 if Ranlib_Name'Length > 0 then
278 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
280 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
281 Write_Str ("found ");
282 Write_Line (Ranlib_Exec.all);
292 function Lib_Directory return String is
293 Libgnat : constant String := Tgt.Libgnat;
296 Name_Len := Libgnat'Length;
297 Name_Buffer (1 .. Name_Len) := Libgnat;
298 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
302 return Name_Buffer (1 .. Name_Len - Libgnat'Length);