gcc/ada/mdll.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 M D L L                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2005 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 --  This package provides the core high level routines used by GNATDLL
  28 --  to build Windows DLL
  29
  30 with Ada.Text_IO;
  31
  32 with GNAT.Directory_Operations;
  33 with MDLL.Utl;
  34 with MDLL.Fil;
  35
  36 package body MDLL is
  37
  38    use Ada;
  39    use GNAT;
  40
  41    function Get_Dll_Name (Lib_Filename : String) return String;
  42    --  Returns <Lib_Filename> if it contains a file extension otherwise it
  43    --  returns <Lib_Filename>.dll.
  44
  45    ---------------------------
  46    -- Build_Dynamic_Library --
  47    ---------------------------
  48
  49    procedure Build_Dynamic_Library
  50      (Ofiles        : Argument_List;
  51       Afiles        : Argument_List;
  52       Options       : Argument_List;
  53       Bargs_Options : Argument_List;
  54       Largs_Options : Argument_List;
  55       Lib_Filename  : String;
  56       Def_Filename  : String;
  57       Lib_Address   : String  := "";
  58       Build_Import  : Boolean := False;
  59       Relocatable   : Boolean := False;
  60       Map_File      : Boolean := False)
  61    is
  62
  63       use type OS_Lib.Argument_List;
  64
  65       Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
  66
  67       Def_File : aliased constant String := Def_Filename;
  68       Jnk_File : aliased          String := Base_Filename & ".jnk";
  69       Bas_File : aliased constant String := Base_Filename & ".base";
  70       Dll_File : aliased          String := Get_Dll_Name (Lib_Filename);
  71       Exp_File : aliased          String := Base_Filename & ".exp";
  72       Lib_File : aliased constant String := "lib" & Base_Filename & ".a";
  73
  74       Bas_Opt  : aliased String := "-Wl,--base-file," & Bas_File;
  75       Lib_Opt  : aliased String := "-mdll";
  76       Out_Opt  : aliased String := "-o";
  77       Adr_Opt  : aliased String := "-Wl,--image-base=" & Lib_Address;
  78       Map_Opt  : aliased String := "-Wl,-Map," & Lib_Filename & ".map";
  79
  80       L_Afiles : Argument_List := Afiles;
  81       --  Local afiles list. This list can be reordered to ensure that the
  82       --  binder ALI file is not the first entry in this list.
  83
  84       All_Options : constant Argument_List := Options & Largs_Options;
  85
  86       procedure Build_Reloc_DLL;
  87       --  Build a relocatable DLL with only objects file specified. This uses
  88       --  the well known five step build (see GNAT User's Guide).
  89
  90       procedure Ada_Build_Reloc_DLL;
  91       --  Build a relocatable DLL with Ada code. This uses the well known five
  92       --  step build (see GNAT User's Guide).
  93
  94       procedure Build_Non_Reloc_DLL;
  95       --  Build a non relocatable DLL containing no Ada code
  96
  97       procedure Ada_Build_Non_Reloc_DLL;
  98       --  Build a non relocatable DLL with Ada code
  99
 100       ---------------------
 101       -- Build_Reloc_DLL --
 102       ---------------------
 103
 104       procedure Build_Reloc_DLL is
 105
 106          Objects_Exp_File : constant OS_Lib.Argument_List :=
 107                               Exp_File'Unchecked_Access & Ofiles;
 108          --  Objects plus the export table (.exp) file
 109
 110          Success : Boolean;
 111
 112       begin
 113          if not Quiet then
 114             Text_IO.Put_Line ("building relocatable DLL...");
 115             Text_IO.Put ("make " & Dll_File);
 116
 117             if Build_Import then
 118                Text_IO.Put_Line (" and " & Lib_File);
 119             else
 120                Text_IO.New_Line;
 121             end if;
 122          end if;
 123
 124          --  1) Build base file with objects files
 125
 126          Utl.Gcc (Output_File => Jnk_File,
 127                   Files       => Ofiles,
 128                   Options     => All_Options,
 129                   Base_File   => Bas_File,
 130                   Build_Lib   => True);
 131
 132          --  2) Build exp from base file
 133
 134          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 135                       Base_File    => Bas_File,
 136                       Exp_Table    => Exp_File,
 137                       Build_Import => False);
 138
 139          --  3) Build base file with exp file and objects files
 140
 141          Utl.Gcc (Output_File => Jnk_File,
 142                   Files       => Objects_Exp_File,
 143                   Options     => All_Options,
 144                   Base_File   => Bas_File,
 145                   Build_Lib   => True);
 146
 147          --  4) Build new exp from base file and the lib file (.a)
 148
 149          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 150                       Base_File    => Bas_File,
 151                       Exp_Table    => Exp_File,
 152                       Build_Import => Build_Import);
 153
 154          --  5) Build the dynamic library
 155
 156          declare
 157             Params : OS_Lib.Argument_List :=
 158                        Adr_Opt'Unchecked_Access & All_Options;
 159
 160          begin
 161             if Map_File then
 162                Params := Map_Opt'Unchecked_Access & Params;
 163             end if;
 164
 165             Utl.Gcc
 166               (Output_File => Dll_File,
 167                Files       => Objects_Exp_File,
 168                Options     => Params,
 169                Build_Lib   => True);
 170          end;
 171
 172          OS_Lib.Delete_File (Exp_File, Success);
 173          OS_Lib.Delete_File (Bas_File, Success);
 174          OS_Lib.Delete_File (Jnk_File, Success);
 175
 176       exception
 177          when others =>
 178             OS_Lib.Delete_File (Exp_File, Success);
 179             OS_Lib.Delete_File (Bas_File, Success);
 180             OS_Lib.Delete_File (Jnk_File, Success);
 181             raise;
 182       end Build_Reloc_DLL;
 183
 184       -------------------------
 185       -- Ada_Build_Reloc_DLL --
 186       -------------------------
 187
 188       procedure Ada_Build_Reloc_DLL is
 189          Success : Boolean;
 190
 191       begin
 192          if not Quiet then
 193             Text_IO.Put_Line ("Building relocatable DLL...");
 194             Text_IO.Put ("make " & Dll_File);
 195
 196             if Build_Import then
 197                Text_IO.Put_Line (" and " & Lib_File);
 198             else
 199                Text_IO.New_Line;
 200             end if;
 201          end if;
 202
 203          --  1) Build base file with objects files
 204
 205          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 206
 207          declare
 208             Params : constant OS_Lib.Argument_List :=
 209                        Out_Opt'Unchecked_Access &
 210                        Jnk_File'Unchecked_Access &
 211                        Lib_Opt'Unchecked_Access &
 212                        Bas_Opt'Unchecked_Access &
 213                        Ofiles &
 214                        All_Options;
 215          begin
 216             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 217          end;
 218
 219          --  2) Build exp from base file
 220
 221          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 222                       Base_File    => Bas_File,
 223                       Exp_Table    => Exp_File,
 224                       Build_Import => False);
 225
 226          --  3) Build base file with exp file and objects files
 227
 228          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 229
 230          declare
 231             Params : constant OS_Lib.Argument_List :=
 232                        Out_Opt'Unchecked_Access &
 233                        Jnk_File'Unchecked_Access &
 234                        Lib_Opt'Unchecked_Access &
 235                        Bas_Opt'Unchecked_Access &
 236                        Exp_File'Unchecked_Access &
 237                        Ofiles &
 238                        All_Options;
 239          begin
 240             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 241          end;
 242
 243          --  4) Build new exp from base file and the lib file (.a)
 244
 245          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 246                       Base_File    => Bas_File,
 247                       Exp_Table    => Exp_File,
 248                       Build_Import => Build_Import);
 249
 250          --  5) Build the dynamic library
 251
 252          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 253
 254          declare
 255             Params : OS_Lib.Argument_List :=
 256                        Out_Opt'Unchecked_Access &
 257                        Dll_File'Unchecked_Access &
 258                        Lib_Opt'Unchecked_Access &
 259                        Exp_File'Unchecked_Access &
 260                        Adr_Opt'Unchecked_Access &
 261                        Ofiles &
 262                        All_Options;
 263          begin
 264             if Map_File then
 265                Params := Map_Opt'Unchecked_Access & Params;
 266             end if;
 267
 268             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 269          end;
 270
 271          OS_Lib.Delete_File (Exp_File, Success);
 272          OS_Lib.Delete_File (Bas_File, Success);
 273          OS_Lib.Delete_File (Jnk_File, Success);
 274
 275       exception
 276          when others =>
 277             OS_Lib.Delete_File (Exp_File, Success);
 278             OS_Lib.Delete_File (Bas_File, Success);
 279             OS_Lib.Delete_File (Jnk_File, Success);
 280             raise;
 281       end Ada_Build_Reloc_DLL;
 282
 283       -------------------------
 284       -- Build_Non_Reloc_DLL --
 285       -------------------------
 286
 287       procedure Build_Non_Reloc_DLL is
 288          Success : Boolean;
 289
 290       begin
 291          if not Quiet then
 292             Text_IO.Put_Line ("building non relocatable DLL...");
 293             Text_IO.Put ("make " & Dll_File &
 294                          " using address " & Lib_Address);
 295
 296             if Build_Import then
 297                Text_IO.Put_Line (" and " & Lib_File);
 298             else
 299                Text_IO.New_Line;
 300             end if;
 301          end if;
 302
 303          --  Build exp table and the lib .a file
 304
 305          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 306                       Exp_Table    => Exp_File,
 307                       Build_Import => Build_Import);
 308
 309          --  Build the DLL
 310
 311          declare
 312             Params : OS_Lib.Argument_List :=
 313                        Adr_Opt'Unchecked_Access & All_Options;
 314          begin
 315             if Map_File then
 316                Params :=  Map_Opt'Unchecked_Access & Params;
 317             end if;
 318
 319             Utl.Gcc (Output_File => Dll_File,
 320                      Files       => Exp_File'Unchecked_Access & Ofiles,
 321                      Options     => Params,
 322                      Build_Lib   => True);
 323          end;
 324
 325          OS_Lib.Delete_File (Exp_File, Success);
 326
 327       exception
 328          when others =>
 329             OS_Lib.Delete_File (Exp_File, Success);
 330             raise;
 331       end Build_Non_Reloc_DLL;
 332
 333       -----------------------------
 334       -- Ada_Build_Non_Reloc_DLL --
 335       -----------------------------
 336
 337       --  Build a non relocatable DLL with Ada code
 338
 339       procedure Ada_Build_Non_Reloc_DLL is
 340          Success : Boolean;
 341
 342       begin
 343          if not Quiet then
 344             Text_IO.Put_Line ("building non relocatable DLL...");
 345             Text_IO.Put ("make " & Dll_File &
 346                          " using address " & Lib_Address);
 347
 348             if Build_Import then
 349                Text_IO.Put_Line (" and " & Lib_File);
 350             else
 351                Text_IO.New_Line;
 352             end if;
 353          end if;
 354
 355          --  Build exp table and the lib .a file
 356
 357          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 358                       Exp_Table    => Exp_File,
 359                       Build_Import => Build_Import);
 360
 361          --  Build the DLL
 362
 363          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 364
 365          declare
 366             Params : OS_Lib.Argument_List :=
 367                        Out_Opt'Unchecked_Access &
 368                        Dll_File'Unchecked_Access &
 369                        Lib_Opt'Unchecked_Access &
 370                        Exp_File'Unchecked_Access &
 371                        Adr_Opt'Unchecked_Access &
 372                        Ofiles &
 373                        All_Options;
 374          begin
 375             if Map_File then
 376                Params := Map_Opt'Unchecked_Access & Params;
 377             end if;
 378
 379             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 380          end;
 381
 382          OS_Lib.Delete_File (Exp_File, Success);
 383
 384       exception
 385          when others =>
 386             OS_Lib.Delete_File (Exp_File, Success);
 387             raise;
 388       end Ada_Build_Non_Reloc_DLL;
 389
 390    begin
 391       --  On Windows the binder file must not be in the first position in the
 392       --  list. This is due to the way DLL's are built on Windows. We swap the
 393       --  first ali with the last one if it is the case.
 394
 395       if L_Afiles'Length > 1 then
 396          declare
 397             Filename : constant String :=
 398                          Directory_Operations.Base_Name (L_Afiles (1).all);
 399             First    : constant Positive := Filename'First;
 400
 401          begin
 402             if Filename (First .. First + 1) = "b~" then
 403                L_Afiles (L_Afiles'Last) := Afiles (1);
 404                L_Afiles (1) := Afiles (Afiles'Last);
 405             end if;
 406          end;
 407       end if;
 408
 409       case Relocatable is
 410          when True =>
 411             if L_Afiles'Length = 0 then
 412                Build_Reloc_DLL;
 413             else
 414                Ada_Build_Reloc_DLL;
 415             end if;
 416
 417          when False =>
 418             if L_Afiles'Length = 0 then
 419                Build_Non_Reloc_DLL;
 420             else
 421                Ada_Build_Non_Reloc_DLL;
 422             end if;
 423       end case;
 424    end Build_Dynamic_Library;
 425
 426    --------------------------
 427    -- Build_Import_Library --
 428    --------------------------
 429
 430    procedure Build_Import_Library
 431      (Lib_Filename : String;
 432       Def_Filename : String)
 433    is
 434
 435       procedure Build_Import_Library (Lib_Filename : String);
 436       --  Build an import library. This is to build only a .a library to link
 437       --  against a DLL.
 438
 439       --------------------------
 440       -- Build_Import_Library --
 441       --------------------------
 442
 443       procedure Build_Import_Library (Lib_Filename : String) is
 444          Def_File      : String renames Def_Filename;
 445          Dll_File      : constant String := Get_Dll_Name (Lib_Filename);
 446          Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
 447          Lib_File      : constant String := "lib" & Base_Filename & ".a";
 448
 449       begin
 450          if not Quiet then
 451             Text_IO.Put_Line ("Building import library...");
 452             Text_IO.Put_Line
 453               ("make " & Lib_File & " to use dynamic library " & Dll_File);
 454          end if;
 455
 456          Utl.Dlltool
 457            (Def_File, Dll_File, Lib_File, Build_Import => True);
 458       end Build_Import_Library;
 459
 460    --  Start of processing for Build_Import_Library
 461
 462    begin
 463       --  If the library has the form lib<name>.a then the def file should be
 464       --  <name>.def and the DLL to link against <name>.dll. This is a Windows
 465       --  convention and we try as much as possible to follow the platform
 466       --  convention.
 467
 468       if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
 469          Build_Import_Library (Lib_Filename (4 .. Lib_Filename'Last));
 470       else
 471          Build_Import_Library (Lib_Filename);
 472       end if;
 473    end Build_Import_Library;
 474
 475    ------------------
 476    -- Get_Dll_Name --
 477    ------------------
 478
 479    function Get_Dll_Name (Lib_Filename : in String) return String is
 480    begin
 481       if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
 482          return Lib_Filename & ".dll";
 483       else
 484          return Lib_Filename;
 485       end if;
 486    end Get_Dll_Name;
 487
 488 end MDLL;