]> gcc.gnu.org Git - gcc.git/blame - gcc/ada/mdll-utl.adb
3psoccon.ads, [...]: Files added.
[gcc.git] / gcc / ada / mdll-utl.adb
CommitLineData
84481f76
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- M D L L . T O O L S --
6-- --
7-- B o d y --
8-- --
fbf5a39b 9-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
84481f76
RK
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. --
fbf5a39b 23-- Extensive contributions were provided by Ada Core Technologies Inc. --
84481f76
RK
24-- --
25------------------------------------------------------------------------------
26
27-- Interface to externals tools used to build DLL and import libraries
28
29with Ada.Text_IO;
30with Ada.Exceptions;
84481f76 31
fbf5a39b 32with GNAT.Directory_Operations;
84481f76
RK
33with Sdefault;
34
07fc65c4 35package body MDLL.Utl is
84481f76
RK
36
37 use Ada;
38 use GNAT;
39
40 Dlltool_Name : constant String := "dlltool";
41 Dlltool_Exec : OS_Lib.String_Access;
42
43 Gcc_Name : constant String := "gcc";
44 Gcc_Exec : OS_Lib.String_Access;
45
46 Gnatbind_Name : constant String := "gnatbind";
47 Gnatbind_Exec : OS_Lib.String_Access;
48
49 Gnatlink_Name : constant String := "gnatlink";
50 Gnatlink_Exec : OS_Lib.String_Access;
51
07fc65c4
GB
52 procedure Print_Command
53 (Tool_Name : String;
54 Arguments : OS_Lib.Argument_List);
84481f76
RK
55 -- display the command runned when in Verbose mode
56
57 -------------------
58 -- Print_Command --
59 -------------------
60
07fc65c4
GB
61 procedure Print_Command
62 (Tool_Name : String;
63 Arguments : OS_Lib.Argument_List)
64 is
84481f76
RK
65 begin
66 if Verbose then
67 Text_IO.Put (Tool_Name);
68 for K in Arguments'Range loop
69 Text_IO.Put (" " & Arguments (K).all);
70 end loop;
71 Text_IO.New_Line;
72 end if;
73 end Print_Command;
74
84481f76
RK
75 -------------
76 -- Dlltool --
77 -------------
78
07fc65c4
GB
79 procedure Dlltool
80 (Def_Filename : String;
81 DLL_Name : String;
82 Library : String;
83 Exp_Table : String := "";
84 Base_File : String := "";
85 Build_Import : Boolean)
84481f76 86 is
84481f76
RK
87 Arguments : OS_Lib.Argument_List (1 .. 11);
88 A : Positive;
89
90 Success : Boolean;
91
92 Def_Opt : aliased String := "--def";
93 Def_V : aliased String := Def_Filename;
94 Dll_Opt : aliased String := "--dllname";
95 Dll_V : aliased String := DLL_Name;
96 Lib_Opt : aliased String := "--output-lib";
97 Lib_V : aliased String := Library;
98 Exp_Opt : aliased String := "--output-exp";
99 Exp_V : aliased String := Exp_Table;
100 Bas_Opt : aliased String := "--base-file";
101 Bas_V : aliased String := Base_File;
102 No_Suf_Opt : aliased String := "-k";
103 begin
104 Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
105 2 => Def_V'Unchecked_Access,
106 3 => Dll_Opt'Unchecked_Access,
107 4 => Dll_V'Unchecked_Access);
108 A := 4;
109
110 if Kill_Suffix then
111 A := A + 1;
112 Arguments (A) := No_Suf_Opt'Unchecked_Access;
113 end if;
114
115 if Library /= "" and then Build_Import then
116 A := A + 1;
117 Arguments (A) := Lib_Opt'Unchecked_Access;
118 A := A + 1;
119 Arguments (A) := Lib_V'Unchecked_Access;
120 end if;
121
122 if Exp_Table /= "" then
123 A := A + 1;
124 Arguments (A) := Exp_Opt'Unchecked_Access;
125 A := A + 1;
126 Arguments (A) := Exp_V'Unchecked_Access;
127 end if;
128
129 if Base_File /= "" then
130 A := A + 1;
131 Arguments (A) := Bas_Opt'Unchecked_Access;
132 A := A + 1;
133 Arguments (A) := Bas_V'Unchecked_Access;
134 end if;
135
136 Print_Command ("dlltool", Arguments (1 .. A));
137
138 OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success);
139
140 if not Success then
fbf5a39b
AC
141 Exceptions.Raise_Exception
142 (Tools_Error'Identity, Dlltool_Name & " execution error.");
84481f76
RK
143 end if;
144
145 end Dlltool;
146
147 ---------
148 -- Gcc --
149 ---------
150
07fc65c4
GB
151 procedure Gcc
152 (Output_File : String;
153 Files : Argument_List;
154 Options : Argument_List;
155 Base_File : String := "";
156 Build_Lib : Boolean := False)
84481f76
RK
157 is
158 use Sdefault;
159
160 Arguments : OS_Lib.Argument_List
161 (1 .. 5 + Files'Length + Options'Length);
162 A : Natural := 0;
163
164 Success : Boolean;
165 C_Opt : aliased String := "-c";
166 Out_Opt : aliased String := "-o";
167 Out_V : aliased String := Output_File;
168 Bas_Opt : aliased String := "-Wl,--base-file," & Base_File;
169 Lib_Opt : aliased String := "-mdll";
170 Lib_Dir : aliased String := "-L" & Object_Dir_Default_Name.all;
171
172 begin
173 A := A + 1;
174 if Build_Lib then
175 Arguments (A) := Lib_Opt'Unchecked_Access;
176 else
177 Arguments (A) := C_Opt'Unchecked_Access;
178 end if;
179
180 A := A + 1;
181 Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access,
182 Out_V'Unchecked_Access,
183 Lib_Dir'Unchecked_Access);
184 A := A + 2;
185
186 if Base_File /= "" then
187 A := A + 1;
188 Arguments (A) := Bas_Opt'Unchecked_Access;
189 end if;
190
191 A := A + 1;
192 Arguments (A .. A + Files'Length - 1) := Files;
193 A := A + Files'Length - 1;
194
195 if Build_Lib then
196 A := A + 1;
197 Arguments (A .. A + Options'Length - 1) := Options;
198 A := A + Options'Length - 1;
199 else
200 declare
201 Largs : Argument_List (Options'Range);
202 L : Natural := Largs'First - 1;
203 begin
204 for K in Options'Range loop
205 if Options (K) (1 .. 2) /= "-l" then
206 L := L + 1;
207 Largs (L) := Options (K);
208 end if;
209 end loop;
210 A := A + 1;
211 Arguments (A .. A + L - 1) := Largs (1 .. L);
212 A := A + L - 1;
213 end;
214 end if;
215
216 Print_Command ("gcc", Arguments (1 .. A));
217
218 OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
219
220 if not Success then
fbf5a39b
AC
221 Exceptions.Raise_Exception
222 (Tools_Error'Identity, Gcc_Name & " execution error.");
84481f76
RK
223 end if;
224 end Gcc;
225
226 --------------
227 -- Gnatbind --
228 --------------
229
07fc65c4
GB
230 procedure Gnatbind
231 (Alis : Argument_List;
232 Args : Argument_List := Null_Argument_List)
84481f76
RK
233 is
234 Arguments : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length);
235 Success : Boolean;
236
237 No_Main_Opt : aliased String := "-n";
238
239 begin
240 Arguments (1) := No_Main_Opt'Unchecked_Access;
241 Arguments (2 .. 1 + Alis'Length) := Alis;
242 Arguments (2 + Alis'Length .. Arguments'Last) := Args;
243
244 Print_Command ("gnatbind", Arguments);
245
246 OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success);
247
fbf5a39b
AC
248 -- Delete binder files on failure
249
84481f76 250 if not Success then
fbf5a39b
AC
251 declare
252 Base_Name : constant String :=
253 Directory_Operations.Base_Name (Alis (1).all, ".ali");
254 begin
255 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
256 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
257 end;
258
259 Exceptions.Raise_Exception
260 (Tools_Error'Identity, Gnatbind_Name & " execution error.");
84481f76
RK
261 end if;
262 end Gnatbind;
263
264 --------------
265 -- Gnatlink --
266 --------------
267
07fc65c4
GB
268 procedure Gnatlink
269 (Ali : String;
270 Args : Argument_List := Null_Argument_List)
84481f76
RK
271 is
272 Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length);
273 Success : Boolean;
274
275 Ali_Name : aliased String := Ali;
276
277 begin
278 Arguments (1) := Ali_Name'Unchecked_Access;
279 Arguments (2 .. Arguments'Last) := Args;
280
281 Print_Command ("gnatlink", Arguments);
282
283 OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success);
284
285 if not Success then
fbf5a39b
AC
286 -- Delete binder files
287 declare
288 Base_Name : constant String :=
289 Directory_Operations.Base_Name (Ali, ".ali");
290 begin
291 OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
292 OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
293 OS_Lib.Delete_File ("b~" & Base_Name & ".ali", Success);
294 OS_Lib.Delete_File ("b~" & Base_Name & ".o", Success);
295 end;
296
297 Exceptions.Raise_Exception
298 (Tools_Error'Identity, Gnatlink_Name & " execution error.");
84481f76
RK
299 end if;
300 end Gnatlink;
301
302 ------------
303 -- Locate --
304 ------------
305
306 procedure Locate is
307 use type OS_Lib.String_Access;
308 begin
309 -- dlltool
310
311 Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name);
312
313 if Dlltool_Exec = null then
fbf5a39b
AC
314 Exceptions.Raise_Exception
315 (Tools_Error'Identity, Dlltool_Name & " not found in path");
316
84481f76
RK
317 elsif Verbose then
318 Text_IO.Put_Line ("using " & Dlltool_Exec.all);
319 end if;
320
321 -- gcc
322
323 Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
324
325 if Gcc_Exec = null then
fbf5a39b
AC
326 Exceptions.Raise_Exception
327 (Tools_Error'Identity, Gcc_Name & " not found in path");
328
84481f76
RK
329 elsif Verbose then
330 Text_IO.Put_Line ("using " & Gcc_Exec.all);
331 end if;
332
333 -- gnatbind
334
335 Gnatbind_Exec := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name);
336
337 if Gnatbind_Exec = null then
fbf5a39b
AC
338 Exceptions.Raise_Exception
339 (Tools_Error'Identity, Gnatbind_Name & " not found in path");
340
84481f76
RK
341 elsif Verbose then
342 Text_IO.Put_Line ("using " & Gnatbind_Exec.all);
343 end if;
344
345 -- gnatlink
346
347 Gnatlink_Exec := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name);
348
349 if Gnatlink_Exec = null then
fbf5a39b
AC
350 Exceptions.Raise_Exception
351 (Tools_Error'Identity, Gnatlink_Name & " not found in path");
352
84481f76
RK
353 elsif Verbose then
354 Text_IO.Put_Line ("using " & Gnatlink_Exec.all);
355 Text_IO.New_Line;
356 end if;
357
358 end Locate;
359
07fc65c4 360end MDLL.Utl;
This page took 0.483618 seconds and 5 git commands to generate.