185 lines
6.1 KiB
Text
185 lines
6.1 KiB
Text
$NetBSD: patch-aq,v 1.1 2004/05/28 22:28:09 shannonjr Exp $
|
|
|
|
--- gcc/ada/osint.adb.orig 2002-10-23 01:33:27.000000000 -0600
|
|
+++ gcc/ada/osint.adb
|
|
@@ -25,12 +25,12 @@
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-with Fmap; use Fmap;
|
|
+with Fmap; use Fmap;
|
|
with Hostparm;
|
|
-with Namet; use Namet;
|
|
-with Opt; use Opt;
|
|
-with Output; use Output;
|
|
-with Sdefault; use Sdefault;
|
|
+with Namet; use Namet;
|
|
+with Opt; use Opt;
|
|
+with Output; use Output;
|
|
+with Sdefault; use Sdefault;
|
|
with Table;
|
|
|
|
with Unchecked_Conversion;
|
|
@@ -43,6 +43,10 @@ package body Osint is
|
|
Running_Program : Program_Type := Unspecified;
|
|
Program_Set : Boolean := False;
|
|
|
|
+ Std_Prefix : String_Ptr;
|
|
+ -- Standard prefix, computed dynamically the first time Relocate_Path
|
|
+ -- is called, and cached for subsequent calls.
|
|
+
|
|
-------------------------------------
|
|
-- Use of Name_Find and Name_Enter --
|
|
-------------------------------------
|
|
@@ -72,6 +76,14 @@ package body Osint is
|
|
function Concat (String_One : String; String_Two : String) return String;
|
|
-- Concatenates 2 strings and returns the result of the concatenation
|
|
|
|
+ function Executable_Prefix return String_Ptr;
|
|
+ -- Returns the name of the root directory where the executable is stored.
|
|
+ -- The executable must be located in a directory called "bin", or
|
|
+ -- under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if
|
|
+ -- the executable is stored in directory "/foo/bar/bin", this routine
|
|
+ -- returns "/foo/bar/".
|
|
+ -- Return "" if the location is not recognized as described above.
|
|
+
|
|
function Update_Path (Path : String_Ptr) return String_Ptr;
|
|
-- Update the specified path to replace the prefix with the location
|
|
-- where GNAT is installed. See the file prefix.c in GCC for details.
|
|
@@ -607,6 +619,82 @@ package body Osint is
|
|
return Name_Enter;
|
|
end Executable_Name;
|
|
|
|
+ -------------------------
|
|
+ -- Executable_Prefix --
|
|
+ -------------------------
|
|
+
|
|
+ function Executable_Prefix return String_Ptr is
|
|
+ Exec_Name : String (1 .. Len_Arg (0));
|
|
+
|
|
+ function Get_Install_Dir (Exec : String) return String_Ptr;
|
|
+ -- S is the executable name preceeded by the absolute or relative
|
|
+ -- path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
|
|
+
|
|
+ function To_Lower (C : Character) return Character;
|
|
+ -- Converts C to lower case
|
|
+
|
|
+ ---------------------
|
|
+ -- To_Lower --
|
|
+ ---------------------
|
|
+
|
|
+ function To_Lower (C : Character) return Character is
|
|
+ type Lowers_Arr is array (Character range 'A' .. 'Z') of Character;
|
|
+ Lowers : constant Lowers_Arr := "abcdefghijklmnopqrstuvwxyz";
|
|
+ begin
|
|
+ case C is
|
|
+ when 'A' .. 'Z' =>
|
|
+ return Lowers (C);
|
|
+ when others =>
|
|
+ return C;
|
|
+ end case;
|
|
+ end To_Lower;
|
|
+
|
|
+ ---------------------
|
|
+ -- Get_Install_Dir --
|
|
+ ---------------------
|
|
+
|
|
+ function Get_Install_Dir (Exec : String) return String_Ptr is
|
|
+ begin
|
|
+ for J in reverse Exec'Range loop
|
|
+ if Is_Directory_Separator (Exec (J)) then
|
|
+ if J < Exec'Last - 5 then
|
|
+ if (To_Lower (Exec (J + 1)) = 'l'
|
|
+ and then To_Lower (Exec (J + 2)) = 'i'
|
|
+ and then To_Lower (Exec (J + 3)) = 'b')
|
|
+ or else
|
|
+ (To_Lower (Exec (J + 1)) = 'b'
|
|
+ and then To_Lower (Exec (J + 2)) = 'i'
|
|
+ and then To_Lower (Exec (J + 3)) = 'n')
|
|
+ then
|
|
+ return new String'(Exec (Exec'First .. J));
|
|
+ end if;
|
|
+ end if;
|
|
+ end if;
|
|
+ end loop;
|
|
+
|
|
+ return new String'("");
|
|
+ end Get_Install_Dir;
|
|
+
|
|
+ -- Beginning of Executable_Prefix
|
|
+
|
|
+ begin
|
|
+ Osint.Fill_Arg (Exec_Name'Address, 0);
|
|
+
|
|
+ -- First determine if a path prefix was placed in front of the
|
|
+ -- executable name.
|
|
+
|
|
+ for J in reverse Exec_Name'Range loop
|
|
+ if Is_Directory_Separator (Exec_Name (J)) then
|
|
+ return Get_Install_Dir (Exec_Name);
|
|
+ end if;
|
|
+ end loop;
|
|
+
|
|
+ -- If you are here, the user has typed the executable name with no
|
|
+ -- directory prefix.
|
|
+
|
|
+ return Get_Install_Dir (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name).all);
|
|
+ end Executable_Prefix;
|
|
+
|
|
------------------
|
|
-- Exit_Program --
|
|
------------------
|
|
@@ -1851,6 +1939,44 @@ package body Osint is
|
|
|
|
end Read_Source_File;
|
|
|
|
+ -------------------
|
|
+ -- Relocate_Path --
|
|
+ -------------------
|
|
+
|
|
+ function Relocate_Path
|
|
+ (Prefix : String;
|
|
+ Path : String) return String_Ptr
|
|
+ is
|
|
+ S : String_Ptr;
|
|
+
|
|
+ procedure set_std_prefix (S : String; Len : Integer);
|
|
+ pragma Import (C, set_std_prefix);
|
|
+
|
|
+ begin
|
|
+ if Std_Prefix = null then
|
|
+ Std_Prefix := Executable_Prefix;
|
|
+
|
|
+ if Std_Prefix.all /= "" then
|
|
+ -- Remove trailing directory separator when calling set_std_prefix
|
|
+
|
|
+ set_std_prefix (Std_Prefix.all, Std_Prefix'Length - 1);
|
|
+ end if;
|
|
+ end if;
|
|
+
|
|
+ if Path (Prefix'Range) = Prefix then
|
|
+ if Std_Prefix.all /= "" then
|
|
+ S := new String
|
|
+ (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
|
|
+ S (1 .. Std_Prefix'Length) := Std_Prefix.all;
|
|
+ S (Std_Prefix'Length + 1 .. S'Last) :=
|
|
+ Path (Prefix'Last + 1 .. Path'Last);
|
|
+ return S;
|
|
+ end if;
|
|
+ end if;
|
|
+
|
|
+ return new String'(Path);
|
|
+ end Relocate_Path;
|
|
+
|
|
-----------------
|
|
-- Set_Program --
|
|
-----------------
|
|
@@ -2269,7 +2395,7 @@ package body Osint is
|
|
|
|
In_Length : constant Integer := Path'Length;
|
|
In_String : String (1 .. In_Length + 1);
|
|
- Component_Name : aliased String := "GNAT" & ASCII.NUL;
|
|
+ Component_Name : aliased String := "GCC" & ASCII.NUL;
|
|
Result_Ptr : Address;
|
|
Result_Length : Integer;
|
|
Out_String : String_Ptr;
|