diff options
Diffstat (limited to 'gcc/ada/mdlltool.adb')
| -rw-r--r-- | gcc/ada/mdlltool.adb | 346 |
1 files changed, 346 insertions, 0 deletions
diff --git a/gcc/ada/mdlltool.adb b/gcc/ada/mdlltool.adb new file mode 100644 index 00000000000..fee7218c5be --- /dev/null +++ b/gcc/ada/mdlltool.adb @@ -0,0 +1,346 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- M D L L . T O O L S -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.4 $ +-- -- +-- Copyright (C) 1992-2000 Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- Interface to externals tools used to build DLL and import libraries + +with Ada.Text_IO; +with Ada.Exceptions; +with Ada.Unchecked_Deallocation; + +with Sdefault; + +package body MDLL.Tools is + + use Ada; + use GNAT; + + Dlltool_Name : constant String := "dlltool"; + Dlltool_Exec : OS_Lib.String_Access; + + Gcc_Name : constant String := "gcc"; + Gcc_Exec : OS_Lib.String_Access; + + Gnatbind_Name : constant String := "gnatbind"; + Gnatbind_Exec : OS_Lib.String_Access; + + Gnatlink_Name : constant String := "gnatlink"; + Gnatlink_Exec : OS_Lib.String_Access; + + procedure Free is + new Ada.Unchecked_Deallocation (OS_Lib.Argument_List, + OS_Lib.Argument_List_Access); + + procedure Print_Command (Tool_Name : in String; + Arguments : in OS_Lib.Argument_List); + -- display the command runned when in Verbose mode + + ------------------- + -- Print_Command -- + ------------------- + + procedure Print_Command (Tool_Name : in String; + Arguments : in OS_Lib.Argument_List) is + begin + if Verbose then + Text_IO.Put (Tool_Name); + for K in Arguments'Range loop + Text_IO.Put (" " & Arguments (K).all); + end loop; + Text_IO.New_Line; + end if; + end Print_Command; + + ----------------- + -- Delete_File -- + ----------------- + + procedure Delete_File (Filename : in String) is + File : constant String := Filename & ASCII.Nul; + Sucess : Boolean; + begin + OS_Lib.Delete_File (File'Address, Sucess); + end Delete_File; + + ------------- + -- Dlltool -- + ------------- + + procedure Dlltool (Def_Filename : in String; + DLL_Name : in String; + Library : in String; + Exp_Table : in String := ""; + Base_File : in String := ""; + Build_Import : in Boolean) + is + + Arguments : OS_Lib.Argument_List (1 .. 11); + A : Positive; + + Success : Boolean; + + Def_Opt : aliased String := "--def"; + Def_V : aliased String := Def_Filename; + Dll_Opt : aliased String := "--dllname"; + Dll_V : aliased String := DLL_Name; + Lib_Opt : aliased String := "--output-lib"; + Lib_V : aliased String := Library; + Exp_Opt : aliased String := "--output-exp"; + Exp_V : aliased String := Exp_Table; + Bas_Opt : aliased String := "--base-file"; + Bas_V : aliased String := Base_File; + No_Suf_Opt : aliased String := "-k"; + begin + Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access, + 2 => Def_V'Unchecked_Access, + 3 => Dll_Opt'Unchecked_Access, + 4 => Dll_V'Unchecked_Access); + A := 4; + + if Kill_Suffix then + A := A + 1; + Arguments (A) := No_Suf_Opt'Unchecked_Access; + end if; + + if Library /= "" and then Build_Import then + A := A + 1; + Arguments (A) := Lib_Opt'Unchecked_Access; + A := A + 1; + Arguments (A) := Lib_V'Unchecked_Access; + end if; + + if Exp_Table /= "" then + A := A + 1; + Arguments (A) := Exp_Opt'Unchecked_Access; + A := A + 1; + Arguments (A) := Exp_V'Unchecked_Access; + end if; + + if Base_File /= "" then + A := A + 1; + Arguments (A) := Bas_Opt'Unchecked_Access; + A := A + 1; + Arguments (A) := Bas_V'Unchecked_Access; + end if; + + Print_Command ("dlltool", Arguments (1 .. A)); + + OS_Lib.Spawn (Dlltool_Exec.all, Arguments (1 .. A), Success); + + if not Success then + Exceptions.Raise_Exception (Tools_Error'Identity, + Dlltool_Name & " execution error."); + end if; + + end Dlltool; + + --------- + -- Gcc -- + --------- + + procedure Gcc (Output_File : in String; + Files : in Argument_List; + Options : in Argument_List; + Base_File : in String := ""; + Build_Lib : in Boolean := False) + is + use Sdefault; + + Arguments : OS_Lib.Argument_List + (1 .. 5 + Files'Length + Options'Length); + A : Natural := 0; + + Success : Boolean; + C_Opt : aliased String := "-c"; + Out_Opt : aliased String := "-o"; + Out_V : aliased String := Output_File; + Bas_Opt : aliased String := "-Wl,--base-file," & Base_File; + Lib_Opt : aliased String := "-mdll"; + Lib_Dir : aliased String := "-L" & Object_Dir_Default_Name.all; + + begin + A := A + 1; + if Build_Lib then + Arguments (A) := Lib_Opt'Unchecked_Access; + else + Arguments (A) := C_Opt'Unchecked_Access; + end if; + + A := A + 1; + Arguments (A .. A + 2) := (Out_Opt'Unchecked_Access, + Out_V'Unchecked_Access, + Lib_Dir'Unchecked_Access); + A := A + 2; + + if Base_File /= "" then + A := A + 1; + Arguments (A) := Bas_Opt'Unchecked_Access; + end if; + + A := A + 1; + Arguments (A .. A + Files'Length - 1) := Files; + A := A + Files'Length - 1; + + if Build_Lib then + A := A + 1; + Arguments (A .. A + Options'Length - 1) := Options; + A := A + Options'Length - 1; + else + declare + Largs : Argument_List (Options'Range); + L : Natural := Largs'First - 1; + begin + for K in Options'Range loop + if Options (K) (1 .. 2) /= "-l" then + L := L + 1; + Largs (L) := Options (K); + end if; + end loop; + A := A + 1; + Arguments (A .. A + L - 1) := Largs (1 .. L); + A := A + L - 1; + end; + end if; + + Print_Command ("gcc", Arguments (1 .. A)); + + OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success); + + if not Success then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gcc_Name & " execution error."); + end if; + end Gcc; + + -------------- + -- Gnatbind -- + -------------- + + procedure Gnatbind (Alis : in Argument_List; + Args : in Argument_List := Null_Argument_List) + is + Arguments : OS_Lib.Argument_List (1 .. 1 + Alis'Length + Args'Length); + Success : Boolean; + + No_Main_Opt : aliased String := "-n"; + + begin + Arguments (1) := No_Main_Opt'Unchecked_Access; + Arguments (2 .. 1 + Alis'Length) := Alis; + Arguments (2 + Alis'Length .. Arguments'Last) := Args; + + Print_Command ("gnatbind", Arguments); + + OS_Lib.Spawn (Gnatbind_Exec.all, Arguments, Success); + + if not Success then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gnatbind_Name & " execution error."); + end if; + end Gnatbind; + + -------------- + -- Gnatlink -- + -------------- + + procedure Gnatlink (Ali : in String; + Args : in Argument_List := Null_Argument_List) + is + Arguments : OS_Lib.Argument_List (1 .. 1 + Args'Length); + Success : Boolean; + + Ali_Name : aliased String := Ali; + + begin + Arguments (1) := Ali_Name'Unchecked_Access; + Arguments (2 .. Arguments'Last) := Args; + + Print_Command ("gnatlink", Arguments); + + OS_Lib.Spawn (Gnatlink_Exec.all, Arguments, Success); + + if not Success then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gnatlink_Name & " execution error."); + end if; + end Gnatlink; + + ------------ + -- Locate -- + ------------ + + procedure Locate is + use type OS_Lib.String_Access; + begin + -- dlltool + + Dlltool_Exec := OS_Lib.Locate_Exec_On_Path (Dlltool_Name); + + if Dlltool_Exec = null then + Exceptions.Raise_Exception (Tools_Error'Identity, + Dlltool_Name & " not found in path"); + elsif Verbose then + Text_IO.Put_Line ("using " & Dlltool_Exec.all); + end if; + + -- gcc + + Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name); + + if Gcc_Exec = null then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gcc_Name & " not found in path"); + elsif Verbose then + Text_IO.Put_Line ("using " & Gcc_Exec.all); + end if; + + -- gnatbind + + Gnatbind_Exec := OS_Lib.Locate_Exec_On_Path (Gnatbind_Name); + + if Gnatbind_Exec = null then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gnatbind_Name & " not found in path"); + elsif Verbose then + Text_IO.Put_Line ("using " & Gnatbind_Exec.all); + end if; + + -- gnatlink + + Gnatlink_Exec := OS_Lib.Locate_Exec_On_Path (Gnatlink_Name); + + if Gnatlink_Exec = null then + Exceptions.Raise_Exception (Tools_Error'Identity, + Gnatlink_Name & " not found in path"); + elsif Verbose then + Text_IO.Put_Line ("using " & Gnatlink_Exec.all); + Text_IO.New_Line; + end if; + + end Locate; + +end MDLL.Tools; |