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