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 constant String := Def_Filename;
  63       Jnk_File : aliased          String := Base_Filename & ".jnk";
  64       Bas_File : aliased constant String := Base_Filename & ".base";
  65       Dll_File : aliased          String := Base_Filename & ".dll";
  66       Exp_File : aliased          String := Base_Filename & ".exp";
  67       Lib_File : aliased constant 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 : constant OS_Lib.Argument_List :=
 191                        Out_Opt'Unchecked_Access &
 192                        Jnk_File'Unchecked_Access &
 193                        Lib_Opt'Unchecked_Access &
 194                        Bas_Opt'Unchecked_Access &
 195                        Ofiles &
 196                        All_Options;
 197          begin
 198             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 199          end;
 200
 201          --  2) Build exp from base file.
 202
 203          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 204                       Base_File    => Bas_File,
 205                       Exp_Table    => Exp_File,
 206                       Build_Import => False);
 207
 208          --  3) Build base file with exp file and 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                        Exp_File'Unchecked_Access &
 219                        Ofiles &
 220                        All_Options;
 221          begin
 222             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 223          end;
 224
 225          --  4) Build new exp from base file and the lib file (.a)
 226
 227          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 228                       Base_File    => Bas_File,
 229                       Exp_Table    => Exp_File,
 230                       Build_Import => Build_Import);
 231
 232          --  5) Build the dynamic library
 233
 234          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 235
 236          declare
 237             Params : constant OS_Lib.Argument_List :=
 238                        Out_Opt'Unchecked_Access &
 239                        Dll_File'Unchecked_Access &
 240                        Lib_Opt'Unchecked_Access &
 241                        Exp_File'Unchecked_Access &
 242                        Adr_Opt'Unchecked_Access &
 243                        Ofiles &
 244                        All_Options;
 245          begin
 246             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 247          end;
 248
 249          OS_Lib.Delete_File (Exp_File, Success);
 250          OS_Lib.Delete_File (Bas_File, Success);
 251          OS_Lib.Delete_File (Jnk_File, Success);
 252
 253       exception
 254          when others =>
 255             OS_Lib.Delete_File (Exp_File, Success);
 256             OS_Lib.Delete_File (Bas_File, Success);
 257             OS_Lib.Delete_File (Jnk_File, Success);
 258             raise;
 259       end Ada_Build_Reloc_DLL;
 260
 261       -------------------------
 262       -- Build_Non_Reloc_DLL --
 263       -------------------------
 264
 265       procedure Build_Non_Reloc_DLL is
 266          Success : Boolean;
 267       begin
 268          if not Quiet then
 269             Text_IO.Put_Line ("building non relocatable DLL...");
 270             Text_IO.Put ("make " & Dll_File &
 271                          " using address " & Lib_Address);
 272
 273             if Build_Import then
 274                Text_IO.Put_Line (" and " & Lib_File);
 275             else
 276                Text_IO.New_Line;
 277             end if;
 278          end if;
 279
 280          --  Build exp table and the lib .a file.
 281
 282          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 283                       Exp_Table    => Exp_File,
 284                       Build_Import => Build_Import);
 285
 286          --  Build the DLL
 287
 288          Utl.Gcc (Output_File => Dll_File,
 289                   Files       => Exp_File'Unchecked_Access & Ofiles,
 290                   Options     => Adr_Opt'Unchecked_Access & All_Options,
 291                   Build_Lib   => True);
 292
 293          OS_Lib.Delete_File (Exp_File, Success);
 294
 295       exception
 296          when others =>
 297             OS_Lib.Delete_File (Exp_File, Success);
 298             raise;
 299       end Build_Non_Reloc_DLL;
 300
 301       -----------------------------
 302       -- Ada_Build_Non_Reloc_DLL --
 303       -----------------------------
 304
 305       --  Build a non relocatable DLL with Ada code.
 306
 307       procedure Ada_Build_Non_Reloc_DLL is
 308          Success : Boolean;
 309       begin
 310          if not Quiet then
 311             Text_IO.Put_Line ("building non relocatable DLL...");
 312             Text_IO.Put ("make " & Dll_File &
 313                          " using address " & Lib_Address);
 314
 315             if Build_Import then
 316                Text_IO.Put_Line (" and " & Lib_File);
 317             else
 318                Text_IO.New_Line;
 319             end if;
 320          end if;
 321
 322          --  Build exp table and the lib .a file.
 323
 324          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 325                       Exp_Table    => Exp_File,
 326                       Build_Import => Build_Import);
 327
 328          --  Build the DLL
 329
 330          Utl.Gnatbind (L_Afiles, Options & Bargs_Options);
 331
 332          declare
 333             Params : constant OS_Lib.Argument_List :=
 334                        Out_Opt'Unchecked_Access &
 335                        Dll_File'Unchecked_Access &
 336                        Lib_Opt'Unchecked_Access &
 337                        Exp_File'Unchecked_Access &
 338                        Adr_Opt'Unchecked_Access &
 339                        Ofiles &
 340                        All_Options;
 341          begin
 342             Utl.Gnatlink (L_Afiles (L_Afiles'Last).all, Params);
 343          end;
 344
 345          OS_Lib.Delete_File (Exp_File, Success);
 346
 347       exception
 348          when others =>
 349             OS_Lib.Delete_File (Exp_File, Success);
 350             raise;
 351       end Ada_Build_Non_Reloc_DLL;
 352
 353    begin
 354       --  On Windows the binder file must not be in the first position
 355       --  in the list. This is due to the way DLL's are built on Windows.
 356       --  We swap the first ali with the last one if it is the case.
 357
 358       if L_Afiles'Length > 1 then
 359          declare
 360             Filename : constant String :=
 361                          Directory_Operations.Base_Name (L_Afiles (1).all);
 362             First    : constant Positive := Filename'First;
 363
 364          begin
 365             if Filename (First .. First + 1) = "b~" then
 366                L_Afiles (L_Afiles'Last) := Afiles (1);
 367                L_Afiles (1) := Afiles (Afiles'Last);
 368             end if;
 369          end;
 370       end if;
 371
 372       case Relocatable is
 373
 374          when True =>
 375             if L_Afiles'Length = 0 then
 376                Build_Reloc_DLL;
 377             else
 378                Ada_Build_Reloc_DLL;
 379             end if;
 380
 381          when False =>
 382             if L_Afiles'Length = 0 then
 383                Build_Non_Reloc_DLL;
 384             else
 385                Ada_Build_Non_Reloc_DLL;
 386             end if;
 387
 388       end case;
 389    end Build_Dynamic_Library;
 390
 391    --------------------------
 392    -- Build_Import_Library --
 393    --------------------------
 394
 395    procedure Build_Import_Library
 396      (Lib_Filename : String;
 397       Def_Filename : String)
 398    is
 399
 400       procedure Build_Import_Library (Def_Base_Filename : String);
 401       --  Build an import library.
 402       --  this is to build only a .a library to link against a DLL.
 403
 404       Base_Filename : constant String := MDLL.Fil.Ext_To (Lib_Filename);
 405
 406       --------------------------
 407       -- Build_Import_Library --
 408       --------------------------
 409
 410       procedure Build_Import_Library (Def_Base_Filename : String) is
 411
 412          Def_File : String renames Def_Filename;
 413          Dll_File : constant String := Def_Base_Filename & ".dll";
 414          Lib_File : constant String := "lib" & Base_Filename & ".a";
 415
 416       begin
 417
 418          if not Quiet then
 419             Text_IO.Put_Line ("Building import library...");
 420             Text_IO.Put_Line ("make " & Lib_File &
 421                               " to use dynamic library " & Dll_File);
 422          end if;
 423
 424          Utl.Dlltool (Def_File, Dll_File, Lib_File,
 425                       Build_Import => True);
 426       end Build_Import_Library;
 427
 428    begin
 429       --  If the library has the form lib<name>.a then the def file should
 430       --  be <name>.def and the DLL to link against <name>.dll
 431       --  this is a Windows convention and we try as much as possible to
 432       --  follow the platform convention.
 433
 434       if Lib_Filename'Length > 3 and then Lib_Filename (1 .. 3) = "lib" then
 435          Build_Import_Library (Base_Filename (4 .. Base_Filename'Last));
 436       else
 437          Build_Import_Library (Base_Filename);
 438       end if;
 439    end Build_Import_Library;
 440
 441 end MDLL;