1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2002-2006, AdaCore --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 Gcc_Name : constant String := Osint.Program_Name ("gcc").all;
40 Gcc_Exec : OS_Lib.String_Access;
42 Ar_Name : OS_Lib.String_Access;
43 Ar_Exec : OS_Lib.String_Access;
44 Ar_Options : OS_Lib.String_List_Access;
46 Ranlib_Name : OS_Lib.String_Access;
47 Ranlib_Exec : OS_Lib.String_Access := null;
48 Ranlib_Options : OS_Lib.String_List_Access := null;
54 procedure Ar (Output_File : String; Objects : Argument_List) is
55 Full_Output_File : constant String :=
56 Ext_To (Output_File, Archive_Ext);
58 Arguments : OS_Lib.Argument_List_Access;
60 Line_Length : Natural := 0;
63 if Ar_Exec = null then
64 Ar_Name := Osint.Program_Name (Archive_Builder);
65 Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
67 if Ar_Exec = null then
69 Ar_Name := new String'(Archive_Builder);
70 Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
73 if Ar_Exec = null then
74 Fail (Ar_Name.all, " not found in path");
76 elsif Opt.Verbose_Mode then
78 Write_Line (Ar_Exec.all);
81 Ar_Options := Archive_Builder_Options;
85 Ranlib_Name := Osint.Program_Name (Archive_Indexer);
87 if Ranlib_Name'Length > 0 then
88 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
90 if Ranlib_Exec = null then
92 Ranlib_Name := new String'(Archive_Indexer);
93 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
96 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
98 Write_Line (Ranlib_Exec.all);
102 Ranlib_Options := Archive_Indexer_Options;
106 new String_List (1 .. 1 + Ar_Options'Length + Objects'Length);
107 Arguments (1 .. Ar_Options'Length) := Ar_Options.all; -- "ar cr ..."
108 Arguments (Ar_Options'Length + 1) := new String'(Full_Output_File);
109 Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects;
111 Delete_File (Full_Output_File);
113 if not Opt.Quiet_Output then
114 Write_Str (Ar_Name.all);
115 Line_Length := Ar_Name'Length;
117 for J in Arguments'Range loop
119 -- Make sure the Output buffer does not overflow
121 if Line_Length + 1 + Arguments (J)'Length > Buffer_Max then
127 Write_Str (Arguments (J).all);
128 Line_Length := Line_Length + 1 + Arguments (J)'Length;
134 OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
137 Fail (Ar_Name.all, " execution error.");
140 -- If we have found ranlib, run it over the library
142 if Ranlib_Exec /= null then
143 if not Opt.Quiet_Output then
144 Write_Str (Ranlib_Name.all);
146 Write_Line (Arguments (Ar_Options'Length + 1).all);
151 Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
155 Fail (Ranlib_Name.all, " execution error.");
164 procedure Delete_File (Filename : String) is
165 File : constant String := Filename & ASCII.Nul;
169 OS_Lib.Delete_File (File'Address, Success);
171 if Opt.Verbose_Mode then
173 Write_Str ("deleted ");
176 Write_Str ("could not delete ");
179 Write_Line (Filename);
188 (Output_File : String;
189 Objects : Argument_List;
190 Options : Argument_List;
191 Options_2 : Argument_List;
192 Driver_Name : Name_Id := No_Name)
196 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
201 Out_Opt : constant OS_Lib.String_Access :=
203 Out_V : constant OS_Lib.String_Access :=
204 new String'(Output_File);
205 Lib_Dir : constant OS_Lib.String_Access :=
206 new String'("-L" & Lib_Directory);
207 Lib_Opt : constant OS_Lib.String_Access :=
208 new String'(Dynamic_Option);
210 Driver : String_Access;
213 if Driver_Name = No_Name then
214 if Gcc_Exec = null then
215 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
217 if Gcc_Exec = null then
218 Fail (Gcc_Name, " not found in path");
225 Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
227 if Driver = null then
228 Fail (Get_Name_String (Driver_Name), " not found in path");
232 if Lib_Opt'Length /= 0 then
234 Arguments (A) := Lib_Opt;
238 Arguments (A) := Out_Opt;
241 Arguments (A) := Out_V;
244 Arguments (A) := Lib_Dir;
246 A := A + Options'Length;
247 Arguments (A - Options'Length + 1 .. A) := Options;
249 A := A + Objects'Length;
250 Arguments (A - Objects'Length + 1 .. A) := Objects;
252 A := A + Options_2'Length;
253 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
255 if not Opt.Quiet_Output then
256 Write_Str (Driver.all);
260 Write_Str (Arguments (J).all);
266 OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
269 if Driver_Name = No_Name then
270 Fail (Gcc_Name, " execution error");
273 Fail (Get_Name_String (Driver_Name), " execution error");
282 function Lib_Directory return String is
283 Libgnat : constant String := Tgt.Libgnat;
286 Name_Len := Libgnat'Length;
287 Name_Buffer (1 .. Name_Len) := Libgnat;
288 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
292 return Name_Buffer (1 .. Name_Len - Libgnat'Length);