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