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