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