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-2003, Ada Core Technologies, Inc.        --
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,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, 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------------------------------------------------------------------------------
26
27with MLib.Fil; use MLib.Fil;
28with MLib.Tgt; use MLib.Tgt;
29
30with Namet;    use Namet;
31with Opt;
32with Osint;
33with Output;   use Output;
34
35with GNAT;     use GNAT;
36
37package body MLib.Utl is
38
39   Initialized   : Boolean := False;
40
41   Gcc_Name      : constant String := "gcc";
42   Gcc_Exec      : OS_Lib.String_Access;
43
44   Ar_Name       : OS_Lib.String_Access;
45   Ar_Exec       : OS_Lib.String_Access;
46   Ar_Options    : OS_Lib.String_List_Access;
47
48   Ranlib_Name   : OS_Lib.String_Access;
49   Ranlib_Exec   : OS_Lib.String_Access := null;
50
51   procedure Initialize;
52   --  Look for the tools in the path and record the full path for each one
53
54   --------
55   -- Ar --
56   --------
57
58   procedure Ar (Output_File : String; Objects : Argument_List) is
59      Full_Output_File : constant String :=
60                             Ext_To (Output_File, Archive_Ext);
61
62      Arguments : OS_Lib.Argument_List_Access;
63
64      Success   : Boolean;
65
66      Line_Length : Natural := 0;
67      Max_Line_Length : constant := 200; --  arbitrary
68
69   begin
70      Initialize;
71
72      Arguments :=
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;
77
78      Delete_File (Full_Output_File);
79
80      if not Opt.Quiet_Output then
81         Write_Str (Ar_Name.all);
82         Line_Length := Ar_Name'Length;
83
84         for J in Arguments'Range loop
85            --  Make sure the Output buffer does not overflow
86
87            if Line_Length + 1 + Arguments (J)'Length > Max_Line_Length then
88               Write_Eol;
89               Line_Length := 0;
90            end if;
91
92            Write_Char (' ');
93            Write_Str  (Arguments (J).all);
94            Line_Length := Line_Length + 1 + Arguments (J)'Length;
95         end loop;
96
97         Write_Eol;
98      end if;
99
100      OS_Lib.Spawn (Ar_Exec.all, Arguments.all, Success);
101
102      if not Success then
103         Fail (Ar_Name.all, " execution error.");
104      end if;
105
106      --  If we have found ranlib, run it over the library
107
108      if Ranlib_Exec /= null then
109         if not Opt.Quiet_Output then
110            Write_Str  (Ranlib_Name.all);
111            Write_Char (' ');
112            Write_Line (Arguments (Ar_Options'Length + 1).all);
113         end if;
114
115         OS_Lib.Spawn
116           (Ranlib_Exec.all,
117            (1 => Arguments (Ar_Options'Length + 1)),
118            Success);
119
120         if not Success then
121            Fail (Ranlib_Name.all, " execution error.");
122         end if;
123      end if;
124   end Ar;
125
126   -----------------
127   -- Delete_File --
128   -----------------
129
130   procedure Delete_File (Filename : in String) is
131      File   : constant String := Filename & ASCII.Nul;
132      Success : Boolean;
133
134   begin
135      OS_Lib.Delete_File (File'Address, Success);
136
137      if Opt.Verbose_Mode then
138         if Success then
139            Write_Str ("deleted ");
140
141         else
142            Write_Str ("could not delete ");
143         end if;
144
145         Write_Line (Filename);
146      end if;
147   end Delete_File;
148
149   ---------
150   -- Gcc --
151   ---------
152
153   procedure Gcc
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)
159   is
160      Arguments :
161        OS_Lib.Argument_List
162          (1 .. 7 + Objects'Length + Options'Length + Options_2'Length);
163
164      A       : Natural := 0;
165      Success : Boolean;
166
167      Out_Opt : constant OS_Lib.String_Access :=
168                  new String'("-o");
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);
175
176      Driver  : String_Access;
177   begin
178      Initialize;
179
180      if Driver_Name = No_Name then
181         Driver := Gcc_Exec;
182
183      else
184         Driver := OS_Lib.Locate_Exec_On_Path (Get_Name_String (Driver_Name));
185
186         if Driver = null then
187            Fail (Get_Name_String (Driver_Name), " not found in path");
188         end if;
189      end if;
190
191      if Lib_Opt'Length /= 0 then
192         A := A + 1;
193         Arguments (A) := Lib_Opt;
194      end if;
195
196      A := A + 1;
197      Arguments (A) := Out_Opt;
198
199      A := A + 1;
200      Arguments (A) := Out_V;
201
202      A := A + 1;
203      Arguments (A) := Lib_Dir;
204
205      A := A + Options'Length;
206      Arguments (A - Options'Length + 1 .. A) := Options;
207
208      A := A + Objects'Length;
209      Arguments (A - Objects'Length + 1 .. A) := Objects;
210
211      A := A + Options_2'Length;
212      Arguments (A - Options_2'Length + 1 .. A) := Options_2;
213
214      if not Opt.Quiet_Output then
215         Write_Str (Driver.all);
216
217         for J in 1 .. A loop
218            Write_Char (' ');
219            Write_Str  (Arguments (J).all);
220         end loop;
221
222         Write_Eol;
223      end if;
224
225      OS_Lib.Spawn (Driver.all, Arguments (1 .. A), Success);
226
227      if not Success then
228         if Driver_Name = No_Name then
229            Fail (Gcc_Name, " execution error");
230
231         else
232            Fail (Get_Name_String (Driver_Name), " execution error");
233         end if;
234      end if;
235   end Gcc;
236
237   ----------------
238   -- Initialize --
239   ----------------
240
241   procedure Initialize is
242   begin
243      if not Initialized then
244         Initialized := True;
245
246         --  gcc
247
248         Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
249
250         if Gcc_Exec = null then
251            Fail (Gcc_Name, " not found in path");
252
253         elsif Opt.Verbose_Mode then
254            Write_Str  ("found ");
255            Write_Line (Gcc_Exec.all);
256         end if;
257
258         --  ar
259
260         Ar_Name := new String'(Archive_Builder);
261         Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name.all);
262
263         if Ar_Exec = null then
264            Fail (Ar_Name.all, " not found in path");
265
266         elsif Opt.Verbose_Mode then
267            Write_Str  ("found ");
268            Write_Line (Ar_Exec.all);
269         end if;
270
271         Ar_Options := Archive_Builder_Options;
272
273         --  ranlib
274
275         Ranlib_Name := new String'(Archive_Indexer);
276
277         if Ranlib_Name'Length > 0 then
278            Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name.all);
279
280            if Ranlib_Exec /= null and then Opt.Verbose_Mode then
281               Write_Str ("found ");
282               Write_Line (Ranlib_Exec.all);
283            end if;
284         end if;
285      end if;
286   end Initialize;
287
288   -------------------
289   -- Lib_Directory --
290   -------------------
291
292   function Lib_Directory return String is
293      Libgnat : constant String := Tgt.Libgnat;
294
295   begin
296      Name_Len := Libgnat'Length;
297      Name_Buffer (1 .. Name_Len) := Libgnat;
298      Get_Name_String (Osint.Find_File (Name_Enter, Osint.Library));
299
300      --  Remove libgnat.a
301
302      return Name_Buffer (1 .. Name_Len - Libgnat'Length);
303   end Lib_Directory;
304
305end MLib.Utl;
306