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-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 --  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      : constant OS_Lib.Argument_List :=
 158                             Map_Opt'Unchecked_Access &
 159                             Adr_Opt'Unchecked_Access & All_Options;
 160             First_Param : Positive := Params'First + 1;
 161
 162          begin
 163             if Map_File then
 164                First_Param := Params'First;
 165             end if;
 166
 167             Utl.Gcc
 168               (Output_File => Dll_File,
 169                Files       => Objects_Exp_File,
 170                Options     => Params (First_Param .. Params'Last),
 171                Build_Lib   => True);
 172          end;
 173
 174          OS_Lib.Delete_File (Exp_File, Success);
 175          OS_Lib.Delete_File (Bas_File, Success);
 176          OS_Lib.Delete_File (Jnk_File, Success);
 177
 178       exception
 179          when others =>
 180             OS_Lib.Delete_File (Exp_File, Success);
 181             OS_Lib.Delete_File (Bas_File, Success);
 182             OS_Lib.Delete_File (Jnk_File, Success);
 183             raise;
 184       end Build_Reloc_DLL;
 185
 186       -------------------------
 187       -- Ada_Build_Reloc_DLL --
 188       -------------------------
 189
 190       procedure Ada_Build_Reloc_DLL is
 191          Success : Boolean;
 192
 193       begin
 194          if not Quiet then
 195             Text_IO.Put_Line ("Building relocatable DLL...");
 196             Text_IO.Put ("make " & Dll_File);
 197
 198             if Build_Import then
 199                Text_IO.Put_Line (" and " & Lib_File);
 200             else
 201                Text_IO.New_Line;
 202             end if;
 203          end if;
 204
 205          --  1) Build base file with objects files
 206
 207          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 208
 209          declare
 210             Params : constant OS_Lib.Argument_List :=
 211                        Out_Opt'Unchecked_Access &
 212                        Jnk_File'Unchecked_Access &
 213                        Lib_Opt'Unchecked_Access &
 214                        Bas_Opt'Unchecked_Access &
 215                        Ofiles &
 216                        All_Options;
 217          begin
 218             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 219          end;
 220
 221          --  2) Build exp from base file
 222
 223          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 224                       Base_File    => Bas_File,
 225                       Exp_Table    => Exp_File,
 226                       Build_Import => False);
 227
 228          --  3) Build base file with exp file and objects files
 229
 230          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 231
 232          declare
 233             Params : constant OS_Lib.Argument_List :=
 234                        Out_Opt'Unchecked_Access &
 235                        Jnk_File'Unchecked_Access &
 236                        Lib_Opt'Unchecked_Access &
 237                        Bas_Opt'Unchecked_Access &
 238                        Exp_File'Unchecked_Access &
 239                        Ofiles &
 240                        All_Options;
 241          begin
 242             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 243          end;
 244
 245          --  4) Build new exp from base file and the lib file (.a)
 246
 247          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 248                       Base_File    => Bas_File,
 249                       Exp_Table    => Exp_File,
 250                       Build_Import => Build_Import);
 251
 252          --  5) Build the dynamic library
 253
 254          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 255
 256          declare
 257             Params      : constant OS_Lib.Argument_List :=
 258                             Map_Opt'Unchecked_Access &
 259                             Out_Opt'Unchecked_Access &
 260                             Dll_File'Unchecked_Access &
 261                             Lib_Opt'Unchecked_Access &
 262                             Exp_File'Unchecked_Access &
 263                             Adr_Opt'Unchecked_Access &
 264                             Ofiles &
 265                             All_Options;
 266             First_Param : Positive := Params'First + 1;
 267
 268          begin
 269             if Map_File then
 270                First_Param := Params'First;
 271             end if;
 272
 273             Utl.Gnatlink
 274               (L_Afiles (L_Afiles'Last).all,
 275                Params (First_Param .. Params'Last));
 276          end;
 277
 278          OS_Lib.Delete_File (Exp_File, Success);
 279          OS_Lib.Delete_File (Bas_File, Success);
 280          OS_Lib.Delete_File (Jnk_File, Success);
 281
 282       exception
 283          when others =>
 284             OS_Lib.Delete_File (Exp_File, Success);
 285             OS_Lib.Delete_File (Bas_File, Success);
 286             OS_Lib.Delete_File (Jnk_File, Success);
 287             raise;
 288       end Ada_Build_Reloc_DLL;
 289
 290       -------------------------
 291       -- Build_Non_Reloc_DLL --
 292       -------------------------
 293
 294       procedure Build_Non_Reloc_DLL is
 295          Success : Boolean;
 296
 297       begin
 298          if not Quiet then
 299             Text_IO.Put_Line ("building non relocatable DLL...");
 300             Text_IO.Put ("make " & Dll_File &
 301                          " using address " & Lib_Address);
 302
 303             if Build_Import then
 304                Text_IO.Put_Line (" and " & Lib_File);
 305             else
 306                Text_IO.New_Line;
 307             end if;
 308          end if;
 309
 310          --  Build exp table and the lib .a file
 311
 312          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 313                       Exp_Table    => Exp_File,
 314                       Build_Import => Build_Import);
 315
 316          --  Build the DLL
 317
 318          declare
 319             Params : OS_Lib.Argument_List :=
 320                        Adr_Opt'Unchecked_Access & All_Options;
 321          begin
 322             if Map_File then
 323                Params :=  Map_Opt'Unchecked_Access & Params;
 324             end if;
 325
 326             Utl.Gcc (Output_File => Dll_File,
 327                      Files       => Exp_File'Unchecked_Access & Ofiles,
 328                      Options     => Params,
 329                      Build_Lib   => True);
 330          end;
 331
 332          OS_Lib.Delete_File (Exp_File, Success);
 333
 334       exception
 335          when others =>
 336             OS_Lib.Delete_File (Exp_File, Success);
 337             raise;
 338       end Build_Non_Reloc_DLL;
 339
 340       -----------------------------
 341       -- Ada_Build_Non_Reloc_DLL --
 342       -----------------------------
 343
 344       --  Build a non relocatable DLL with Ada code
 345
 346       procedure Ada_Build_Non_Reloc_DLL is
 347          Success : Boolean;
 348
 349       begin
 350          if not Quiet then
 351             Text_IO.Put_Line ("building non relocatable DLL...");
 352             Text_IO.Put ("make " & Dll_File &
 353                          " using address " & Lib_Address);
 354
 355             if Build_Import then
 356                Text_IO.Put_Line (" and " & Lib_File);
 357             else
 358                Text_IO.New_Line;
 359             end if;
 360          end if;
 361
 362          --  Build exp table and the lib .a file
 363
 364          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 365                       Exp_Table    => Exp_File,
 366                       Build_Import => Build_Import);
 367
 368          --  Build the DLL
 369
 370          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 371
 372          declare
 373             Params : OS_Lib.Argument_List :=
 374                        Out_Opt'Unchecked_Access &
 375                        Dll_File'Unchecked_Access &
 376                        Lib_Opt'Unchecked_Access &
 377                        Exp_File'Unchecked_Access &
 378                        Adr_Opt'Unchecked_Access &
 379                        Ofiles &
 380                        All_Options;
 381          begin
 382             if Map_File then
 383                Params := Map_Opt'Unchecked_Access & Params;
 384             end if;
 385
 386             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 387          end;
 388
 389          OS_Lib.Delete_File (Exp_File, Success);
 390
 391       exception
 392          when others =>
 393             OS_Lib.Delete_File (Exp_File, Success);
 394             raise;
 395       end Ada_Build_Non_Reloc_DLL;
 396
 397    --  Start of processing for Build_Dynamic_Library
 398
 399    begin
 400       --  On Windows the binder file must not be in the first position in the
 401       --  list. This is due to the way DLL's are built on Windows. We swap the
 402       --  first ali with the last one if it is the case.
 403
 404       if L_Afiles'Length > 1 then
 405          declare
 406             Filename : constant String :=
 407                          Directory_Operations.Base_Name
 408                            (L_Afiles (L_Afiles'First).all);
 409             First    : constant Positive := Filename'First;
 410
 411          begin
 412             if Filename (First .. First + 1) = "b~" then
 413                L_Afiles (L_Afiles'Last) := Afiles (Afiles'First);
 414                L_Afiles (L_Afiles'First) := Afiles (Afiles'Last);
 415             end if;
 416          end;
 417       end if;
 418
 419       case Relocatable is
 420          when True =>
 421             if L_Afiles'Length = 0 then
 422                Build_Reloc_DLL;
 423             else
 424                Ada_Build_Reloc_DLL;
 425             end if;
 426
 427          when False =>
 428             if L_Afiles'Length = 0 then
 429                Build_Non_Reloc_DLL;
 430             else
 431                Ada_Build_Non_Reloc_DLL;
 432             end if;
 433       end case;
 434    end Build_Dynamic_Library;
 435
 436    --------------------------
 437    -- Build_Import_Library --
 438    --------------------------
 439
 440    procedure Build_Import_Library
 441      (Lib_Filename : String;
 442       Def_Filename : String)
 443    is
 444       procedure Build_Import_Library (Lib_Filename : String);
 445       --  Build an import library. This is to build only a .a library to link
 446       --  against a DLL.
 447
 448       --------------------------
 449       -- Build_Import_Library --
 450       --------------------------
 451
 452       procedure Build_Import_Library (Lib_Filename : String) is
 453          Def_File      : String renames Def_Filename;
 454          Dll_File      : constant String := Get_Dll_Name (Lib_Filename);
 455          Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
 456          Lib_File      : constant String := "lib" & Base_Filename & ".a";
 457
 458       begin
 459          if not Quiet then
 460             Text_IO.Put_Line ("Building import library...");
 461             Text_IO.Put_Line
 462               ("make " & Lib_File & " to use dynamic library " & Dll_File);
 463          end if;
 464
 465          Utl.Dlltool
 466            (Def_File, Dll_File, Lib_File, Build_Import => True);
 467       end Build_Import_Library;
 468
 469    --  Start of processing for Build_Import_Library
 470
 471    begin
 472       --  If the library has the form lib<name>.a then the def file should be
 473       --  <name>.def and the DLL to link against <name>.dll. This is a Windows
 474       --  convention and we try as much as possible to follow the platform
 475       --  convention.
 476
 477       if Lib_Filename'Length > 3
 478         and then
 479           Lib_Filename (Lib_Filename'First .. Lib_Filename'First + 2) = "lib"
 480       then
 481          Build_Import_Library
 482            (Lib_Filename (Lib_Filename'First + 3 .. Lib_Filename'Last));
 483       else
 484          Build_Import_Library (Lib_Filename);
 485       end if;
 486    end Build_Import_Library;
 487
 488    ------------------
 489    -- Get_Dll_Name --
 490    ------------------
 491
 492    function Get_Dll_Name (Lib_Filename : String) return String is
 493    begin
 494       if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
 495          return Lib_Filename & ".dll";
 496       else
 497          return Lib_Filename;
 498       end if;
 499    end Get_Dll_Name;
 500
 501 end MDLL;