head 1.2; access; symbols pkgsrc-2021Q3:1.1.0.144 pkgsrc-2021Q3-base:1.1 pkgsrc-2021Q2:1.1.0.142 pkgsrc-2021Q2-base:1.1 pkgsrc-2021Q1:1.1.0.140 pkgsrc-2021Q1-base:1.1 pkgsrc-2020Q4:1.1.0.138 pkgsrc-2020Q4-base:1.1 pkgsrc-2020Q3:1.1.0.136 pkgsrc-2020Q3-base:1.1 pkgsrc-2020Q2:1.1.0.132 pkgsrc-2020Q2-base:1.1 pkgsrc-2020Q1:1.1.0.112 pkgsrc-2020Q1-base:1.1 pkgsrc-2019Q4:1.1.0.134 pkgsrc-2019Q4-base:1.1 pkgsrc-2019Q3:1.1.0.130 pkgsrc-2019Q3-base:1.1 pkgsrc-2019Q2:1.1.0.128 pkgsrc-2019Q2-base:1.1 pkgsrc-2019Q1:1.1.0.126 pkgsrc-2019Q1-base:1.1 pkgsrc-2018Q4:1.1.0.124 pkgsrc-2018Q4-base:1.1 pkgsrc-2018Q3:1.1.0.122 pkgsrc-2018Q3-base:1.1 pkgsrc-2018Q2:1.1.0.120 pkgsrc-2018Q2-base:1.1 pkgsrc-2018Q1:1.1.0.118 pkgsrc-2018Q1-base:1.1 pkgsrc-2017Q4:1.1.0.116 pkgsrc-2017Q4-base:1.1 pkgsrc-2017Q3:1.1.0.114 pkgsrc-2017Q3-base:1.1 pkgsrc-2017Q2:1.1.0.110 pkgsrc-2017Q2-base:1.1 pkgsrc-2017Q1:1.1.0.108 pkgsrc-2017Q1-base:1.1 pkgsrc-2016Q4:1.1.0.106 pkgsrc-2016Q4-base:1.1 pkgsrc-2016Q3:1.1.0.104 pkgsrc-2016Q3-base:1.1 pkgsrc-2016Q2:1.1.0.102 pkgsrc-2016Q2-base:1.1 pkgsrc-2016Q1:1.1.0.100 pkgsrc-2016Q1-base:1.1 pkgsrc-2015Q4:1.1.0.98 pkgsrc-2015Q4-base:1.1 pkgsrc-2015Q3:1.1.0.96 pkgsrc-2015Q3-base:1.1 pkgsrc-2015Q2:1.1.0.94 pkgsrc-2015Q2-base:1.1 pkgsrc-2015Q1:1.1.0.92 pkgsrc-2015Q1-base:1.1 pkgsrc-2014Q4:1.1.0.90 pkgsrc-2014Q4-base:1.1 pkgsrc-2014Q3:1.1.0.88 pkgsrc-2014Q3-base:1.1 pkgsrc-2014Q2:1.1.0.86 pkgsrc-2014Q2-base:1.1 pkgsrc-2014Q1:1.1.0.84 pkgsrc-2014Q1-base:1.1 pkgsrc-2013Q4:1.1.0.82 pkgsrc-2013Q4-base:1.1 pkgsrc-2013Q3:1.1.0.80 pkgsrc-2013Q3-base:1.1 pkgsrc-2013Q2:1.1.0.78 pkgsrc-2013Q2-base:1.1 pkgsrc-2013Q1:1.1.0.76 pkgsrc-2013Q1-base:1.1 pkgsrc-2012Q4:1.1.0.74 pkgsrc-2012Q4-base:1.1 pkgsrc-2012Q3:1.1.0.72 pkgsrc-2012Q3-base:1.1 pkgsrc-2012Q2:1.1.0.70 pkgsrc-2012Q2-base:1.1 pkgsrc-2012Q1:1.1.0.68 pkgsrc-2012Q1-base:1.1 pkgsrc-2011Q4:1.1.0.66 pkgsrc-2011Q4-base:1.1 pkgsrc-2011Q3:1.1.0.64 pkgsrc-2011Q3-base:1.1 pkgsrc-2011Q2:1.1.0.62 pkgsrc-2011Q2-base:1.1 pkgsrc-2011Q1:1.1.0.60 pkgsrc-2011Q1-base:1.1 pkgsrc-2010Q4:1.1.0.58 pkgsrc-2010Q4-base:1.1 pkgsrc-2010Q3:1.1.0.56 pkgsrc-2010Q3-base:1.1 pkgsrc-2010Q2:1.1.0.54 pkgsrc-2010Q2-base:1.1 pkgsrc-2010Q1:1.1.0.52 pkgsrc-2010Q1-base:1.1 pkgsrc-2009Q4:1.1.0.50 pkgsrc-2009Q4-base:1.1 pkgsrc-2009Q3:1.1.0.48 pkgsrc-2009Q3-base:1.1 pkgsrc-2009Q2:1.1.0.46 pkgsrc-2009Q2-base:1.1 pkgsrc-2009Q1:1.1.0.44 pkgsrc-2009Q1-base:1.1 pkgsrc-2008Q4:1.1.0.42 pkgsrc-2008Q4-base:1.1 pkgsrc-2008Q3:1.1.0.40 pkgsrc-2008Q3-base:1.1 cube-native-xorg:1.1.0.38 cube-native-xorg-base:1.1 pkgsrc-2008Q2:1.1.0.36 pkgsrc-2008Q2-base:1.1 cwrapper:1.1.0.34 pkgsrc-2008Q1:1.1.0.32 pkgsrc-2008Q1-base:1.1 pkgsrc-2007Q4:1.1.0.30 pkgsrc-2007Q4-base:1.1 pkgsrc-2007Q3:1.1.0.28 pkgsrc-2007Q3-base:1.1 pkgsrc-2007Q2:1.1.0.26 pkgsrc-2007Q2-base:1.1 pkgsrc-2007Q1:1.1.0.24 pkgsrc-2007Q1-base:1.1 pkgsrc-2006Q4:1.1.0.22 pkgsrc-2006Q4-base:1.1 pkgsrc-2006Q3:1.1.0.20 pkgsrc-2006Q3-base:1.1 pkgsrc-2006Q2:1.1.0.18 pkgsrc-2006Q2-base:1.1 pkgsrc-2006Q1:1.1.0.16 pkgsrc-2006Q1-base:1.1 pkgsrc-2005Q4:1.1.0.14 pkgsrc-2005Q4-base:1.1 pkgsrc-2005Q3:1.1.0.12 pkgsrc-2005Q3-base:1.1 pkgsrc-2005Q2:1.1.0.10 pkgsrc-2005Q2-base:1.1 pkgsrc-2005Q1:1.1.0.8 pkgsrc-2005Q1-base:1.1 pkgsrc-2004Q4:1.1.0.6 pkgsrc-2004Q4-base:1.1 pkgsrc-2004Q3:1.1.0.4 pkgsrc-2004Q3-base:1.1 pkgsrc-2004Q2:1.1.0.2 pkgsrc-2004Q2-base:1.1; locks; strict; comment @# @; 1.2 date 2021.10.08.16.38.31; author nia; state dead; branches; next 1.1; commitid 40BbVLpGn10MK1cD; 1.1 date 2004.05.28.22.28.09; author shannonjr; state Exp; branches; next ; desc @@ 1.2 log @lang: Remove gcc3. @ 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; @ 1.1 log @pkg/23871 Ada runtime is not relocatable (same as gcc Bug ada/12950) part 1/2 @ text @d1 1 a1 1 $NetBSD$ @