gcc/ada/mdll-utl.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                            M D L L . T O O L S                           --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2008, 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 --  Interface to externals tools used to build DLL and import libraries
  27
  28 with Ada.Text_IO;
  29 with Ada.Exceptions;
  30
  31 with GNAT.Directory_Operations;
  32 with Osint;
  33
  34 package body MDLL.Utl is
  35
  36    use Ada;
  37    use GNAT;
  38
  39    Dlltool_Name  : constant String := "dlltool";
  40    Dlltool_Exec  : OS_Lib.String_Access;
  41
  42    Gcc_Name      : constant String := "gcc";
  43    Gcc_Exec      : OS_Lib.String_Access;
  44
  45    Gnatbind_Name : constant String := "gnatbind";
  46    Gnatbind_Exec : OS_Lib.String_Access;
  47
  48    Gnatlink_Name : constant String := "gnatlink";
  49    Gnatlink_Exec : OS_Lib.String_Access;
  50
  51    procedure Print_Command
  52      (Tool_Name : String;
  53       Arguments : OS_Lib.Argument_List);
  54    --  display the command run when in Verbose mode
  55
  56    -------------------
  57    -- Print_Command --
  58    -------------------
  59
  60    procedure Print_Command
  61      (Tool_Name : String;
  62       Arguments : OS_Lib.Argument_List)
  63    is
  64    begin
  65       if Verbose then
  66          Text_IO.Put (Tool_Name);
  67          for K in Arguments'Range loop
  68             Text_IO.Put (" " & Arguments (K).all);
  69          end loop;
  70          Text_IO.New_Line;
  71       end if;
  72    end Print_Command;
  73
  74    -------------
  75    -- Dlltool --
  76    -------------
  77
  78    procedure Dlltool
  79      (Def_Filename : String;
  80       DLL_Name     : String;
  81       Library      : String;
  82       Exp_Table    : String := "";
  83       Base_File    : String := "";
  84       Build_Import : Boolean)
  85    is
  86       Arguments  : OS_Lib.Argument_List (1 .. 11);
  87       A          : Positive;
  88
  89       Success    : Boolean;
  90
  91       Def_Opt    : aliased String := "--def";
  92       Def_V      : aliased String := Def_Filename;
  93       Dll_Opt    : aliased String := "--dllname";
  94       Dll_V      : aliased String := DLL_Name;
  95       Lib_Opt    : aliased String := "--output-lib";
  96       Lib_V      : aliased String := Library;
  97       Exp_Opt    : aliased String := "--output-exp";
  98       Exp_V      : aliased String := Exp_Table;
  99       Bas_Opt    : aliased String := "--base-file";
 100       Bas_V      : aliased String := Base_File;
 101       No_Suf_Opt : aliased String := "-k";
 102
 103    begin
 104       Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
 105                              2 => Def_V'Unchecked_Access,
 106                              3 => Dll_Opt'Unchecked_Access,
 107                              4 => Dll_V'Unchecked_Access);
 108       A := 4;
 109
 110       if Kill_Suffix then
 111          A := A + 1;
 112          Arguments (A) := No_Suf_Opt'Unchecked_Access;
 113       end if;
 114
 115       if Library /= "" and then Build_Import then
 116          A := A + 1;
 117          Arguments (A) := Lib_Opt'Unchecked_Access;
 118          A := A + 1;
 119          Arguments (A) := Lib_V'Unchecked_Access;
 120       end if;
 121
 122       if Exp_Table /= "" then
 123          A := A + 1;
 124          Arguments (A) := Exp_Opt'Unchecked_Access;
 125          A := A + 1;
 126          Arguments (A) := Exp_V'Unchecked_Access;
 127       end if;
 128
 129       if Base_File /= "" then
 130          A := A + 1;
 131          Arguments (A) := Bas_Opt'Unchecked_Access;
 132          A := A + 1;
 133          Arguments (A) := Bas_V'Unchecked_Access;
 134       end if;
 135
 136       Print_Command ("dlltool", Arguments (1 .. A));
 137
 138       OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success);
 139
 140       if not Success then
 141          Exceptions.Raise_Exception
 142            (Tools_Error'Identity, Dlltool_Name & " execution error.");
 143       end if;
 144    end Dlltool;
 145
 146    ---------
 147    -- Gcc --
 148    ---------
 149
 150    procedure Gcc
 151      (Output_File : String;
 152       Files       : Argument_List;
 153       Options     : Argument_List;
 154       Base_File   : String := "";
 155       Build_Lib   : Boolean := False)
 156    is
 157       use Osint;
 158
 159       Arguments : OS_Lib.Argument_List
 160         (1 .. 5 + Files'Length + Options'Length);
 161       A         : Natural := 0;
 162
 163       Success   : Boolean;
 164       C_Opt     : aliased String := "-c";
 165       Out_Opt   : aliased String := "-o";
 166       Out_V     : aliased String := Output_File;
 167       Bas_Opt   : aliased String := "-Wl,--base-file," & Base_File;
 168       Lib_Opt   : aliased String := "-mdll";
 169       Lib_Dir   : aliased String := "-L" & Object_Dir_Default_Prefix;
 170
 171    begin
 172       A := A + 1;
 173       if Build_Lib then
 174          Arguments (A) := Lib_Opt'Unchecked_Access;
 175       else
 176          Arguments (A) := C_Opt'Unchecked_Access;
 177       end if;
 178
 179       A := A + 1;
 180       Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access,
 181                                  Out_V'Unchecked_Access,
 182                                  Lib_Dir'Unchecked_Access);
 183       A := A + 2;
 184
 185       if Base_File /= "" then
 186          A := A + 1;
 187          Arguments (A) := Bas_Opt'Unchecked_Access;
 188       end if;
 189
 190       A := A + 1;
 191       Arguments (A .. A + Files'Length - 1) := Files;
 192       A := A + Files'Length - 1;
 193
 194       if Build_Lib then
 195          A := A + 1;
 196          Arguments (A .. A + Options'Length - 1) := Options;
 197          A := A + Options'Length - 1;
 198       else
 199          declare
 200             Largs : Argument_List (Options'Range);
 201             L     : Natural := Largs'First - 1;
 202          begin
 203             for K in Options'Range loop
 204                if Options (K) (1 .. 2) /= "-l" then
 205                   L := L + 1;
 206                   Largs (L) := Options (K);
 207                end if;
 208             end loop;
 209             A := A + 1;
 210             Arguments (A .. A + L - 1) := Largs (1 .. L);
 211             A := A + L - 1;
 212          end;
 213       end if;
 214
 215       Print_Command ("gcc", Arguments (1 .. A));
 216
 217       OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
 218
 219       if not Success then
 220          Exceptions.Raise_Exception
 221            (Tools_Error'Identity, Gcc_Name & " execution error.");
 222       end if;
 223    end Gcc;
 224
 225    --------------
 226    -- Gnatbind --
 227    --------------
 228
 229    procedure Gnatbind
 230      (Alis : Argument_List;
 231       Args : Argument_List := Null_Argument_List)
 232    is
 233       Arguments   : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length);
 234       Success     : Boolean;
 235
 236       No_Main_Opt : aliased String := "-n";
 237
 238    begin
 239       Arguments (1) := No_Main_Opt'Unchecked_Access;
 240       Arguments (2 .. 1 + Alis'Length) := Alis;
 241       Arguments (2 + Alis'Length .. Arguments'Last) := Args;
 242
 243       Print_Command ("gnatbind", Arguments);
 244
 245       OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success);
 246
 247       --  Delete binder files on failure
 248
 249       if not Success then
 250          declare
 251             Base_Name : constant String :=
 252               Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali");
 253          begin
 254             OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
 255             OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
 256          end;
 257
 258          Exceptions.Raise_Exception
 259            (Tools_Error'Identity, Gnatbind_Name & " execution error.");
 260       end if;
 261    end Gnatbind;
 262
 263    --------------
 264    -- Gnatlink --
 265    --------------
 266
 267    procedure Gnatlink
 268      (Ali  : String;
 269       Args : Argument_List := Null_Argument_List)
 270    is
 271       Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length);
 272       Success   : Boolean;
 273
 274       Ali_Name  : aliased String := Ali;
 275
 276    begin
 277       Arguments (1) := Ali_Name'Unchecked_Access;
 278       Arguments (2 .. Arguments'Last) := Args;
 279
 280       Print_Command ("gnatlink", Arguments);
 281
 282       OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success);
 283
 284       if not Success then
 285          --  Delete binder files
 286          declare
 287             Base_Name : constant String :=
 288                           Directory_Operations.Base_Name (Ali, ".ali");
 289          begin
 290             OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
 291             OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
 292             OS_Lib.Delete_File ("b~" & Base_Name & ".ali", Success);
 293             OS_Lib.Delete_File ("b~" & Base_Name & ".o", Success);
 294          end;
 295
 296          Exceptions.Raise_Exception
 297            (Tools_Error'Identity, Gnatlink_Name & " execution error.");
 298       end if;
 299    end Gnatlink;
 300
 301    ------------
 302    -- Locate --
 303    ------------
 304
 305    procedure Locate is
 306       use type OS_Lib.String_Access;
 307    begin
 308       --  dlltool
 309
 310       if Dlltool_Exec = null then
 311          Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name);
 312
 313          if Dlltool_Exec = null then
 314             Exceptions.Raise_Exception
 315               (Tools_Error'Identity, Dlltool_Name & " not found in path");
 316
 317          elsif Verbose then
 318             Text_IO.Put_Line ("using " & Dlltool_Exec.all);
 319          end if;
 320       end if;
 321
 322       --  gcc
 323
 324       if Gcc_Exec = null then
 325          Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
 326
 327          if Gcc_Exec = null then
 328             Exceptions.Raise_Exception
 329               (Tools_Error'Identity, Gcc_Name & " not found in path");
 330
 331          elsif Verbose then
 332             Text_IO.Put_Line ("using " & Gcc_Exec.all);
 333          end if;
 334       end if;
 335
 336       --  gnatbind
 337
 338       if Gnatbind_Exec = null then
 339          Gnatbind_Exec := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name);
 340
 341          if Gnatbind_Exec = null then
 342             Exceptions.Raise_Exception
 343               (Tools_Error'Identity, Gnatbind_Name & " not found in path");
 344
 345          elsif Verbose then
 346             Text_IO.Put_Line ("using " & Gnatbind_Exec.all);
 347          end if;
 348       end if;
 349
 350       --  gnatlink
 351
 352       if Gnatlink_Exec = null then
 353          Gnatlink_Exec := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name);
 354
 355          if Gnatlink_Exec = null then
 356             Exceptions.Raise_Exception
 357               (Tools_Error'Identity, Gnatlink_Name & " not found in path");
 358
 359          elsif Verbose then
 360             Text_IO.Put_Line ("using " & Gnatlink_Exec.all);
 361             Text_IO.New_Line;
 362          end if;
 363       end if;
 364    end Locate;
 365
 366 end MDLL.Utl;