From 2cdc8909d3821f97fba2aa063396a1a09e1fa14c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 10 Nov 2003 10:42:57 +0100 Subject: [PATCH] re PR ada/12950 (Ada runtime is not relocatable) 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 From-SVN: r73407 --- gcc/ada/ChangeLog | 9 ++++ gcc/ada/Make-lang.in | 18 ++++--- gcc/ada/osint.adb | 120 ++++++++++++++++++++++++++++++++++++++++--- gcc/ada/osint.ads | 11 ++++ 4 files changed, 144 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5ab65307786..bb635ba1b56 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2003-11-10 Arnaud Charlet + + 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 * 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 44b2f882e73..0adc2f4f764 100644 --- 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 88fcd3fd94e..e5608509208 100644 --- 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 ba586222675..5f137b7c7fa 100644 --- 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 -- ------------------------- -- 2.30.2