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;
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;
72 new String_List
(1 .. 1 + Ar_Options
'Length + Objects
'Length);
73 Arguments
(1 .. Ar_Options
'Length) := Ar_Options
.all; -- "ar cr ..."
74 Arguments
(Ar_Options
'Length + 1) := new String'(Full_Output_File);
75 Arguments (Ar_Options'Length + 2 .. Arguments'Last) := Objects;
77 Delete_File (Full_Output_File);
79 if not Opt.Quiet_Output then
80 Write_Str (Ar_Name.all);
81 Line_Length := Ar_Name'Length;
83 for J in Arguments'Range loop
85 -- Make sure the Output buffer does not overflow
87 if Line_Length + 1 + Arguments (J)'Length >
88 Integer (Opt.Max_Line_Length)
95 Write_Str (Arguments (J).all);
96 Line_Length := Line_Length + 1 + Arguments (J)'Length;
102 OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
105 Fail (Ar_Name.all, " execution error.");
108 -- If we have found ranlib, run it over the library
110 if Ranlib_Exec /= null then
111 if not Opt.Quiet_Output then
112 Write_Str (Ranlib_Name.all);
114 Write_Line (Arguments (Ar_Options'Length + 1).all);
119 (1 => Arguments (Ar_Options'Length + 1)),
123 Fail (Ranlib_Name.all, " execution error.");
132 procedure Delete_File (Filename : in String) is
133 File : constant String := Filename & ASCII.Nul;
137 OS_Lib.Delete_File (File'Address, Success);
139 if Opt.Verbose_Mode then
141 Write_Str ("deleted ");
144 Write_Str ("could not delete ");
147 Write_Line (Filename);
156 (Output_File : String;
157 Objects : Argument_List;
158 Options : Argument_List;
159 Options_2 : Argument_List;
160 Driver_Name : Name_Id := No_Name)
164 (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
169 Out_Opt : constant OS_Lib.String_Access :=
171 Out_V
: constant OS_Lib
.String_Access
:=
172 new String'(Output_File);
173 Lib_Dir : constant OS_Lib.String_Access :=
174 new String'("-L" & Lib_Directory
);
175 Lib_Opt
: constant OS_Lib
.String_Access
:=
176 new String'(Dynamic_Option);
178 Driver : String_Access;
182 if Driver_Name = No_Name then
186 Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
188 if Driver = null then
189 Fail (Get_Name_String (Driver_Name), " not found in path");
193 if Lib_Opt'Length /= 0 then
195 Arguments (A) := Lib_Opt;
199 Arguments (A) := Out_Opt;
202 Arguments (A) := Out_V;
205 Arguments (A) := Lib_Dir;
207 A := A + Options'Length;
208 Arguments (A - Options'Length + 1 .. A) := Options;
210 A := A + Objects'Length;
211 Arguments (A - Objects'Length + 1 .. A) := Objects;
213 A := A + Options_2'Length;
214 Arguments (A - Options_2'Length + 1 .. A) := Options_2;
216 if not Opt.Quiet_Output then
217 Write_Str (Driver.all);
221 Write_Str (Arguments (J).all);
227 OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
230 if Driver_Name = No_Name then
231 Fail (Gcc_Name, " execution error");
234 Fail (Get_Name_String (Driver_Name), " execution error");
243 procedure Initialize is
245 if not Initialized then
250 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
252 if Gcc_Exec = null then
253 Fail (Gcc_Name, " not found in path");
255 elsif Opt.Verbose_Mode then
256 Write_Str ("found ");
257 Write_Line (Gcc_Exec.all);
262 Ar_Name := new String'(Archive_Builder
);
263 Ar_Exec
:= OS_Lib
.Locate_Exec_On_Path
(Ar_Name
.all);
265 if Ar_Exec
= null then
266 Fail
(Ar_Name
.all, " not found in path");
268 elsif Opt
.Verbose_Mode
then
269 Write_Str
("found ");
270 Write_Line
(Ar_Exec
.all);
273 Ar_Options
:= Archive_Builder_Options
;
277 Ranlib_Name
:= new String'(Archive_Indexer);
279 if Ranlib_Name'Length > 0 then
280 Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
282 if Ranlib_Exec /= null and then Opt.Verbose_Mode then
283 Write_Str ("found ");
284 Write_Line (Ranlib_Exec.all);
294 function Lib_Directory return String is
295 Libgnat : constant String := Tgt.Libgnat;
298 Name_Len := Libgnat'Length;
299 Name_Buffer (1 .. Name_Len) := Libgnat;
300 Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
304 return Name_Buffer (1 .. Name_Len - Libgnat'Length);