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);