]>
Commit | Line | Data |
---|---|---|
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 | ||
29 | with Ada.Text_IO; | |
30 | with Ada.Exceptions; | |
84481f76 | 31 | |
fbf5a39b | 32 | with GNAT.Directory_Operations; |
84481f76 RK |
33 | with Sdefault; |
34 | ||
07fc65c4 | 35 | package 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 | 360 | end MDLL.Utl; |