pkg/23871 Ada runtime is not relocatable (same as gcc Bug ada/12950)

part 1/2

1 files changed, 185 insertions, 0 deletions

diff --git a/lang/gcc3/patches/patch-aq b/lang/gcc3/patches/patch-aq
new file mode 100644
index 00000000000..79c90acb22c
--- /dev/null
+++ b/lang/gcc3/patches/patch-aq
@@ -0,0 +1,185 @@
+$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;