Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/mdll.adb @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- M D L L --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
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;