| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- M L I B . U T L -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision: 1.3 $ |
| -- -- |
| -- Copyright (C) 2001, Ada Core Technologies, 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). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with MLib.Fil; |
| with MLib.Tgt; |
| with Namet; use Namet; |
| with Opt; |
| with Osint; use Osint; |
| with Output; use Output; |
| |
| package body MLib.Utl is |
| |
| use GNAT; |
| |
| package Files renames MLib.Fil; |
| package Target renames MLib.Tgt; |
| |
| Initialized : Boolean := False; |
| |
| Gcc_Name : constant String := "gcc"; |
| Gcc_Exec : OS_Lib.String_Access; |
| |
| Ar_Name : constant String := "ar"; |
| Ar_Exec : OS_Lib.String_Access; |
| |
| Ranlib_Name : constant String := "ranlib"; |
| Ranlib_Exec : OS_Lib.String_Access; |
| |
| procedure Initialize; |
| -- Look for the tools in the path and record the full path for each one |
| |
| -------- |
| -- Ar -- |
| -------- |
| |
| procedure Ar (Output_File : String; Objects : Argument_List) is |
| Create_Add_Opt : OS_Lib.String_Access := new String' ("cr"); |
| |
| Full_Output_File : constant String := |
| Files.Ext_To (Output_File, Target.Archive_Ext); |
| |
| Arguments : OS_Lib.Argument_List (1 .. 2 + Objects'Length); |
| Success : Boolean; |
| |
| begin |
| Initialize; |
| |
| Arguments (1) := Create_Add_Opt; -- "ar cr ..." |
| Arguments (2) := new String'(Full_Output_File); |
| Arguments (3 .. Arguments'Last) := Objects; |
| |
| Delete_File (Full_Output_File); |
| |
| if not Opt.Quiet_Output then |
| Write_Str (Ar_Name); |
| |
| for J in Arguments'Range loop |
| Write_Char (' '); |
| Write_Str (Arguments (J).all); |
| end loop; |
| |
| Write_Eol; |
| end if; |
| |
| OS_Lib.Spawn (Ar_Exec.all, Arguments, Success); |
| |
| if not Success then |
| Fail (Ar_Name, " execution error."); |
| end if; |
| |
| -- If we have found ranlib, run it over the library |
| |
| if Ranlib_Exec /= null then |
| if not Opt.Quiet_Output then |
| Write_Str (Ranlib_Name); |
| Write_Char (' '); |
| Write_Line (Arguments (2).all); |
| end if; |
| |
| OS_Lib.Spawn (Ranlib_Exec.all, (1 => Arguments (2)), Success); |
| |
| if not Success then |
| Fail (Ranlib_Name, " execution error."); |
| end if; |
| end if; |
| end Ar; |
| |
| ----------------- |
| -- 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); |
| |
| if Opt.Verbose_Mode then |
| if Success then |
| Write_Str ("deleted "); |
| |
| else |
| Write_Str ("could not delete "); |
| end if; |
| |
| Write_Line (Filename); |
| end if; |
| end Delete_File; |
| |
| --------- |
| -- Gcc -- |
| --------- |
| |
| procedure Gcc |
| (Output_File : String; |
| Objects : Argument_List; |
| Options : Argument_List; |
| Base_File : String := "") |
| is |
| Arguments : OS_Lib.Argument_List |
| (1 .. 7 + Objects'Length + Options'Length); |
| |
| A : Natural := 0; |
| Success : Boolean; |
| Out_Opt : OS_Lib.String_Access := new String' ("-o"); |
| Out_V : OS_Lib.String_Access := new String' (Output_File); |
| Lib_Dir : OS_Lib.String_Access := new String' ("-L" & Lib_Directory); |
| Lib_Opt : OS_Lib.String_Access := new String' (Target.Dynamic_Option); |
| |
| begin |
| Initialize; |
| |
| if Lib_Opt'Length /= 0 then |
| A := A + 1; |
| Arguments (A) := Lib_Opt; |
| end if; |
| |
| A := A + 1; |
| Arguments (A) := Out_Opt; |
| A := A + 1; |
| Arguments (A) := Out_V; |
| |
| A := A + 1; |
| Arguments (A) := Lib_Dir; |
| |
| A := A + Options'Length; |
| Arguments (A - Options'Length + 1 .. A) := Options; |
| |
| A := A + Objects'Length; |
| Arguments (A - Objects'Length + 1 .. A) := Objects; |
| |
| if not Opt.Quiet_Output then |
| Write_Str (Gcc_Exec.all); |
| |
| for J in 1 .. A loop |
| Write_Char (' '); |
| Write_Str (Arguments (J).all); |
| end loop; |
| |
| Write_Eol; |
| end if; |
| |
| OS_Lib.Spawn (Gcc_Exec.all, Arguments (1 .. A), Success); |
| |
| if not Success then |
| Fail (Gcc_Name, " execution error"); |
| end if; |
| end Gcc; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| procedure Initialize is |
| use type OS_Lib.String_Access; |
| |
| begin |
| if not Initialized then |
| Initialized := True; |
| |
| -- gcc |
| |
| Gcc_Exec := OS_Lib.Locate_Exec_On_Path (Gcc_Name); |
| |
| if Gcc_Exec = null then |
| |
| Fail (Gcc_Name, " not found in path"); |
| |
| elsif Opt.Verbose_Mode then |
| Write_Str ("found "); |
| Write_Line (Gcc_Exec.all); |
| end if; |
| |
| -- ar |
| |
| Ar_Exec := OS_Lib.Locate_Exec_On_Path (Ar_Name); |
| |
| if Ar_Exec = null then |
| |
| Fail (Ar_Name, " not found in path"); |
| |
| elsif Opt.Verbose_Mode then |
| Write_Str ("found "); |
| Write_Line (Ar_Exec.all); |
| end if; |
| |
| -- ranlib |
| |
| Ranlib_Exec := OS_Lib.Locate_Exec_On_Path (Ranlib_Name); |
| |
| if Ranlib_Exec /= null and then Opt.Verbose_Mode then |
| Write_Str ("found "); |
| Write_Line (Ranlib_Exec.all); |
| end if; |
| |
| end if; |
| |
| end Initialize; |
| |
| ------------------- |
| -- Lib_Directory -- |
| ------------------- |
| |
| function Lib_Directory return String is |
| Libgnat : constant String := Target.Libgnat; |
| |
| begin |
| Name_Len := Libgnat'Length; |
| Name_Buffer (1 .. Name_Len) := Libgnat; |
| Get_Name_String (Find_File (Name_Enter, Library)); |
| |
| -- Remove libgnat.a |
| |
| return Name_Buffer (1 .. Name_Len - Libgnat'Length); |
| end Lib_Directory; |
| |
| end MLib.Utl; |