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