gcc/ada/gnatdll.adb

   1 ------------------------------------------------------------------------------
   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;