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