------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- M D L L . T O O L S -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2023, 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 3, 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 COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- Interface to externals tools used to build DLL and import libraries with Ada.Text_IO; with Ada.Exceptions; with GNAT.Directory_Operations; with Osint; package body MDLL.Utl 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 Print_Command (Tool_Name : String; Arguments : OS_Lib.Argument_List); -- display the command run when in Verbose mode ------------------- -- Print_Command -- ------------------- procedure Print_Command (Tool_Name : String; Arguments : 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; ------------- -- Dlltool -- ------------- procedure Dlltool (Def_Filename : String; DLL_Name : String; Library : String; Exp_Table : String := ""; Base_File : String := ""; Build_Import : 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 : String; Files : Argument_List; Options : Argument_List; Base_File : String := ""; Build_Lib : Boolean := False) is use Osint; 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_Prefix; 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 : Argument_List; Args : 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); -- Delete binder files on failure if not Success then declare Base_Name : constant String := Directory_Operations.Base_Name (Alis (Alis'First).all, ".ali"); begin OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success); OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success); end; Exceptions.Raise_Exception (Tools_Error'Identity, Gnatbind_Name & " execution error."); end if; end Gnatbind; -------------- -- Gnatlink -- -------------- procedure Gnatlink (Ali : String; Args : 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 -- Delete binder files declare Base_Name : constant String := Directory_Operations.Base_Name (Ali, ".ali"); begin OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success); OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success); OS_Lib.Delete_File ("b~" & Base_Name & ".ali", Success); OS_Lib.Delete_File ("b~" & Base_Name & ".o", Success); end; 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 if Dlltool_Exec = null then 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; end if; -- gcc if Gcc_Exec = null then 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; end if; -- gnatbind if Gnatbind_Exec = null then 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; end if; -- gnatlink if Gnatlink_Exec = null then 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 if; end Locate; end MDLL.Utl;