PR 12950

	* osint.ads, osint.adb (Relocate_Path, Executable_Suffix): New
	functions. Used to handle dynamic prefix relocation, via set_std_prefix.
	Replace GNAT_ROOT by GCC_ROOT.

	* Make-lang.in: Use new function Relocate_Path to generate sdefault.adb

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@73407 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ab6530..bb635ba 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2003-11-10  Arnaud Charlet  <charlet@act-europe.fr>
+
+       PR 12950
+       * osint.ads, osint.adb (Relocate_Path, Executable_Suffix): New
+       functions. Used to handle dynamic prefix relocation, via set_std_prefix.
+       Replace GNAT_ROOT by GCC_ROOT.
+
+       * Make-lang.in: Use new function Relocate_Path to generate sdefault.adb
+
 2003-11-06  Zack Weinberg  <zack@codesourcery.com>
 
        * misc.c (fp_prec_to_size, fp_size_to_prec): Use GET_MODE_PRECISION

diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in
index 44b2f88..0adc2f4 100644 (file)
--- a/gcc/ada/Make-lang.in
+++ b/gcc/ada/Make-lang.in
@@ -1075,26 +1075,28 @@ ada/sdefault.adb: ada/stamp-sdefault ; @true
 ada/stamp-sdefault : $(srcdir)/version.c $(srcdir)/move-if-change \
  Makefile
        $(ECHO) "pragma Style_Checks (Off);" >tmp-sdefault.adb
+       $(ECHO) "with Osint; use Osint;" >>tmp-sdefault.adb
        $(ECHO) "package body Sdefault is" >>tmp-sdefault.adb
-       $(ECHO) "   S1 : aliased constant String := \"$(ADA_INCLUDE_DIR)/\";" >>tmp-sdefault.adb
-       $(ECHO) "   S2 : aliased constant String := \"$(ADA_RTL_OBJ_DIR)/\";" >>tmp-sdefault.adb
-       $(ECHO) "   S3 : aliased constant String := \"$(target)/\";" >>tmp-sdefault.adb
-       $(ECHO) "   S4 : aliased constant String := \"$(libsubdir)/\";" >>tmp-sdefault.adb
+       $(ECHO) "   S0 : constant String := \"$(prefix)/\";" >>tmp-sdefault.adb
+       $(ECHO) "   S1 : constant String := \"$(ADA_INCLUDE_DIR)/\";" >>tmp-sdefault.adb
+       $(ECHO) "   S2 : constant String := \"$(ADA_RTL_OBJ_DIR)/\";" >>tmp-sdefault.adb
+       $(ECHO) "   S3 : constant String := \"$(target)/\";" >>tmp-sdefault.adb
+       $(ECHO) "   S4 : constant String := \"$(libsubdir)/\";" >>tmp-sdefault.adb
        $(ECHO) "   function Include_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
        $(ECHO) "   begin" >>tmp-sdefault.adb
-       $(ECHO) "      return new String'(S1);" >>tmp-sdefault.adb
+       $(ECHO) "      return Relocate_Path (S0, S1);" >>tmp-sdefault.adb
        $(ECHO) "   end Include_Dir_Default_Name;" >>tmp-sdefault.adb
        $(ECHO) "   function Object_Dir_Default_Name return String_Ptr is" >>tmp-sdefault.adb
        $(ECHO) "   begin" >>tmp-sdefault.adb
-       $(ECHO) "      return new String'(S2);" >>tmp-sdefault.adb
+       $(ECHO) "      return Relocate_Path (S0, S2);" >>tmp-sdefault.adb
        $(ECHO) "   end Object_Dir_Default_Name;" >>tmp-sdefault.adb
        $(ECHO) "   function Target_Name return String_Ptr is" >>tmp-sdefault.adb
        $(ECHO) "   begin" >>tmp-sdefault.adb
-       $(ECHO) "      return new String'(S3);" >>tmp-sdefault.adb
+       $(ECHO) "      return Relocate_Path (S0, S3);" >>tmp-sdefault.adb
        $(ECHO) "   end Target_Name;" >>tmp-sdefault.adb
        $(ECHO) "   function Search_Dir_Prefix return String_Ptr is" >>tmp-sdefault.adb
        $(ECHO) "   begin" >>tmp-sdefault.adb
-       $(ECHO) "      return new String'(S4);" >>tmp-sdefault.adb
+       $(ECHO) "      return Relocate_Path (S0, S4);" >>tmp-sdefault.adb
        $(ECHO) "   end Search_Dir_Prefix;" >>tmp-sdefault.adb
        $(ECHO) "end Sdefault;" >> tmp-sdefault.adb
        $(srcdir)/move-if-change tmp-sdefault.adb ada/sdefault.adb

diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index 88fcd3f..e560850 100644 (file)
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -24,12 +24,13 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-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 System.Case_Util; use System.Case_Util;
 with Table;
 
 with Unchecked_Conversion;
@@ -42,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 --
    -------------------------------------
@@ -71,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.
@@ -735,6 +748,63 @@ 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".
+
+      ---------------------
+      -- 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 --
    ------------------
@@ -2074,6 +2144,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 --
    -----------------
@@ -2493,7 +2601,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;

diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index ba58622..5f137b7 100644 (file)
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -202,6 +202,17 @@ package Osint is
       return           String_Access;
    --  Convert a canonical syntax file specification to host syntax.
 
+   function Relocate_Path
+     (Prefix : String;
+      Path   : String) return String_Ptr;
+   --  Given an absolute path and a prefix, if Path starts with Prefix,
+   --  replace the Prefix substring with the root installation directory.
+   --  By default, try to compute the root installation directory by looking
+   --  at the executable name as it was typed on the command line and, if
+   --  needed, use the PATH environment variable.
+   --  If the above computation fails, return Path.
+   --  This function assumes that Prefix'First = Path'First
+
    -------------------------
    -- Search Dir Routines --
    -------------------------