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