This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

committed: PR 12950 changes


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

--
Index: osint.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/osint.adb,v
retrieving revision 1.12
diff -u -c -3 -p -r1.12 osint.adb
*** osint.adb	21 Oct 2003 13:42:10 -0000	1.12
--- osint.adb	10 Nov 2003 09:39:33 -0000
***************
*** 24,35 ****
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Fmap;     use Fmap;
  with Hostparm;
! with Namet;    use Namet;
! with Opt;      use Opt;
! with Output;   use Output;
! with Sdefault; use Sdefault;
  with Table;
  
  with Unchecked_Conversion;
--- 24,36 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
! with Fmap;             use Fmap;
  with Hostparm;
! 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;
*************** package body Osint is
*** 42,47 ****
--- 43,52 ----
     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 --
     -------------------------------------
*************** package body Osint is
*** 71,76 ****
--- 76,89 ----
     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.
*************** package body Osint is
*** 735,740 ****
--- 748,810 ----
        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 --
     ------------------
*************** package body Osint is
*** 2074,2079 ****
--- 2144,2187 ----
  
     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 --
     -----------------
*************** package body Osint is
*** 2493,2499 ****
  
        In_Length      : constant Integer := Path'Length;
        In_String      : String (1 .. In_Length + 1);
!       Component_Name : aliased String := "GNAT" & ASCII.NUL;
        Result_Ptr     : Address;
        Result_Length  : Integer;
        Out_String     : String_Ptr;
--- 2601,2607 ----
  
        In_Length      : constant Integer := Path'Length;
        In_String      : String (1 .. In_Length + 1);
!       Component_Name : aliased String := "GCC" & ASCII.NUL;
        Result_Ptr     : Address;
        Result_Length  : Integer;
        Out_String     : String_Ptr;
Index: osint.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/osint.ads,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 osint.ads
*** osint.ads	21 Oct 2003 13:42:10 -0000	1.8
--- osint.ads	10 Nov 2003 09:39:33 -0000
*************** package Osint is
*** 202,207 ****
--- 202,218 ----
        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 --
     -------------------------
Index: Make-lang.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Make-lang.in,v
retrieving revision 1.49
diff -u -c -3 -p -r1.49 Make-lang.in
*** Make-lang.in	4 Nov 2003 12:51:46 -0000	1.49
--- Make-lang.in	10 Nov 2003 09:39:33 -0000
*************** ada/sdefault.adb: ada/stamp-sdefault ; @
*** 1075,1100 ****
  ada/stamp-sdefault : $(srcdir)/version.c $(srcdir)/move-if-change \
   Makefile
  	$(ECHO) "pragma Style_Checks (Off);" >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) "   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) "   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) "   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) "   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) "   end Search_Dir_Prefix;" >>tmp-sdefault.adb
  	$(ECHO) "end Sdefault;" >> tmp-sdefault.adb
  	$(srcdir)/move-if-change tmp-sdefault.adb ada/sdefault.adb
--- 1075,1102 ----
  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) "   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 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 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 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 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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]