gcc:
[official-gcc.git] / gcc / ada / mlib-utl.adb
blob821bfa981fb1d082c1afe75950b138b50c8ec39c
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-2006, AdaCore --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 ------------------------------------------------------------------------------
27 with MLib.Fil; use MLib.Fil;
28 with MLib.Tgt; use MLib.Tgt;
30 with Namet; use Namet;
31 with Opt;
32 with Osint;
33 with Output; use Output;
35 with GNAT; use GNAT;
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;
50 --------
51 -- Ar --
52 --------
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;
59 Success : Boolean;
60 Line_Length : Natural := 0;
62 begin
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
68 Free (Ar_Name);
69 Ar_Name := new String'(Archive_Builder);
70 Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
71 end if;
73 if Ar_Exec = null then
74 Fail (Ar_Name.all, " not found in path");
76 elsif Opt.Verbose_Mode then
77 Write_Str ("found ");
78 Write_Line (Ar_Exec.all);
79 end if;
81 Ar_Options := Archive_Builder_Options;
83 -- ranlib
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
91 Free (Ranlib_Name);
92 Ranlib_Name := new String'(Archive_Indexer);
93 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
94 end if;
96 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
97 Write_Str ("found ");
98 Write_Line (Ranlib_Exec.all);
99 end if;
100 end if;
102 Ranlib_Options := Archive_Indexer_Options;
103 end if;
105 Arguments :=
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
122 Write_Eol;
123 Line_Length := 0;
124 end if;
126 Write_Char (' ');
127 Write_Str (Arguments (J).all);
128 Line_Length := Line_Length + 1 + Arguments (J)'Length;
129 end loop;
131 Write_Eol;
132 end if;
134 OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
136 if not Success then
137 Fail (Ar_Name.all, " execution error.");
138 end if;
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);
145 Write_Char (' ');
146 Write_Line (Arguments (Ar_Options'Length + 1).all);
147 end if;
149 OS_Lib.Spawn
150 (Ranlib_Exec.all,
151 Ranlib_Options.all & (Arguments (Ar_Options'Length + 1)),
152 Success);
154 if not Success then
155 Fail (Ranlib_Name.all, " execution error.");
156 end if;
157 end if;
158 end Ar;
160 -----------------
161 -- Delete_File --
162 -----------------
164 procedure Delete_File (Filename : String) is
165 File : constant String := Filename & ASCII.Nul;
166 Success : Boolean;
168 begin
169 OS_Lib.Delete_File (File'Address, Success);
171 if Opt.Verbose_Mode then
172 if Success then
173 Write_Str ("deleted ");
175 else
176 Write_Str ("could not delete ");
177 end if;
179 Write_Line (Filename);
180 end if;
181 end Delete_File;
183 ---------
184 -- Gcc --
185 ---------
187 procedure Gcc
188 (Output_File : String;
189 Objects : Argument_List;
190 Options : Argument_List;
191 Options_2 : Argument_List;
192 Driver_Name : Name_Id := No_Name)
194 Arguments :
195 OS_Lib.Argument_List
196 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
198 A : Natural := 0;
199 Success : Boolean;
201 Out_Opt : constant OS_Lib.String_Access :=
202 new String'("-o");
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;
212 begin
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");
219 end if;
220 end if;
222 Driver := Gcc_Exec;
224 else
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");
229 end if;
230 end if;
232 if Lib_Opt'Length /= 0 then
233 A := A + 1;
234 Arguments (A) := Lib_Opt;
235 end if;
237 A := A + 1;
238 Arguments (A) := Out_Opt;
240 A := A + 1;
241 Arguments (A) := Out_V;
243 A := A + 1;
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);
258 for J in 1 .. A loop
259 Write_Char (' ');
260 Write_Str (Arguments (J).all);
261 end loop;
263 Write_Eol;
264 end if;
266 OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
268 if not Success then
269 if Driver_Name = No_Name then
270 Fail (Gcc_Name, " execution error");
272 else
273 Fail (Get_Name_String (Driver_Name), " execution error");
274 end if;
275 end if;
276 end Gcc;
278 -------------------
279 -- Lib_Directory --
280 -------------------
282 function Lib_Directory return String is
283 Libgnat : constant String := Tgt.Libgnat;
285 begin
286 Name_Len := Libgnat'Length;
287 Name_Buffer (1 .. Name_Len) := Libgnat;
288 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
290 -- Remove libgnat.a
292 return Name_Buffer (1 .. Name_Len - Libgnat'Length);
293 end Lib_Directory;
295 end MLib.Utl;