OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [ada/] [mdll.adb] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                                 M D L L                                  --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1992-2007, 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.