+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- M D L L . T O O L S --
--- --
--- B o d y --
--- --
--- $Revision: 1.2.10.1 $
--- --
--- 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. --
--- 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 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;
- Success : Boolean;
- begin
- OS_Lib.Delete_File (File'Address, Success);
- 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;
projects / msp430-gcc.git / blobdiff