|
131
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- V X L I N K --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 2018, 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 3, 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 COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 pragma Ada_2012;
|
|
|
27
|
|
|
28 with Ada.Command_Line;
|
|
|
29 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
|
|
30 with Ada.Text_IO;
|
|
|
31
|
|
|
32 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
|
33 with GNAT.Expect; use GNAT.Expect;
|
|
|
34 with GNAT.OS_Lib; use GNAT.OS_Lib;
|
|
|
35
|
|
|
36 package body VxLink is
|
|
|
37
|
|
|
38 Target_Triplet : Unbounded_String := Null_Unbounded_String;
|
|
|
39 Verbose : Boolean := False;
|
|
|
40 Error_State : Boolean := False;
|
|
|
41
|
|
|
42 function Triplet return String;
|
|
|
43 -- ??? missing spec
|
|
|
44
|
|
|
45 function Which (Exe : String) return String;
|
|
|
46 -- ??? missing spec
|
|
|
47
|
|
|
48 -------------
|
|
|
49 -- Triplet --
|
|
|
50 -------------
|
|
|
51
|
|
|
52 function Triplet return String is
|
|
|
53 begin
|
|
|
54 if Target_Triplet = Null_Unbounded_String then
|
|
|
55 declare
|
|
|
56 Exe : constant String := File_Name (Ada.Command_Line.Command_Name);
|
|
|
57 begin
|
|
|
58 for J in reverse Exe'Range loop
|
|
|
59 if Exe (J) = '-' then
|
|
|
60 Target_Triplet := To_Unbounded_String (Exe (Exe'First .. J));
|
|
|
61 exit;
|
|
|
62 end if;
|
|
|
63 end loop;
|
|
|
64 end;
|
|
|
65 end if;
|
|
|
66
|
|
|
67 return To_String (Target_Triplet);
|
|
|
68 end Triplet;
|
|
|
69
|
|
|
70 -----------
|
|
|
71 -- Which --
|
|
|
72 -----------
|
|
|
73
|
|
|
74 function Which (Exe : String) return String is
|
|
|
75 Suffix : GNAT.OS_Lib.String_Access := Get_Executable_Suffix;
|
|
|
76 Basename : constant String := Exe & Suffix.all;
|
|
|
77 Path : GNAT.OS_Lib.String_Access := Getenv ("PATH");
|
|
|
78 Last : Natural := Path'First;
|
|
|
79
|
|
|
80 begin
|
|
|
81 Free (Suffix);
|
|
|
82
|
|
|
83 for J in Path'Range loop
|
|
|
84 if Path (J) = Path_Separator then
|
|
|
85 declare
|
|
|
86 Full : constant String := Normalize_Pathname
|
|
|
87 (Name => Basename,
|
|
|
88 Directory => Path (Last .. J - 1),
|
|
|
89 Resolve_Links => False,
|
|
|
90 Case_Sensitive => True);
|
|
|
91 begin
|
|
|
92 if Is_Executable_File (Full) then
|
|
|
93 Free (Path);
|
|
|
94
|
|
|
95 return Full;
|
|
|
96 end if;
|
|
|
97 end;
|
|
|
98
|
|
|
99 Last := J + 1;
|
|
|
100 end if;
|
|
|
101 end loop;
|
|
|
102
|
|
|
103 Free (Path);
|
|
|
104
|
|
|
105 return "";
|
|
|
106 end Which;
|
|
|
107
|
|
|
108 -----------------
|
|
|
109 -- Set_Verbose --
|
|
|
110 -----------------
|
|
|
111
|
|
|
112 procedure Set_Verbose (Value : Boolean) is
|
|
|
113 begin
|
|
|
114 Verbose := Value;
|
|
|
115 end Set_Verbose;
|
|
|
116
|
|
|
117 ----------------
|
|
|
118 -- Is_Verbose --
|
|
|
119 ----------------
|
|
|
120
|
|
|
121 function Is_Verbose return Boolean is
|
|
|
122 begin
|
|
|
123 return Verbose;
|
|
|
124 end Is_Verbose;
|
|
|
125
|
|
|
126 ---------------------
|
|
|
127 -- Set_Error_State --
|
|
|
128 ---------------------
|
|
|
129
|
|
|
130 procedure Set_Error_State (Message : String) is
|
|
|
131 begin
|
|
|
132 Log_Error ("Error: " & Message);
|
|
|
133 Error_State := True;
|
|
|
134 Ada.Command_Line.Set_Exit_Status (1);
|
|
|
135 end Set_Error_State;
|
|
|
136
|
|
|
137 --------------------
|
|
|
138 -- Is_Error_State --
|
|
|
139 --------------------
|
|
|
140
|
|
|
141 function Is_Error_State return Boolean is
|
|
|
142 begin
|
|
|
143 return Error_State;
|
|
|
144 end Is_Error_State;
|
|
|
145
|
|
|
146 --------------
|
|
|
147 -- Log_Info --
|
|
|
148 --------------
|
|
|
149
|
|
|
150 procedure Log_Info (S : String) is
|
|
|
151 begin
|
|
|
152 if Verbose then
|
|
|
153 Ada.Text_IO.Put_Line (S);
|
|
|
154 end if;
|
|
|
155 end Log_Info;
|
|
|
156
|
|
|
157 ---------------
|
|
|
158 -- Log_Error --
|
|
|
159 ---------------
|
|
|
160
|
|
|
161 procedure Log_Error (S : String) is
|
|
|
162 begin
|
|
|
163 Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, S);
|
|
|
164 end Log_Error;
|
|
|
165
|
|
|
166 ---------
|
|
|
167 -- Run --
|
|
|
168 ---------
|
|
|
169
|
|
|
170 procedure Run (Arguments : Arguments_List) is
|
|
|
171 Output : constant String := Run (Arguments);
|
|
|
172 begin
|
|
|
173 if not Is_Error_State then
|
|
|
174 -- In case of erroneous execution, the function version of run will
|
|
|
175 -- have already displayed the output
|
|
|
176 Ada.Text_IO.Put (Output);
|
|
|
177 end if;
|
|
|
178 end Run;
|
|
|
179
|
|
|
180 ---------
|
|
|
181 -- Run --
|
|
|
182 ---------
|
|
|
183
|
|
|
184 function Run (Arguments : Arguments_List) return String is
|
|
|
185 Args : GNAT.OS_Lib.Argument_List_Access :=
|
|
|
186 new GNAT.OS_Lib.Argument_List
|
|
|
187 (1 .. Natural (Arguments.Length) - 1);
|
|
|
188 Base : constant String := Base_Name (Arguments.First_Element);
|
|
|
189
|
|
|
190 Debug_Line : Unbounded_String;
|
|
|
191 Add_Quotes : Boolean;
|
|
|
192
|
|
|
193 begin
|
|
|
194 if Verbose then
|
|
|
195 Append (Debug_Line, Base);
|
|
|
196 end if;
|
|
|
197
|
|
|
198 for J in Arguments.First_Index + 1 .. Arguments.Last_Index loop
|
|
|
199 declare
|
|
|
200 Arg : String renames Arguments.Element (J);
|
|
|
201 begin
|
|
|
202 Args (J - 1) := new String'(Arg);
|
|
|
203
|
|
|
204 if Verbose then
|
|
|
205 Add_Quotes := False;
|
|
|
206
|
|
|
207 for K in Arg'Range loop
|
|
|
208 if Arg (K) = ' ' then
|
|
|
209 Add_Quotes := True;
|
|
|
210 exit;
|
|
|
211 end if;
|
|
|
212 end loop;
|
|
|
213
|
|
|
214 Append (Debug_Line, ' ');
|
|
|
215
|
|
|
216 if Add_Quotes then
|
|
|
217 Append (Debug_Line, '"' & Arg & '"');
|
|
|
218 else
|
|
|
219 Append (Debug_Line, Arg);
|
|
|
220 end if;
|
|
|
221 end if;
|
|
|
222 end;
|
|
|
223 end loop;
|
|
|
224
|
|
|
225 if Verbose then
|
|
|
226 Ada.Text_IO.Put_Line (To_String (Debug_Line));
|
|
|
227 end if;
|
|
|
228
|
|
|
229 declare
|
|
|
230 Status : aliased Integer := 0;
|
|
|
231 Ret : constant String :=
|
|
|
232 Get_Command_Output
|
|
|
233 (Command => Arguments.First_Element,
|
|
|
234 Arguments => Args.all,
|
|
|
235 Input => "",
|
|
|
236 Status => Status'Access,
|
|
|
237 Err_To_Out => True);
|
|
|
238
|
|
|
239 begin
|
|
|
240 GNAT.OS_Lib.Free (Args);
|
|
|
241
|
|
|
242 if Status /= 0 then
|
|
|
243 Ada.Text_IO.Put_Line (Ret);
|
|
|
244 Set_Error_State
|
|
|
245 (Base_Name (Arguments.First_Element) &
|
|
|
246 " returned" & Status'Image);
|
|
|
247 end if;
|
|
|
248
|
|
|
249 return Ret;
|
|
|
250 end;
|
|
|
251 end Run;
|
|
|
252
|
|
|
253 ---------
|
|
|
254 -- Gcc --
|
|
|
255 ---------
|
|
|
256
|
|
|
257 function Gcc return String is
|
|
|
258 begin
|
|
|
259 return Which (Triplet & "gcc");
|
|
|
260 end Gcc;
|
|
|
261
|
|
|
262 ---------
|
|
|
263 -- Gxx --
|
|
|
264 ---------
|
|
|
265
|
|
|
266 function Gxx return String is
|
|
|
267 begin
|
|
|
268 return Which (Triplet & "g++");
|
|
|
269 end Gxx;
|
|
|
270
|
|
|
271 --------
|
|
|
272 -- Nm --
|
|
|
273 --------
|
|
|
274
|
|
|
275 function Nm return String is
|
|
|
276 begin
|
|
|
277 return Which (Triplet & "nm");
|
|
|
278 end Nm;
|
|
|
279
|
|
|
280 end VxLink;
|
