gcc/ada/mdlltool.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 --                            $Revision: 1.1 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  Interface to externals tools used to build DLL and import libraries
  30
  31 with Ada.Text_IO;
  32 with Ada.Exceptions;
  33 with Ada.Unchecked_Deallocation;
  34
  35 with Sdefault;
  36
  37 package body MDLL.Tools is
  38
  39    use Ada;
  40    use GNAT;
  41
  42    Dlltool_Name  : constant String := "dlltool";
  43    Dlltool_Exec  : OS_Lib.String_Access;
  44
  45    Gcc_Name      : constant String := "gcc";
  46    Gcc_Exec      : OS_Lib.String_Access;
  47
  48    Gnatbind_Name : constant String := "gnatbind";
  49    Gnatbind_Exec : OS_Lib.String_Access;
  50
  51    Gnatlink_Name : constant String := "gnatlink";
  52    Gnatlink_Exec : OS_Lib.String_Access;
  53
  54    procedure Free is
  55      new Ada.Unchecked_Deallocation (OS_Lib.Argument_List,
  56                                      OS_Lib.Argument_List_Access);
  57
  58    procedure Print_Command (Tool_Name : in String;
  59                             Arguments : in OS_Lib.Argument_List);
  60    --  display the command runned when in Verbose mode
  61
  62    -------------------
  63    -- Print_Command --
  64    -------------------
  65
  66    procedure Print_Command (Tool_Name : in String;
  67                             Arguments : in OS_Lib.Argument_List) is
  68    begin
  69       if Verbose then
  70          Text_IO.Put (Tool_Name);
  71          for K in Arguments'Range loop
  72             Text_IO.Put (" " & Arguments (K).all);
  73          end loop;
  74          Text_IO.New_Line;
  75       end if;
  76    end Print_Command;
  77
  78    -----------------
  79    -- Delete_File --
  80    -----------------
  81
  82    procedure Delete_File (Filename : in String) is
  83       File   : constant String := Filename & ASCII.Nul;
  84       Success : Boolean;
  85    begin
  86       OS_Lib.Delete_File (File'Address, Success);
  87    end Delete_File;
  88
  89    -------------
  90    -- Dlltool --
  91    -------------
  92
  93    procedure Dlltool (Def_Filename : in String;
  94                       DLL_Name     : in String;
  95                       Library      : in String;
  96                       Exp_Table    : in String := "";
  97                       Base_File    : in String := "";
  98                       Build_Import : in Boolean)
  99    is
 100
 101       Arguments  : OS_Lib.Argument_List (1 .. 11);
 102       A          : Positive;
 103
 104       Success    : Boolean;
 105
 106       Def_Opt    : aliased String := "--def";
 107       Def_V      : aliased String := Def_Filename;
 108       Dll_Opt    : aliased String := "--dllname";
 109       Dll_V      : aliased String := DLL_Name;
 110       Lib_Opt    : aliased String := "--output-lib";
 111       Lib_V      : aliased String := Library;
 112       Exp_Opt    : aliased String := "--output-exp";
 113       Exp_V      : aliased String := Exp_Table;
 114       Bas_Opt    : aliased String := "--base-file";
 115       Bas_V      : aliased String := Base_File;
 116       No_Suf_Opt : aliased String := "-k";
 117    begin
 118       Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
 119                              2 => Def_V'Unchecked_Access,
 120                              3 => Dll_Opt'Unchecked_Access,
 121                              4 => Dll_V'Unchecked_Access);
 122       A := 4;
 123
 124       if Kill_Suffix then
 125          A := A + 1;
 126          Arguments (A) := No_Suf_Opt'Unchecked_Access;
 127       end if;
 128
 129       if Library /= "" and then Build_Import then
 130          A := A + 1;
 131          Arguments (A) := Lib_Opt'Unchecked_Access;
 132          A := A + 1;
 133          Arguments (A) := Lib_V'Unchecked_Access;
 134       end if;
 135
 136       if Exp_Table /= "" then
 137          A := A + 1;
 138          Arguments (A) := Exp_Opt'Unchecked_Access;
 139          A := A + 1;
 140          Arguments (A) := Exp_V'Unchecked_Access;
 141       end if;
 142
 143       if Base_File /= "" then
 144          A := A + 1;
 145          Arguments (A) := Bas_Opt'Unchecked_Access;
 146          A := A + 1;
 147          Arguments (A) := Bas_V'Unchecked_Access;
 148       end if;
 149
 150       Print_Command ("dlltool", Arguments (1 .. A));
 151
 152       OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success);
 153
 154       if not Success then
 155          Exceptions.Raise_Exception (Tools_Error'Identity,
 156                                      Dlltool_Name & " execution error.");
 157       end if;
 158
 159    end Dlltool;
 160
 161    ---------
 162    -- Gcc --
 163    ---------
 164
 165    procedure Gcc (Output_File : in String;
 166                   Files       : in Argument_List;
 167                   Options     : in Argument_List;
 168                   Base_File   : in String := "";
 169                   Build_Lib   : in Boolean := False)
 170    is
 171       use Sdefault;
 172
 173       Arguments : OS_Lib.Argument_List
 174         (1 .. 5 + Files'Length + Options'Length);
 175       A         : Natural := 0;
 176
 177       Success   : Boolean;
 178       C_Opt     : aliased String := "-c";
 179       Out_Opt   : aliased String := "-o";
 180       Out_V     : aliased String := Output_File;
 181       Bas_Opt   : aliased String := "-Wl,--base-file," & Base_File;
 182       Lib_Opt   : aliased String := "-mdll";
 183       Lib_Dir   : aliased String := "-L" & Object_Dir_Default_Name.all;
 184
 185    begin
 186       A := A + 1;
 187       if Build_Lib then
 188          Arguments (A) := Lib_Opt'Unchecked_Access;
 189       else
 190          Arguments (A) := C_Opt'Unchecked_Access;
 191       end if;
 192
 193       A := A + 1;
 194       Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access,
 195                                  Out_V'Unchecked_Access,
 196                                  Lib_Dir'Unchecked_Access);
 197       A := A + 2;
 198
 199       if Base_File /= "" then
 200          A := A + 1;
 201          Arguments (A) := Bas_Opt'Unchecked_Access;
 202       end if;
 203
 204       A := A + 1;
 205       Arguments (A .. A + Files'Length - 1) := Files;
 206       A := A + Files'Length - 1;
 207
 208       if Build_Lib then
 209          A := A + 1;
 210          Arguments (A .. A + Options'Length - 1) := Options;
 211          A := A + Options'Length - 1;
 212       else
 213          declare
 214             Largs : Argument_List (Options'Range);
 215             L     : Natural := Largs'First - 1;
 216          begin
 217             for K in Options'Range loop
 218                if Options (K) (1 .. 2) /= "-l" then
 219                   L := L + 1;
 220                   Largs (L) := Options (K);
 221                end if;
 222             end loop;
 223             A := A + 1;
 224             Arguments (A .. A + L - 1) := Largs (1 .. L);
 225             A := A + L - 1;
 226          end;
 227       end if;
 228
 229       Print_Command ("gcc", Arguments (1 .. A));
 230
 231       OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success);
 232
 233       if not Success then
 234          Exceptions.Raise_Exception (Tools_Error'Identity,
 235                                      Gcc_Name & " execution error.");
 236       end if;
 237    end Gcc;
 238
 239    --------------
 240    -- Gnatbind --
 241    --------------
 242
 243    procedure Gnatbind (Alis : in Argument_List;
 244                        Args : in Argument_List := Null_Argument_List)
 245    is
 246       Arguments   : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length);
 247       Success     : Boolean;
 248
 249       No_Main_Opt : aliased String := "-n";
 250
 251    begin
 252       Arguments (1) := No_Main_Opt'Unchecked_Access;
 253       Arguments (2 .. 1 + Alis'Length) := Alis;
 254       Arguments (2 + Alis'Length .. Arguments'Last) := Args;
 255
 256       Print_Command ("gnatbind", Arguments);
 257
 258       OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success);
 259
 260       if not Success then
 261          Exceptions.Raise_Exception (Tools_Error'Identity,
 262                                      Gnatbind_Name & " execution error.");
 263       end if;
 264    end Gnatbind;
 265
 266    --------------
 267    -- Gnatlink --
 268    --------------
 269
 270    procedure Gnatlink (Ali  : in String;
 271                        Args : in Argument_List := Null_Argument_List)
 272    is
 273       Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length);
 274       Success   : Boolean;
 275
 276       Ali_Name  : aliased String := Ali;
 277
 278    begin
 279       Arguments (1) := Ali_Name'Unchecked_Access;
 280       Arguments (2 .. Arguments'Last) := Args;
 281
 282       Print_Command ("gnatlink", Arguments);
 283
 284       OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success);
 285
 286       if not Success then
 287          Exceptions.Raise_Exception (Tools_Error'Identity,
 288                                      Gnatlink_Name & " execution error.");
 289       end if;
 290    end Gnatlink;
 291
 292    ------------
 293    -- Locate --
 294    ------------
 295
 296    procedure Locate is
 297       use type OS_Lib.String_Access;
 298    begin
 299       --  dlltool
 300
 301       Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name);
 302
 303       if Dlltool_Exec = null then
 304          Exceptions.Raise_Exception (Tools_Error'Identity,
 305                                      Dlltool_Name & " not found in path");
 306       elsif Verbose then
 307          Text_IO.Put_Line ("using " & Dlltool_Exec.all);
 308       end if;
 309
 310       --  gcc
 311
 312       Gcc_Exec     := OS_Lib.Locate_Exec_On_Path (Gcc_Name);
 313
 314       if Gcc_Exec = null then
 315          Exceptions.Raise_Exception (Tools_Error'Identity,
 316                                      Gcc_Name & " not found in path");
 317       elsif Verbose then
 318          Text_IO.Put_Line ("using " & Gcc_Exec.all);
 319       end if;
 320
 321       --  gnatbind
 322
 323       Gnatbind_Exec     := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name);
 324
 325       if Gnatbind_Exec = null then
 326          Exceptions.Raise_Exception (Tools_Error'Identity,
 327                                      Gnatbind_Name & " not found in path");
 328       elsif Verbose then
 329          Text_IO.Put_Line ("using " & Gnatbind_Exec.all);
 330       end if;
 331
 332       --  gnatlink
 333
 334       Gnatlink_Exec     := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name);
 335
 336       if Gnatlink_Exec = null then
 337          Exceptions.Raise_Exception (Tools_Error'Identity,
 338                                      Gnatlink_Name & " not found in path");
 339       elsif Verbose then
 340          Text_IO.Put_Line ("using " & Gnatlink_Exec.all);
 341          Text_IO.New_Line;
 342       end if;
 343
 344    end Locate;
 345
 346 end MDLL.Tools;