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