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