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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [gnatdll.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              G N A T D L L                               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1997-2008, 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
--  GNATDLL is a Windows specific tool for building a DLL.
27
--  Both relocatable and non-relocatable DLL's are supported
28
 
29
with Ada.Text_IO;           use Ada.Text_IO;
30
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
31
with Ada.Exceptions;        use Ada.Exceptions;
32
with Ada.Command_Line;      use Ada.Command_Line;
33
with GNAT.OS_Lib;           use GNAT.OS_Lib;
34
with GNAT.Command_Line;     use GNAT.Command_Line;
35
with Gnatvsn;
36
 
37
with MDLL.Fil;              use MDLL.Fil;
38
with MDLL.Utl;              use MDLL.Utl;
39
 
40
procedure Gnatdll is
41
 
42
   use type GNAT.OS_Lib.Argument_List;
43
 
44
   procedure Syntax;
45
   --  Print out usage
46
 
47
   procedure Check (Filename : String);
48
   --  Check that the file whose name is Filename exists
49
 
50
   procedure Parse_Command_Line;
51
   --  Parse the command line arguments passed to gnatdll
52
 
53
   procedure Check_Context;
54
   --  Check the context before running any commands to build the library
55
 
56
   Syntax_Error : exception;
57
   --  Raised when a syntax error is detected, in this case a usage info will
58
   --  be displayed.
59
 
60
   Context_Error : exception;
61
   --  Raised when some files (specified on the command line) are missing to
62
   --  build the DLL.
63
 
64
   Help : Boolean := False;
65
   --  Help will be set to True the usage information is to be displayed
66
 
67
   Version : constant String := Gnatvsn.Gnat_Version_String;
68
   --  Why should it be necessary to make a copy of this
69
 
70
   Default_DLL_Address : constant String := "0x11000000";
71
   --  Default address for non relocatable DLL (Win32)
72
 
73
   Lib_Filename : Unbounded_String := Null_Unbounded_String;
74
   --  The DLL filename that will be created (.dll)
75
 
76
   Def_Filename : Unbounded_String := Null_Unbounded_String;
77
   --  The definition filename (.def)
78
 
79
   List_Filename : Unbounded_String := Null_Unbounded_String;
80
   --  The name of the file containing the objects file to put into the DLL
81
 
82
   DLL_Address : Unbounded_String := To_Unbounded_String (Default_DLL_Address);
83
   --  The DLL's base address
84
 
85
   Gen_Map_File : Boolean := False;
86
   --  Set to True if a map file is to be generated
87
 
88
   Objects_Files : Argument_List_Access := MDLL.Null_Argument_List_Access;
89
   --  List of objects to put inside the library
90
 
91
   Ali_Files : Argument_List_Access := MDLL.Null_Argument_List_Access;
92
   --  For each Ada file specified, we keep a record of the corresponding
93
   --  ALI file. This list of SLI files is used to build the binder program.
94
 
95
   Options : Argument_List_Access := MDLL.Null_Argument_List_Access;
96
   --  A list of options set in the command line
97
 
98
   Largs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access;
99
   Bargs_Options : Argument_List_Access := MDLL.Null_Argument_List_Access;
100
   --  GNAT linker and binder args options
101
 
102
   type Build_Mode_State is (Import_Lib, Dynamic_Lib, Dynamic_Lib_Only, Nil);
103
   --  Import_Lib means only the .a file will be created, Dynamic_Lib means
104
   --  that both the DLL and the import library will be created.
105
   --  Dynamic_Lib_Only means that only the DLL will be created (no import
106
   --  library).
107
 
108
   Build_Mode : Build_Mode_State := Nil;
109
   --  Will be set when parsing the command line
110
 
111
   Must_Build_Relocatable : Boolean := True;
112
   --  True means build a relocatable DLL, will be set to False if a
113
   --  non-relocatable DLL must be built.
114
 
115
   ------------
116
   -- Syntax --
117
   ------------
118
 
119
   procedure Syntax is
120
      procedure P (Str : String) renames Put_Line;
121
   begin
122
      P ("Usage : gnatdll [options] [list-of-files]");
123
      New_Line;
124
      P ("[list-of-files] a list of Ada libraries (.ali) and/or " &
125
         "foreign object files");
126
      New_Line;
127
      P ("[options] can be");
128
      P ("   -h            Help - display this message");
129
      P ("   -v            Verbose");
130
      P ("   -q            Quiet");
131
      P ("   -k            Remove @nn suffix from exported names");
132
      P ("   -g            Generate debugging information");
133
      P ("   -Idir         Specify source and object files search path");
134
      P ("   -l file       File contains a list-of-files to be added to "
135
         & "the library");
136
      P ("   -e file       Definition file containing exports");
137
      P ("   -d file       Put objects in the relocatable dynamic "
138
         & "library <file>");
139
      P ("   -b addr       Set base address for the relocatable DLL");
140
      P ("                 default address is " & Default_DLL_Address);
141
      P ("   -a[addr]      Build non-relocatable DLL at address <addr>");
142
      P ("                 if <addr> is not specified use "
143
         & Default_DLL_Address);
144
      P ("   -m            Generate map file");
145
      P ("   -n            No-import - do not create the import library");
146
      P ("   -bargs opts   opts are passed to the binder");
147
      P ("   -largs opts   opts are passed to the linker");
148
   end Syntax;
149
 
150
   -----------
151
   -- Check --
152
   -----------
153
 
154
   procedure Check (Filename : String) is
155
   begin
156
      if not Is_Regular_File (Filename) then
157
         Raise_Exception
158
           (Context_Error'Identity, "Error: " & Filename & " not found.");
159
      end if;
160
   end Check;
161
 
162
   ------------------------
163
   -- Parse_Command_Line --
164
   ------------------------
165
 
166
   procedure Parse_Command_Line is
167
 
168
      procedure Add_File (Filename : String);
169
      --  Add one file to the list of file to handle
170
 
171
      procedure Add_Files_From_List (List_Filename : String);
172
      --  Add the files listed in List_Filename (one by line) to the list
173
      --  of file to handle
174
 
175
      Max_Files   : constant := 5_000;
176
      Max_Options : constant :=   100;
177
      --  These are arbitrary limits, a better way will be to use linked list.
178
      --  No, a better choice would be to use tables ???
179
      --  Limits on what???
180
 
181
      Ofiles : Argument_List (1 .. Max_Files);
182
      O      : Positive := Ofiles'First;
183
      --  List of object files to put in the library. O is the next entry
184
      --  to be used.
185
 
186
      Afiles : Argument_List (1 .. Max_Files);
187
      A      : Positive := Afiles'First;
188
      --  List of ALI files. A is the next entry to be used
189
 
190
      Gopts  : Argument_List (1 .. Max_Options);
191
      G      : Positive := Gopts'First;
192
      --  List of gcc options. G is the next entry to be used
193
 
194
      Lopts  : Argument_List (1 .. Max_Options);
195
      L      : Positive := Lopts'First;
196
      --  A list of -largs options (L is next entry to be used)
197
 
198
      Bopts  : Argument_List (1 .. Max_Options);
199
      B      : Positive := Bopts'First;
200
      --  A list of -bargs options (B is next entry to be used)
201
 
202
      Build_Import : Boolean := True;
203
      --  Set to False if option -n if specified (no-import)
204
 
205
      --------------
206
      -- Add_File --
207
      --------------
208
 
209
      procedure Add_File (Filename : String) is
210
      begin
211
         if Is_Ali (Filename) then
212
            Check (Filename);
213
 
214
            --  Record it to generate the binder program when
215
            --  building dynamic library
216
 
217
            Afiles (A) := new String'(Filename);
218
            A := A + 1;
219
 
220
         elsif Is_Obj (Filename) then
221
            Check (Filename);
222
 
223
            --  Just record this object file
224
 
225
            Ofiles (O) := new String'(Filename);
226
            O := O + 1;
227
 
228
         else
229
            --  Unknown file type
230
 
231
            Raise_Exception
232
              (Syntax_Error'Identity,
233
               "don't know what to do with " & Filename & " !");
234
         end if;
235
      end Add_File;
236
 
237
      -------------------------
238
      -- Add_Files_From_List --
239
      -------------------------
240
 
241
      procedure Add_Files_From_List (List_Filename : String) is
242
         File   : File_Type;
243
         Buffer : String (1 .. 500);
244
         Last   : Natural;
245
 
246
      begin
247
         Open (File, In_File, List_Filename);
248
 
249
         while not End_Of_File (File) loop
250
            Get_Line (File, Buffer, Last);
251
            Add_File (Buffer (1 .. Last));
252
         end loop;
253
 
254
         Close (File);
255
 
256
      exception
257
         when Name_Error =>
258
            Raise_Exception
259
              (Syntax_Error'Identity,
260
               "list-of-files file " & List_Filename & " not found.");
261
      end Add_Files_From_List;
262
 
263
   --  Start of processing for Parse_Command_Line
264
 
265
   begin
266
      Initialize_Option_Scan ('-', False, "bargs largs");
267
 
268
      --  scan gnatdll switches
269
 
270
      loop
271
         case Getopt ("g h v q k a? b: d: e: l: n m I:") is
272
 
273
            when ASCII.NUL =>
274
               exit;
275
 
276
            when 'h' =>
277
               Help := True;
278
 
279
            when 'g' =>
280
               Gopts (G) := new String'("-g");
281
               G := G + 1;
282
 
283
            when 'v' =>
284
 
285
               --  Turn verbose mode on
286
 
287
               MDLL.Verbose := True;
288
               if MDLL.Quiet then
289
                  Raise_Exception
290
                    (Syntax_Error'Identity,
291
                     "impossible to use -q and -v together.");
292
               end if;
293
 
294
            when 'q' =>
295
 
296
               --  Turn quiet mode on
297
 
298
               MDLL.Quiet := True;
299
               if MDLL.Verbose then
300
                  Raise_Exception
301
                    (Syntax_Error'Identity,
302
                     "impossible to use -v and -q together.");
303
               end if;
304
 
305
            when 'k' =>
306
 
307
               MDLL.Kill_Suffix := True;
308
 
309
            when 'a' =>
310
 
311
               if Parameter = "" then
312
 
313
                  --  Default address for a relocatable dynamic library.
314
                  --  address for a non relocatable dynamic library.
315
 
316
                  DLL_Address := To_Unbounded_String (Default_DLL_Address);
317
 
318
               else
319
                  DLL_Address := To_Unbounded_String (Parameter);
320
               end if;
321
 
322
               Must_Build_Relocatable := False;
323
 
324
            when 'b' =>
325
 
326
               DLL_Address := To_Unbounded_String (Parameter);
327
 
328
               Must_Build_Relocatable := True;
329
 
330
            when 'e' =>
331
 
332
               Def_Filename := To_Unbounded_String (Parameter);
333
 
334
            when 'd' =>
335
 
336
               --  Build a non relocatable DLL
337
 
338
               Lib_Filename := To_Unbounded_String (Parameter);
339
 
340
               if Def_Filename = Null_Unbounded_String then
341
                  Def_Filename := To_Unbounded_String
342
                    (Ext_To (Parameter, "def"));
343
               end if;
344
 
345
               Build_Mode := Dynamic_Lib;
346
 
347
            when 'm' =>
348
 
349
               Gen_Map_File := True;
350
 
351
            when 'n' =>
352
 
353
               Build_Import := False;
354
 
355
            when 'l' =>
356
               List_Filename := To_Unbounded_String (Parameter);
357
 
358
            when 'I' =>
359
               Gopts (G) := new String'("-I" & Parameter);
360
               G := G + 1;
361
 
362
            when others =>
363
               raise Invalid_Switch;
364
         end case;
365
      end loop;
366
 
367
      --  Get parameters
368
 
369
      loop
370
         declare
371
            File : constant String := Get_Argument (Do_Expansion => True);
372
         begin
373
            exit when File'Length = 0;
374
            Add_File (File);
375
         end;
376
      end loop;
377
 
378
      --  Get largs parameters
379
 
380
      Goto_Section ("largs");
381
 
382
      loop
383
         case Getopt ("*") is
384
            when ASCII.NUL =>
385
               exit;
386
 
387
            when others =>
388
               Lopts (L) := new String'(Full_Switch);
389
               L := L + 1;
390
         end case;
391
      end loop;
392
 
393
      --  Get bargs parameters
394
 
395
      Goto_Section ("bargs");
396
 
397
      loop
398
         case Getopt ("*") is
399
 
400
            when ASCII.NUL =>
401
               exit;
402
 
403
            when others =>
404
               Bopts (B) := new String'(Full_Switch);
405
               B := B + 1;
406
 
407
         end case;
408
      end loop;
409
 
410
      --  if list filename has been specified, parse it
411
 
412
      if List_Filename /= Null_Unbounded_String then
413
         Add_Files_From_List (To_String (List_Filename));
414
      end if;
415
 
416
      --  Check if the set of parameters are compatible
417
 
418
      if Build_Mode = Nil and then not Help and then not MDLL.Verbose then
419
         Raise_Exception (Syntax_Error'Identity, "nothing to do.");
420
      end if;
421
 
422
      --  -n option but no file specified
423
 
424
      if not Build_Import
425
        and then A = Afiles'First
426
        and then O = Ofiles'First
427
      then
428
         Raise_Exception
429
           (Syntax_Error'Identity,
430
            "-n specified but there are no objects to build the library.");
431
      end if;
432
 
433
      --  Check if we want to build an import library (option -e and
434
      --  no file specified)
435
 
436
      if Build_Mode = Dynamic_Lib
437
        and then A = Afiles'First
438
        and then O = Ofiles'First
439
      then
440
         Build_Mode := Import_Lib;
441
      end if;
442
 
443
      --  If map file is to be generated, add linker option here
444
 
445
      if Gen_Map_File and then Build_Mode = Import_Lib then
446
         Raise_Exception
447
           (Syntax_Error'Identity,
448
            "Can't generate a map file for an import library.");
449
      end if;
450
 
451
      --  Check if only a dynamic library must be built
452
 
453
      if Build_Mode = Dynamic_Lib and then not Build_Import then
454
         Build_Mode := Dynamic_Lib_Only;
455
      end if;
456
 
457
      if O /= Ofiles'First then
458
         Objects_Files := new Argument_List'(Ofiles (1 .. O - 1));
459
      end if;
460
 
461
      if A /= Afiles'First then
462
         Ali_Files     := new Argument_List'(Afiles (1 .. A - 1));
463
      end if;
464
 
465
      if G /= Gopts'First then
466
         Options       := new Argument_List'(Gopts (1 .. G - 1));
467
      end if;
468
 
469
      if L /= Lopts'First then
470
         Largs_Options := new Argument_List'(Lopts (1 .. L - 1));
471
      end if;
472
 
473
      if B /= Bopts'First then
474
         Bargs_Options := new Argument_List'(Bopts (1 .. B - 1));
475
      end if;
476
 
477
   exception
478
      when Invalid_Switch    =>
479
         Raise_Exception
480
           (Syntax_Error'Identity,
481
            Message => "Invalid Switch " & Full_Switch);
482
 
483
      when Invalid_Parameter =>
484
         Raise_Exception
485
           (Syntax_Error'Identity,
486
            Message => "No parameter for " & Full_Switch);
487
   end Parse_Command_Line;
488
 
489
   -------------------
490
   -- Check_Context --
491
   -------------------
492
 
493
   procedure Check_Context is
494
   begin
495
      Check (To_String (Def_Filename));
496
 
497
      --  Check that each object file specified exists and raise exception
498
      --  Context_Error if it does not.
499
 
500
      for F in Objects_Files'Range loop
501
         Check (Objects_Files (F).all);
502
      end loop;
503
   end Check_Context;
504
 
505
--  Start of processing for Gnatdll
506
 
507
begin
508
   if Ada.Command_Line.Argument_Count = 0 then
509
      Help := True;
510
   else
511
      Parse_Command_Line;
512
   end if;
513
 
514
   if MDLL.Verbose or else Help then
515
      New_Line;
516
      Put_Line ("GNATDLL " & Version & " - Dynamic Libraries Builder");
517
      New_Line;
518
   end if;
519
 
520
   MDLL.Utl.Locate;
521
 
522
   if Help
523
     or else (MDLL.Verbose and then Ada.Command_Line.Argument_Count = 1)
524
   then
525
      Syntax;
526
   else
527
      Check_Context;
528
 
529
      case Build_Mode is
530
         when Import_Lib =>
531
            MDLL.Build_Import_Library
532
              (To_String (Lib_Filename),
533
               To_String (Def_Filename));
534
 
535
         when Dynamic_Lib =>
536
            MDLL.Build_Dynamic_Library
537
              (Objects_Files.all,
538
               Ali_Files.all,
539
               Options.all,
540
               Bargs_Options.all,
541
               Largs_Options.all,
542
               To_String (Lib_Filename),
543
               To_String (Def_Filename),
544
               To_String (DLL_Address),
545
               Build_Import => True,
546
               Relocatable  => Must_Build_Relocatable,
547
               Map_File     => Gen_Map_File);
548
 
549
         when Dynamic_Lib_Only =>
550
            MDLL.Build_Dynamic_Library
551
              (Objects_Files.all,
552
               Ali_Files.all,
553
               Options.all,
554
               Bargs_Options.all,
555
               Largs_Options.all,
556
               To_String (Lib_Filename),
557
               To_String (Def_Filename),
558
               To_String (DLL_Address),
559
               Build_Import => False,
560
               Relocatable  => Must_Build_Relocatable,
561
               Map_File     => Gen_Map_File);
562
 
563
         when Nil =>
564
            null;
565
      end case;
566
   end if;
567
 
568
   Set_Exit_Status (Success);
569
 
570
exception
571
   when SE : Syntax_Error =>
572
      Put_Line ("Syntax error : " & Exception_Message (SE));
573
      New_Line;
574
      Syntax;
575
      Set_Exit_Status (Failure);
576
 
577
   when E : MDLL.Tools_Error | Context_Error =>
578
      Put_Line (Exception_Message (E));
579
      Set_Exit_Status (Failure);
580
 
581
   when others =>
582
      Put_Line ("gnatdll: INTERNAL ERROR. Please report");
583
      Set_Exit_Status (Failure);
584
end Gnatdll;

powered by: WebSVN 2.1.0

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