111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- M D L L --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
111
|
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 -- This package provides the core high level routines used by GNATDLL
|
|
27 -- to build Windows DLL.
|
|
28
|
|
29 with Ada.Text_IO;
|
|
30
|
|
31 with GNAT.Directory_Operations;
|
|
32 with MDLL.Utl;
|
|
33 with MDLL.Fil;
|
|
34
|
|
35 package body MDLL is
|
|
36
|
|
37 use Ada;
|
|
38 use GNAT;
|
|
39
|
|
40 -- Convention used for the library names on Windows:
|
|
41 -- DLL: <name>.dll
|
|
42 -- Import library: lib<name>.dll
|
|
43
|
|
44 function Get_Dll_Name (Lib_Filename : String) return String;
|
|
45 -- Returns <Lib_Filename> if it contains a file extension otherwise it
|
|
46 -- returns <Lib_Filename>.dll.
|
|
47
|
|
48 ---------------------------
|
|
49 -- Build_Dynamic_Library --
|
|
50 ---------------------------
|
|
51
|
|
52 procedure Build_Dynamic_Library
|
|
53 (Ofiles : Argument_List;
|
|
54 Afiles : Argument_List;
|
|
55 Options : Argument_List;
|
|
56 Bargs_Options : Argument_List;
|
|
57 Largs_Options : Argument_List;
|
|
58 Lib_Filename : String;
|
|
59 Def_Filename : String;
|
|
60 Lib_Address : String := "";
|
|
61 Build_Import : Boolean := False;
|
|
62 Relocatable : Boolean := False;
|
|
63 Map_File : Boolean := False)
|
|
64 is
|
|
65
|
|
66 use type OS_Lib.Argument_List;
|
|
67
|
|
68 Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
|
|
69
|
|
70 Def_File : aliased constant String := Def_Filename;
|
|
71 Jnk_File : aliased String := Base_Filename & ".jnk";
|
|
72 Bas_File : aliased constant String := Base_Filename & ".base";
|
|
73 Dll_File : aliased String := Get_Dll_Name (Lib_Filename);
|
|
74 Exp_File : aliased String := Base_Filename & ".exp";
|
|
75 Lib_File : aliased constant String := "lib" & Base_Filename & ".dll.a";
|
|
76
|
|
77 Bas_Opt : aliased String := "-Wl,--base-file," & Bas_File;
|
|
78 Lib_Opt : aliased String := "-mdll";
|
|
79 Out_Opt : aliased String := "-o";
|
|
80 Adr_Opt : aliased String := "-Wl,--image-base=" & Lib_Address;
|
|
81 Map_Opt : aliased String := "-Wl,-Map," & Lib_Filename & ".map";
|
|
82
|
|
83 L_Afiles : Argument_List := Afiles;
|
|
84 -- Local afiles list. This list can be reordered to ensure that the
|
|
85 -- binder ALI file is not the first entry in this list.
|
|
86
|
|
87 All_Options : constant Argument_List := Options & Largs_Options;
|
|
88
|
|
89 procedure Build_Reloc_DLL;
|
|
90 -- Build a relocatable DLL with only objects file specified. This uses
|
|
91 -- the well known five step build (see GNAT User's Guide).
|
|
92
|
|
93 procedure Ada_Build_Reloc_DLL;
|
|
94 -- Build a relocatable DLL with Ada code. This uses the well known five
|
|
95 -- step build (see GNAT User's Guide).
|
|
96
|
|
97 procedure Build_Non_Reloc_DLL;
|
|
98 -- Build a non relocatable DLL containing no Ada code
|
|
99
|
|
100 procedure Ada_Build_Non_Reloc_DLL;
|
|
101 -- Build a non relocatable DLL with Ada code
|
|
102
|
|
103 ---------------------
|
|
104 -- Build_Reloc_DLL --
|
|
105 ---------------------
|
|
106
|
|
107 procedure Build_Reloc_DLL is
|
|
108
|
|
109 Objects_Exp_File : constant OS_Lib.Argument_List :=
|
|
110 Exp_File'Unchecked_Access & Ofiles;
|
|
111 -- Objects plus the export table (.exp) file
|
|
112
|
|
113 Success : Boolean;
|
|
114 pragma Warnings (Off, Success);
|
|
115
|
|
116 begin
|
|
117 if not Quiet then
|
|
118 Text_IO.Put_Line ("building relocatable DLL...");
|
|
119 Text_IO.Put ("make " & Dll_File);
|
|
120
|
|
121 if Build_Import then
|
|
122 Text_IO.Put_Line (" and " & Lib_File);
|
|
123 else
|
|
124 Text_IO.New_Line;
|
|
125 end if;
|
|
126 end if;
|
|
127
|
|
128 -- 1) Build base file with objects files
|
|
129
|
|
130 Utl.Gcc (Output_File => Jnk_File,
|
|
131 Files => Ofiles,
|
|
132 Options => All_Options,
|
|
133 Base_File => Bas_File,
|
|
134 Build_Lib => True);
|
|
135
|
|
136 -- 2) Build exp from base file
|
|
137
|
|
138 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
139 Base_File => Bas_File,
|
|
140 Exp_Table => Exp_File,
|
|
141 Build_Import => False);
|
|
142
|
|
143 -- 3) Build base file with exp file and objects files
|
|
144
|
|
145 Utl.Gcc (Output_File => Jnk_File,
|
|
146 Files => Objects_Exp_File,
|
|
147 Options => All_Options,
|
|
148 Base_File => Bas_File,
|
|
149 Build_Lib => True);
|
|
150
|
|
151 -- 4) Build new exp from base file and the lib file (.a)
|
|
152
|
|
153 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
154 Base_File => Bas_File,
|
|
155 Exp_Table => Exp_File,
|
|
156 Build_Import => Build_Import);
|
|
157
|
|
158 -- 5) Build the dynamic library
|
|
159
|
|
160 declare
|
|
161 Params : constant OS_Lib.Argument_List :=
|
|
162 Map_Opt'Unchecked_Access &
|
|
163 Adr_Opt'Unchecked_Access & All_Options;
|
|
164 First_Param : Positive := Params'First + 1;
|
|
165
|
|
166 begin
|
|
167 if Map_File then
|
|
168 First_Param := Params'First;
|
|
169 end if;
|
|
170
|
|
171 Utl.Gcc
|
|
172 (Output_File => Dll_File,
|
|
173 Files => Objects_Exp_File,
|
|
174 Options => Params (First_Param .. Params'Last),
|
|
175 Build_Lib => True);
|
|
176 end;
|
|
177
|
|
178 OS_Lib.Delete_File (Exp_File, Success);
|
|
179 OS_Lib.Delete_File (Bas_File, Success);
|
|
180 OS_Lib.Delete_File (Jnk_File, Success);
|
|
181
|
|
182 exception
|
|
183 when others =>
|
|
184 OS_Lib.Delete_File (Exp_File, Success);
|
|
185 OS_Lib.Delete_File (Bas_File, Success);
|
|
186 OS_Lib.Delete_File (Jnk_File, Success);
|
|
187 raise;
|
|
188 end Build_Reloc_DLL;
|
|
189
|
|
190 -------------------------
|
|
191 -- Ada_Build_Reloc_DLL --
|
|
192 -------------------------
|
|
193
|
|
194 procedure Ada_Build_Reloc_DLL is
|
|
195 Success : Boolean;
|
|
196 pragma Warnings (Off, Success);
|
|
197
|
|
198 begin
|
|
199 if not Quiet then
|
|
200 Text_IO.Put_Line ("Building relocatable DLL...");
|
|
201 Text_IO.Put ("make " & Dll_File);
|
|
202
|
|
203 if Build_Import then
|
|
204 Text_IO.Put_Line (" and " & Lib_File);
|
|
205 else
|
|
206 Text_IO.New_Line;
|
|
207 end if;
|
|
208 end if;
|
|
209
|
|
210 -- 1) Build base file with objects files
|
|
211
|
|
212 Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
|
|
213
|
|
214 declare
|
|
215 Params : constant OS_Lib.Argument_List :=
|
|
216 Out_Opt'Unchecked_Access &
|
|
217 Jnk_File'Unchecked_Access &
|
|
218 Lib_Opt'Unchecked_Access &
|
|
219 Bas_Opt'Unchecked_Access &
|
|
220 Ofiles &
|
|
221 All_Options;
|
|
222 begin
|
|
223 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
|
|
224 end;
|
|
225
|
|
226 -- 2) Build exp from base file
|
|
227
|
|
228 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
229 Base_File => Bas_File,
|
|
230 Exp_Table => Exp_File,
|
|
231 Build_Import => False);
|
|
232
|
|
233 -- 3) Build base file with exp file and objects files
|
|
234
|
|
235 Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
|
|
236
|
|
237 declare
|
|
238 Params : constant OS_Lib.Argument_List :=
|
|
239 Out_Opt'Unchecked_Access &
|
|
240 Jnk_File'Unchecked_Access &
|
|
241 Lib_Opt'Unchecked_Access &
|
|
242 Bas_Opt'Unchecked_Access &
|
|
243 Exp_File'Unchecked_Access &
|
|
244 Ofiles &
|
|
245 All_Options;
|
|
246 begin
|
|
247 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
|
|
248 end;
|
|
249
|
|
250 -- 4) Build new exp from base file and the lib file (.a)
|
|
251
|
|
252 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
253 Base_File => Bas_File,
|
|
254 Exp_Table => Exp_File,
|
|
255 Build_Import => Build_Import);
|
|
256
|
|
257 -- 5) Build the dynamic library
|
|
258
|
|
259 Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
|
|
260
|
|
261 declare
|
|
262 Params : constant OS_Lib.Argument_List :=
|
|
263 Map_Opt'Unchecked_Access &
|
|
264 Out_Opt'Unchecked_Access &
|
|
265 Dll_File'Unchecked_Access &
|
|
266 Lib_Opt'Unchecked_Access &
|
|
267 Exp_File'Unchecked_Access &
|
|
268 Adr_Opt'Unchecked_Access &
|
|
269 Ofiles &
|
|
270 All_Options;
|
|
271 First_Param : Positive := Params'First + 1;
|
|
272
|
|
273 begin
|
|
274 if Map_File then
|
|
275 First_Param := Params'First;
|
|
276 end if;
|
|
277
|
|
278 Utl.Gnatlink
|
|
279 (L_Afiles (L_Afiles'Last).all,
|
|
280 Params (First_Param .. Params'Last));
|
|
281 end;
|
|
282
|
|
283 OS_Lib.Delete_File (Exp_File, Success);
|
|
284 OS_Lib.Delete_File (Bas_File, Success);
|
|
285 OS_Lib.Delete_File (Jnk_File, Success);
|
|
286
|
|
287 exception
|
|
288 when others =>
|
|
289 OS_Lib.Delete_File (Exp_File, Success);
|
|
290 OS_Lib.Delete_File (Bas_File, Success);
|
|
291 OS_Lib.Delete_File (Jnk_File, Success);
|
|
292 raise;
|
|
293 end Ada_Build_Reloc_DLL;
|
|
294
|
|
295 -------------------------
|
|
296 -- Build_Non_Reloc_DLL --
|
|
297 -------------------------
|
|
298
|
|
299 procedure Build_Non_Reloc_DLL is
|
|
300 Success : Boolean;
|
|
301 pragma Warnings (Off, Success);
|
|
302
|
|
303 begin
|
|
304 if not Quiet then
|
|
305 Text_IO.Put_Line ("building non relocatable DLL...");
|
|
306 Text_IO.Put ("make " & Dll_File &
|
|
307 " using address " & Lib_Address);
|
|
308
|
|
309 if Build_Import then
|
|
310 Text_IO.Put_Line (" and " & Lib_File);
|
|
311 else
|
|
312 Text_IO.New_Line;
|
|
313 end if;
|
|
314 end if;
|
|
315
|
|
316 -- Build exp table and the lib .a file
|
|
317
|
|
318 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
319 Exp_Table => Exp_File,
|
|
320 Build_Import => Build_Import);
|
|
321
|
|
322 -- Build the DLL
|
|
323
|
|
324 declare
|
|
325 Params : OS_Lib.Argument_List :=
|
|
326 Adr_Opt'Unchecked_Access & All_Options;
|
|
327 begin
|
|
328 if Map_File then
|
|
329 Params := Map_Opt'Unchecked_Access & Params;
|
|
330 end if;
|
|
331
|
|
332 Utl.Gcc (Output_File => Dll_File,
|
|
333 Files => Exp_File'Unchecked_Access & Ofiles,
|
|
334 Options => Params,
|
|
335 Build_Lib => True);
|
|
336 end;
|
|
337
|
|
338 OS_Lib.Delete_File (Exp_File, Success);
|
|
339
|
|
340 exception
|
|
341 when others =>
|
|
342 OS_Lib.Delete_File (Exp_File, Success);
|
|
343 raise;
|
|
344 end Build_Non_Reloc_DLL;
|
|
345
|
|
346 -----------------------------
|
|
347 -- Ada_Build_Non_Reloc_DLL --
|
|
348 -----------------------------
|
|
349
|
|
350 -- Build a non relocatable DLL with Ada code
|
|
351
|
|
352 procedure Ada_Build_Non_Reloc_DLL is
|
|
353 Success : Boolean;
|
|
354 pragma Warnings (Off, Success);
|
|
355
|
|
356 begin
|
|
357 if not Quiet then
|
|
358 Text_IO.Put_Line ("building non relocatable DLL...");
|
|
359 Text_IO.Put ("make " & Dll_File &
|
|
360 " using address " & Lib_Address);
|
|
361
|
|
362 if Build_Import then
|
|
363 Text_IO.Put_Line (" and " & Lib_File);
|
|
364 else
|
|
365 Text_IO.New_Line;
|
|
366 end if;
|
|
367 end if;
|
|
368
|
|
369 -- Build exp table and the lib .a file
|
|
370
|
|
371 Utl.Dlltool (Def_File, Dll_File, Lib_File,
|
|
372 Exp_Table => Exp_File,
|
|
373 Build_Import => Build_Import);
|
|
374
|
|
375 -- Build the DLL
|
|
376
|
|
377 Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
|
|
378
|
|
379 declare
|
|
380 Params : OS_Lib.Argument_List :=
|
|
381 Out_Opt'Unchecked_Access &
|
|
382 Dll_File'Unchecked_Access &
|
|
383 Lib_Opt'Unchecked_Access &
|
|
384 Exp_File'Unchecked_Access &
|
|
385 Adr_Opt'Unchecked_Access &
|
|
386 Ofiles &
|
|
387 All_Options;
|
|
388 begin
|
|
389 if Map_File then
|
|
390 Params := Map_Opt'Unchecked_Access & Params;
|
|
391 end if;
|
|
392
|
|
393 Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
|
|
394 end;
|
|
395
|
|
396 OS_Lib.Delete_File (Exp_File, Success);
|
|
397
|
|
398 exception
|
|
399 when others =>
|
|
400 OS_Lib.Delete_File (Exp_File, Success);
|
|
401 raise;
|
|
402 end Ada_Build_Non_Reloc_DLL;
|
|
403
|
|
404 -- Start of processing for Build_Dynamic_Library
|
|
405
|
|
406 begin
|
|
407 -- On Windows the binder file must not be in the first position in the
|
|
408 -- list. This is due to the way DLL's are built on Windows. We swap the
|
|
409 -- first ali with the last one if it is the case.
|
|
410
|
|
411 if L_Afiles'Length > 1 then
|
|
412 declare
|
|
413 Filename : constant String :=
|
|
414 Directory_Operations.Base_Name
|
|
415 (L_Afiles (L_Afiles'First).all);
|
|
416 First : constant Positive := Filename'First;
|
|
417
|
|
418 begin
|
|
419 if Filename (First .. First + 1) = "b~" then
|
|
420 L_Afiles (L_Afiles'Last) := Afiles (Afiles'First);
|
|
421 L_Afiles (L_Afiles'First) := Afiles (Afiles'Last);
|
|
422 end if;
|
|
423 end;
|
|
424 end if;
|
|
425
|
|
426 case Relocatable is
|
|
427 when True =>
|
|
428 if L_Afiles'Length = 0 then
|
|
429 Build_Reloc_DLL;
|
|
430 else
|
|
431 Ada_Build_Reloc_DLL;
|
|
432 end if;
|
|
433
|
|
434 when False =>
|
|
435 if L_Afiles'Length = 0 then
|
|
436 Build_Non_Reloc_DLL;
|
|
437 else
|
|
438 Ada_Build_Non_Reloc_DLL;
|
|
439 end if;
|
|
440 end case;
|
|
441 end Build_Dynamic_Library;
|
|
442
|
|
443 --------------------------
|
|
444 -- Build_Import_Library --
|
|
445 --------------------------
|
|
446
|
|
447 procedure Build_Import_Library
|
|
448 (Lib_Filename : String;
|
|
449 Def_Filename : String)
|
|
450 is
|
|
451 procedure Build_Import_Library (Lib_Filename : String);
|
|
452 -- Build an import library. This is to build only a .a library to link
|
|
453 -- against a DLL.
|
|
454
|
|
455 --------------------------
|
|
456 -- Build_Import_Library --
|
|
457 --------------------------
|
|
458
|
|
459 procedure Build_Import_Library (Lib_Filename : String) is
|
|
460
|
|
461 function No_Lib_Prefix (Filename : String) return String;
|
|
462 -- Return Filename without the lib prefix if present
|
|
463
|
|
464 -------------------
|
|
465 -- No_Lib_Prefix --
|
|
466 -------------------
|
|
467
|
|
468 function No_Lib_Prefix (Filename : String) return String is
|
|
469 begin
|
|
470 if Filename (Filename'First .. Filename'First + 2) = "lib" then
|
|
471 return Filename (Filename'First + 3 .. Filename'Last);
|
|
472 else
|
|
473 return Filename;
|
|
474 end if;
|
|
475 end No_Lib_Prefix;
|
|
476
|
|
477 -- Local variables
|
|
478
|
|
479 Def_File : String renames Def_Filename;
|
|
480 Dll_File : constant String := Get_Dll_Name (Lib_Filename);
|
|
481 Base_Filename : constant String :=
|
|
482 MDLL.Fil.Ext_To (No_Lib_Prefix (Lib_Filename));
|
|
483 Lib_File : constant String := "lib" & Base_Filename & ".dll.a";
|
|
484
|
|
485 -- Start of processing for Build_Import_Library
|
|
486
|
|
487 begin
|
|
488 if not Quiet then
|
|
489 Text_IO.Put_Line ("Building import library...");
|
|
490 Text_IO.Put_Line
|
|
491 ("make " & Lib_File & " to use dynamic library " & Dll_File);
|
|
492 end if;
|
|
493
|
|
494 Utl.Dlltool
|
|
495 (Def_File, Dll_File, Lib_File, Build_Import => True);
|
|
496 end Build_Import_Library;
|
|
497
|
|
498 -- Start of processing for Build_Import_Library
|
|
499
|
|
500 begin
|
|
501 Build_Import_Library (Lib_Filename);
|
|
502 end Build_Import_Library;
|
|
503
|
|
504 ------------------
|
|
505 -- Get_Dll_Name --
|
|
506 ------------------
|
|
507
|
|
508 function Get_Dll_Name (Lib_Filename : String) return String is
|
|
509 begin
|
|
510 if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
|
|
511 return Lib_Filename & ".dll";
|
|
512 else
|
|
513 return Lib_Filename;
|
|
514 end if;
|
|
515 end Get_Dll_Name;
|
|
516
|
|
517 end MDLL;
|