annotate gcc/ada/mdll-utl.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- M D L L . T O O L S --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
kono
parents:
diff changeset
17 -- for more details. You should have received a copy of the GNU General --
kono
parents:
diff changeset
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
kono
parents:
diff changeset
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
kono
parents:
diff changeset
20 -- --
kono
parents:
diff changeset
21 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
23 -- --
kono
parents:
diff changeset
24 ------------------------------------------------------------------------------
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 -- Interface to externals tools used to build DLL and import libraries
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28 with Ada.Text_IO;
kono
parents:
diff changeset
29 with Ada.Exceptions;
kono
parents:
diff changeset
30
kono
parents:
diff changeset
31 with GNAT.Directory_Operations;
kono
parents:
diff changeset
32 with Osint;
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 package body MDLL.Utl is
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 use Ada;
kono
parents:
diff changeset
37 use GNAT;
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 Dlltool_Name : constant String := "dlltool";
kono
parents:
diff changeset
40 Dlltool_Exec : OS_Lib.String_Access;
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 Gcc_Name : constant String := "gcc";
kono
parents:
diff changeset
43 Gcc_Exec : OS_Lib.String_Access;
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 Gnatbind_Name : constant String := "gnatbind";
kono
parents:
diff changeset
46 Gnatbind_Exec : OS_Lib.String_Access;
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 Gnatlink_Name : constant String := "gnatlink";
kono
parents:
diff changeset
49 Gnatlink_Exec : OS_Lib.String_Access;
kono
parents:
diff changeset
50
kono
parents:
diff changeset
51 procedure Print_Command
kono
parents:
diff changeset
52 (Tool_Name : String;
kono
parents:
diff changeset
53 Arguments : OS_Lib.Argument_List);
kono
parents:
diff changeset
54 -- display the command run when in Verbose mode
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 -------------------
kono
parents:
diff changeset
57 -- Print_Command --
kono
parents:
diff changeset
58 -------------------
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 procedure Print_Command
kono
parents:
diff changeset
61 (Tool_Name : String;
kono
parents:
diff changeset
62 Arguments : OS_Lib.Argument_List)
kono
parents:
diff changeset
63 is
kono
parents:
diff changeset
64 begin
kono
parents:
diff changeset
65 if Verbose then
kono
parents:
diff changeset
66 Text_IO.Put (Tool_Name);
kono
parents:
diff changeset
67 for K in Arguments'Range loop
kono
parents:
diff changeset
68 Text_IO.Put (" " & Arguments (K).all);
kono
parents:
diff changeset
69 end loop;
kono
parents:
diff changeset
70 Text_IO.New_Line;
kono
parents:
diff changeset
71 end if;
kono
parents:
diff changeset
72 end Print_Command;
kono
parents:
diff changeset
73
kono
parents:
diff changeset
74 -------------
kono
parents:
diff changeset
75 -- Dlltool --
kono
parents:
diff changeset
76 -------------
kono
parents:
diff changeset
77
kono
parents:
diff changeset
78 procedure Dlltool
kono
parents:
diff changeset
79 (Def_Filename : String;
kono
parents:
diff changeset
80 DLL_Name : String;
kono
parents:
diff changeset
81 Library : String;
kono
parents:
diff changeset
82 Exp_Table : String := "";
kono
parents:
diff changeset
83 Base_File : String := "";
kono
parents:
diff changeset
84 Build_Import : Boolean)
kono
parents:
diff changeset
85 is
kono
parents:
diff changeset
86 Arguments : OS_Lib.Argument_List (1 .. 11);
kono
parents:
diff changeset
87 A : Positive;
kono
parents:
diff changeset
88
kono
parents:
diff changeset
89 Success : Boolean;
kono
parents:
diff changeset
90
kono
parents:
diff changeset
91 Def_Opt : aliased String := "--def";
kono
parents:
diff changeset
92 Def_V : aliased String := Def_Filename;
kono
parents:
diff changeset
93 Dll_Opt : aliased String := "--dllname";
kono
parents:
diff changeset
94 Dll_V : aliased String := DLL_Name;
kono
parents:
diff changeset
95 Lib_Opt : aliased String := "--output-lib";
kono
parents:
diff changeset
96 Lib_V : aliased String := Library;
kono
parents:
diff changeset
97 Exp_Opt : aliased String := "--output-exp";
kono
parents:
diff changeset
98 Exp_V : aliased String := Exp_Table;
kono
parents:
diff changeset
99 Bas_Opt : aliased String := "--base-file";
kono
parents:
diff changeset
100 Bas_V : aliased String := Base_File;
kono
parents:
diff changeset
101 No_Suf_Opt : aliased String := "-k";
kono
parents:
diff changeset
102
kono
parents:
diff changeset
103 begin
kono
parents:
diff changeset
104 Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
kono
parents:
diff changeset
105 2 => Def_V'Unchecked_Access,
kono
parents:
diff changeset
106 3 => Dll_Opt'Unchecked_Access,
kono
parents:
diff changeset
107 4 => Dll_V'Unchecked_Access);
kono
parents:
diff changeset
108 A := 4;
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 if Kill_Suffix then
kono
parents:
diff changeset
111 A := A + 1;
kono
parents:
diff changeset
112 Arguments (A) := No_Suf_Opt'Unchecked_Access;
kono
parents:
diff changeset
113 end if;
kono
parents:
diff changeset
114
kono
parents:
diff changeset
115 if Library /= "" and then Build_Import then
kono
parents:
diff changeset
116 A := A + 1;
kono
parents:
diff changeset
117 Arguments (A) := Lib_Opt'Unchecked_Access;
kono
parents:
diff changeset
118 A := A + 1;
kono
parents:
diff changeset
119 Arguments (A) := Lib_V'Unchecked_Access;
kono
parents:
diff changeset
120 end if;
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 if Exp_Table /= "" then
kono
parents:
diff changeset
123 A := A + 1;
kono
parents:
diff changeset
124 Arguments (A) := Exp_Opt'Unchecked_Access;
kono
parents:
diff changeset
125 A := A + 1;
kono
parents:
diff changeset
126 Arguments (A) := Exp_V'Unchecked_Access;
kono
parents:
diff changeset
127 end if;
kono
parents:
diff changeset
128
kono
parents:
diff changeset
129 if Base_File /= "" then
kono
parents:
diff changeset
130 A := A + 1;
kono
parents:
diff changeset
131 Arguments (A) := Bas_Opt'Unchecked_Access;
kono
parents:
diff changeset
132 A := A + 1;
kono
parents:
diff changeset
133 Arguments (A) := Bas_V'Unchecked_Access;
kono
parents:
diff changeset
134 end if;
kono
parents:
diff changeset
135
kono
parents:
diff changeset
136 Print_Command ("dlltool", Arguments (1 .. A));
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success);
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 if not Success then
kono
parents:
diff changeset
141 Exceptions.Raise_Exception
kono
parents:
diff changeset
142 (Tools_Error'Identity, Dlltool_Name & " execution error.");
kono
parents:
diff changeset
143 end if;
kono
parents:
diff changeset
144 end Dlltool;
kono
parents:
diff changeset
145
kono
parents:
diff changeset
146 ---------
kono
parents:
diff changeset
147 -- Gcc --
kono
parents:
diff changeset
148 ---------
kono
parents:
diff changeset
149
kono
parents:
diff changeset
150 procedure Gcc
kono
parents:
diff changeset
151 (Output_File : String;
kono
parents:
diff changeset
152 Files : Argument_List;
kono
parents:
diff changeset
153 Options : Argument_List;
kono
parents:
diff changeset
154 Base_File : String := "";
kono
parents:
diff changeset
155 Build_Lib : Boolean := False)
kono
parents:
diff changeset
156 is
kono
parents:
diff changeset
157 use Osint;
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 Arguments : OS_Lib.Argument_List
kono
parents:
diff changeset
160 (1 .. 5 + Files'Length + Options'Length);
kono
parents:
diff changeset
161 A : Natural := 0;
kono
parents:
diff changeset
162
kono
parents:
diff changeset
163 Success : Boolean;
kono
parents:
diff changeset
164 C_Opt : aliased String := "-c";
kono
parents:
diff changeset
165 Out_Opt : aliased String := "-o";
kono
parents:
diff changeset
166 Out_V : aliased String := Output_File;
kono
parents:
diff changeset
167 Bas_Opt : aliased String := "-Wl,--base-file," & Base_File;
kono
parents:
diff changeset
168 Lib_Opt : aliased String := "-mdll";
kono
parents:
diff changeset
169 Lib_Dir : aliased String := "-L" & Object_Dir_Default_Prefix;
kono
parents:
diff changeset
170
kono
parents:
diff changeset
171 begin
kono
parents:
diff changeset
172 A := A + 1;
kono
parents:
diff changeset
173 if Build_Lib then
kono
parents:
diff changeset
174 Arguments (A) := Lib_Opt'Unchecked_Access;
kono
parents:
diff changeset
175 else
kono
parents:
diff changeset
176 Arguments (A) := C_Opt'Unchecked_Access;
kono
parents:
diff changeset
177 end if;
kono
parents:
diff changeset
178
kono
parents:
diff changeset
179 A := A + 1;
kono
parents:
diff changeset
180 Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access,
kono
parents:
diff changeset
181 Out_V'Unchecked_Access,
kono
parents:
diff changeset
182 Lib_Dir'Unchecked_Access);
kono
parents:
diff changeset
183 A := A + 2;
kono
parents:
diff changeset
184
kono
parents:
diff changeset
185 if Base_File /= "" then
kono
parents:
diff changeset
186 A := A + 1;
kono
parents:
diff changeset
187 Arguments (A) := Bas_Opt'Unchecked_Access;
kono
parents:
diff changeset
188 end if;
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 A := A + 1;
kono
parents:
diff changeset
191 Arguments (A .. A + Files'Length - 1) := Files;
kono
parents:
diff changeset
192 A := A + Files'Length - 1;
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 if Build_Lib then
kono
parents:
diff changeset
195 A := A + 1;
kono
parents:
diff changeset
196 Arguments (A .. A + Options'Length - 1) := Options;
kono
parents:
diff changeset
197 A := A + Options'Length - 1;
kono
parents:
diff changeset
198 else
kono
parents:
diff changeset
199 declare
kono
parents:
diff changeset
200 Largs : Argument_List (Options'Range);
kono
parents:
diff changeset
201 L : Natural := Largs'First - 1;
kono
parents:
diff changeset
202 begin
kono
parents:
diff changeset
203 for K in Options'Range loop
kono
parents:
diff changeset
204 if Options (K) (1 .. 2) /= "-l" then
kono
parents:
diff changeset
205 L := L + 1;
kono
parents:
diff changeset
206 Largs (L) := Options (K);
kono
parents:
diff changeset
207 end if;
kono
parents:
diff changeset
208 end loop;
kono
parents:
diff changeset
209 A := A + 1;
kono
parents:
diff changeset
210 Arguments (A .. A + L - 1) := Largs (1 .. L);
kono
parents:
diff changeset
211 A := A + L - 1;
kono
parents:
diff changeset
212 end;
kono
parents:
diff changeset
213 end if;
kono
parents:
diff changeset
214
kono
parents:
diff changeset
215 Print_Command ("gcc", Arguments (1 .. A));
kono
parents:
diff changeset
216
kono
parents:
diff changeset
217 OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219 if not Success then
kono
parents:
diff changeset
220 Exceptions.Raise_Exception
kono
parents:
diff changeset
221 (Tools_Error'Identity, Gcc_Name & " execution error.");
kono
parents:
diff changeset
222 end if;
kono
parents:
diff changeset
223 end Gcc;
kono
parents:
diff changeset
224
kono
parents:
diff changeset
225 --------------
kono
parents:
diff changeset
226 -- Gnatbind --
kono
parents:
diff changeset
227 --------------
kono
parents:
diff changeset
228
kono
parents:
diff changeset
229 procedure Gnatbind
kono
parents:
diff changeset
230 (Alis : Argument_List;
kono
parents:
diff changeset
231 Args : Argument_List := Null_Argument_List)
kono
parents:
diff changeset
232 is
kono
parents:
diff changeset
233 Arguments : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length);
kono
parents:
diff changeset
234 Success : Boolean;
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 No_Main_Opt : aliased String := "-n";
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 begin
kono
parents:
diff changeset
239 Arguments (1) := No_Main_Opt'Unchecked_Access;
kono
parents:
diff changeset
240 Arguments (2 .. 1 + Alis'Length) := Alis;
kono
parents:
diff changeset
241 Arguments (2 + Alis'Length .. Arguments'Last) := Args;
kono
parents:
diff changeset
242
kono
parents:
diff changeset
243 Print_Command ("gnatbind", Arguments);
kono
parents:
diff changeset
244
kono
parents:
diff changeset
245 OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success);
kono
parents:
diff changeset
246
kono
parents:
diff changeset
247 -- Delete binder files on failure
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 if not Success then
kono
parents:
diff changeset
250 declare
kono
parents:
diff changeset
251 Base_Name : constant String :=
kono
parents:
diff changeset
252 Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali");
kono
parents:
diff changeset
253 begin
kono
parents:
diff changeset
254 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
kono
parents:
diff changeset
255 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
kono
parents:
diff changeset
256 end;
kono
parents:
diff changeset
257
kono
parents:
diff changeset
258 Exceptions.Raise_Exception
kono
parents:
diff changeset
259 (Tools_Error'Identity, Gnatbind_Name & " execution error.");
kono
parents:
diff changeset
260 end if;
kono
parents:
diff changeset
261 end Gnatbind;
kono
parents:
diff changeset
262
kono
parents:
diff changeset
263 --------------
kono
parents:
diff changeset
264 -- Gnatlink --
kono
parents:
diff changeset
265 --------------
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 procedure Gnatlink
kono
parents:
diff changeset
268 (Ali : String;
kono
parents:
diff changeset
269 Args : Argument_List := Null_Argument_List)
kono
parents:
diff changeset
270 is
kono
parents:
diff changeset
271 Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length);
kono
parents:
diff changeset
272 Success : Boolean;
kono
parents:
diff changeset
273
kono
parents:
diff changeset
274 Ali_Name : aliased String := Ali;
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 begin
kono
parents:
diff changeset
277 Arguments (1) := Ali_Name'Unchecked_Access;
kono
parents:
diff changeset
278 Arguments (2 .. Arguments'Last) := Args;
kono
parents:
diff changeset
279
kono
parents:
diff changeset
280 Print_Command ("gnatlink", Arguments);
kono
parents:
diff changeset
281
kono
parents:
diff changeset
282 OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success);
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 if not Success then
kono
parents:
diff changeset
285 -- Delete binder files
kono
parents:
diff changeset
286 declare
kono
parents:
diff changeset
287 Base_Name : constant String :=
kono
parents:
diff changeset
288 Directory_Operations.Base_Name (Ali, ".ali");
kono
parents:
diff changeset
289 begin
kono
parents:
diff changeset
290 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
kono
parents:
diff changeset
291 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
kono
parents:
diff changeset
292 OS_Lib.Delete_File ("b~" & Base_Name & ".ali", Success);
kono
parents:
diff changeset
293 OS_Lib.Delete_File ("b~" & Base_Name & ".o", Success);
kono
parents:
diff changeset
294 end;
kono
parents:
diff changeset
295
kono
parents:
diff changeset
296 Exceptions.Raise_Exception
kono
parents:
diff changeset
297 (Tools_Error'Identity, Gnatlink_Name & " execution error.");
kono
parents:
diff changeset
298 end if;
kono
parents:
diff changeset
299 end Gnatlink;
kono
parents:
diff changeset
300
kono
parents:
diff changeset
301 ------------
kono
parents:
diff changeset
302 -- Locate --
kono
parents:
diff changeset
303 ------------
kono
parents:
diff changeset
304
kono
parents:
diff changeset
305 procedure Locate is
kono
parents:
diff changeset
306 use type OS_Lib.String_Access;
kono
parents:
diff changeset
307 begin
kono
parents:
diff changeset
308 -- dlltool
kono
parents:
diff changeset
309
kono
parents:
diff changeset
310 if Dlltool_Exec = null then
kono
parents:
diff changeset
311 Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name);
kono
parents:
diff changeset
312
kono
parents:
diff changeset
313 if Dlltool_Exec = null then
kono
parents:
diff changeset
314 Exceptions.Raise_Exception
kono
parents:
diff changeset
315 (Tools_Error'Identity, Dlltool_Name & " not found in path");
kono
parents:
diff changeset
316
kono
parents:
diff changeset
317 elsif Verbose then
kono
parents:
diff changeset
318 Text_IO.Put_Line ("using " & Dlltool_Exec.all);
kono
parents:
diff changeset
319 end if;
kono
parents:
diff changeset
320 end if;
kono
parents:
diff changeset
321
kono
parents:
diff changeset
322 -- gcc
kono
parents:
diff changeset
323
kono
parents:
diff changeset
324 if Gcc_Exec = null then
kono
parents:
diff changeset
325 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
kono
parents:
diff changeset
326
kono
parents:
diff changeset
327 if Gcc_Exec = null then
kono
parents:
diff changeset
328 Exceptions.Raise_Exception
kono
parents:
diff changeset
329 (Tools_Error'Identity, Gcc_Name & " not found in path");
kono
parents:
diff changeset
330
kono
parents:
diff changeset
331 elsif Verbose then
kono
parents:
diff changeset
332 Text_IO.Put_Line ("using " & Gcc_Exec.all);
kono
parents:
diff changeset
333 end if;
kono
parents:
diff changeset
334 end if;
kono
parents:
diff changeset
335
kono
parents:
diff changeset
336 -- gnatbind
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 if Gnatbind_Exec = null then
kono
parents:
diff changeset
339 Gnatbind_Exec := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name);
kono
parents:
diff changeset
340
kono
parents:
diff changeset
341 if Gnatbind_Exec = null then
kono
parents:
diff changeset
342 Exceptions.Raise_Exception
kono
parents:
diff changeset
343 (Tools_Error'Identity, Gnatbind_Name & " not found in path");
kono
parents:
diff changeset
344
kono
parents:
diff changeset
345 elsif Verbose then
kono
parents:
diff changeset
346 Text_IO.Put_Line ("using " & Gnatbind_Exec.all);
kono
parents:
diff changeset
347 end if;
kono
parents:
diff changeset
348 end if;
kono
parents:
diff changeset
349
kono
parents:
diff changeset
350 -- gnatlink
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 if Gnatlink_Exec = null then
kono
parents:
diff changeset
353 Gnatlink_Exec := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name);
kono
parents:
diff changeset
354
kono
parents:
diff changeset
355 if Gnatlink_Exec = null then
kono
parents:
diff changeset
356 Exceptions.Raise_Exception
kono
parents:
diff changeset
357 (Tools_Error'Identity, Gnatlink_Name & " not found in path");
kono
parents:
diff changeset
358
kono
parents:
diff changeset
359 elsif Verbose then
kono
parents:
diff changeset
360 Text_IO.Put_Line ("using " & Gnatlink_Exec.all);
kono
parents:
diff changeset
361 Text_IO.New_Line;
kono
parents:
diff changeset
362 end if;
kono
parents:
diff changeset
363 end if;
kono
parents:
diff changeset
364 end Locate;
kono
parents:
diff changeset
365
kono
parents:
diff changeset
366 end MDLL.Utl;