system/gcc: look, ma! Ada is in the house!

1 files changed, 565 insertions, 0 deletions

diff --git a/system/gcc/201-ada.patch b/system/gcc/201-ada.patch
new file mode 100644
index 000000000..acb1e1f1b
--- /dev/null
+++ b/system/gcc/201-ada.patch
@@ -0,0 +1,565 @@
+diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c
+index a63b7e7641b0..92155ef2025a 100644
+--- a/gcc/ada/adadecode.c
++++ b/gcc/ada/adadecode.c
+@@ -29,6 +29,7 @@
+  *                                                                          *
+  ****************************************************************************/
+ 
++#include "adaint.h"  /* for a macro version of xstrdup.  */
+ 
+ #if defined(IN_RTS)
+ #include "tconfig.h"
+@@ -42,8 +43,6 @@
+ #include <stdio.h>
+ #include <ctype.h>
+ 
+-#include "adaint.h"  /* for a macro version of xstrdup.  */
+-
+ #ifndef ISDIGIT
+ #define ISDIGIT(c) isdigit(c)
+ #endif
+diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
+index 414346558654..2586a1368903 100644
+--- a/gcc/ada/adaint.c
++++ b/gcc/ada/adaint.c
+@@ -85,6 +85,8 @@
+ #define _LARGEFILE64_SOURCE 1
+ #endif
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -202,8 +204,6 @@ UINT __gnat_current_ccs_encoding;
+ #include <utime.h>
+ #endif
+ 
+-#include "adaint.h"
+-
+ /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
+    defined in the current system. On DOS-like systems these flags control
+    whether the file is opened/created in text-translation mode (CR/LF in
+diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
+index 0d12f7e90209..74182446d4ac 100644
+--- a/gcc/ada/adaint.h
++++ b/gcc/ada/adaint.h
+@@ -316,6 +316,7 @@ extern void   *__gnat_lwp_self			   (void);
+ 
+ /* Routines for interface to required CPU set primitives */
+ 
++#define _GNU_SOURCE
+ #include <sched.h>
+ 
+ extern cpu_set_t *__gnat_cpu_alloc                 (size_t);
+diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c
+index f62cf1eb37dc..0b6c5fe6f0df 100644
+--- a/gcc/ada/argv.c
++++ b/gcc/ada/argv.c
+@@ -42,6 +42,8 @@
+    main program, and these routines are accessed from the
+    Ada.Command_Line.Environment package.  */
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -51,8 +53,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+-
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+diff --git a/gcc/ada/cio.c b/gcc/ada/cio.c
+index ff97abe36ef1..56aa3477c8cd 100644
+--- a/gcc/ada/cio.c
++++ b/gcc/ada/cio.c
+@@ -29,6 +29,8 @@
+  *                                                                          *
+  ****************************************************************************/
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -38,8 +40,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+-
+ /* We need L_tmpnam definition */
+ #include <stdio.h>
+ 
+diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c
+index cdcb531e2b3f..dde6b9948089 100644
+--- a/gcc/ada/cstreams.c
++++ b/gcc/ada/cstreams.c
+@@ -52,6 +52,8 @@
+ #include "vxWorks.h"
+ #endif
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -61,8 +63,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+-
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+diff --git a/gcc/ada/exit.c b/gcc/ada/exit.c
+index 6274571c6f04..336b0f8f386b 100644
+--- a/gcc/ada/exit.c
++++ b/gcc/ada/exit.c
+@@ -33,6 +33,8 @@
+ #include "vxWorks.h"
+ #endif
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -42,8 +44,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+-
+ #ifdef __cplusplus
+ extern "C" {
+ #endif
+diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
+index 0258f106d404..0416244ae428 100644
+--- a/gcc/ada/gcc-interface/Makefile.in
++++ b/gcc/ada/gcc-interface/Makefile.in
+@@ -1574,7 +1574,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(target_cpu) $(target_os))),)
+ endif
+ 
+ # ARM linux, GNU eabi
+-ifeq ($(strip $(filter-out arm% linux-gnueabi%,$(target_cpu) $(target_os))),)
++ifeq ($(strip $(filter-out arm% linux-gnueabi% linux-musleabi% linux-muslgnueabi%,$(target_cpu) $(target_os))),)
+   LIBGNAT_TARGET_PAIRS = \
+   a-intnam.ads<libgnarl/a-intnam__linux.ads \
+   s-inmaop.adb<libgnarl/s-inmaop__posix.adb \
+diff --git a/gcc/ada/init.c b/gcc/ada/init.c
+index 5088ecffc4f1..02a45b3ce7ca 100644
+--- a/gcc/ada/init.c
++++ b/gcc/ada/init.c
+@@ -53,6 +53,8 @@
+ #undef __linux__
+ #endif
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -65,7 +67,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+ #include "raise.h"
+ 
+ #ifdef __cplusplus
+diff --git a/gcc/ada/libgnarl/s-osinte__linux.ads b/gcc/ada/libgnarl/s-osinte__linux.ads
+index 5bf4a5fe1d26..c52cc70dfbab 100644
+--- a/gcc/ada/libgnarl/s-osinte__linux.ads
++++ b/gcc/ada/libgnarl/s-osinte__linux.ads
+@@ -394,12 +394,6 @@ package System.OS_Interface is
+    PTHREAD_RWLOCK_PREFER_WRITER_NP              : constant := 1;
+    PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP : constant := 2;
+ 
+-   function pthread_rwlockattr_setkind_np
+-     (attr : access pthread_rwlockattr_t;
+-      pref : int) return int;
+-   pragma Import
+-     (C, pthread_rwlockattr_setkind_np, "pthread_rwlockattr_setkind_np");
+-
+    function pthread_rwlock_init
+      (mutex : access pthread_rwlock_t;
+       attr  : access pthread_rwlockattr_t) return int;
+@@ -464,11 +458,6 @@ package System.OS_Interface is
+       protocol : int) return int;
+    pragma Import (C, pthread_mutexattr_setprotocol);
+ 
+-   function pthread_mutexattr_setprioceiling
+-     (attr        : access pthread_mutexattr_t;
+-      prioceiling : int) return int;
+-   pragma Import (C, pthread_mutexattr_setprioceiling);
+-
+    type struct_sched_param is record
+       sched_priority : int;  --  scheduling priority
+    end record;
+diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb
+index e55cd65e54f6..32d72b3980a6 100644
+--- a/gcc/ada/libgnarl/s-taprop__linux.adb
++++ b/gcc/ada/libgnarl/s-taprop__linux.adb
+@@ -202,9 +202,6 @@ package body System.Task_Primitives.Operations is
+    pragma Import
+      (C, GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ 
+-   function GNAT_has_cap_sys_nice return C.int;
+-   pragma Import
+-     (C, GNAT_has_cap_sys_nice, "__gnat_has_cap_sys_nice");
+    --  We do not have pragma Linker_Options ("-lcap"); here, because this
+    --  library is not present on many Linux systems. 'libcap' is the Linux
+    --  "capabilities" library, called by __gnat_has_cap_sys_nice.
+@@ -214,38 +211,6 @@ package body System.Task_Primitives.Operations is
+    --  Convert Ada priority to Linux priority. Priorities are 1 .. 99 on
+    --  GNU/Linux, so we map 0 .. 98 to 1 .. 99.
+ 
+-   function Get_Ceiling_Support return Boolean;
+-   --  Get the value of the Ceiling_Support constant (see below).
+-   --  Note well: If this function or related code is modified, it should be
+-   --  tested by hand, because automated testing doesn't exercise it.
+-
+-   -------------------------
+-   -- Get_Ceiling_Support --
+-   -------------------------
+-
+-   function Get_Ceiling_Support return Boolean is
+-      Ceiling_Support : Boolean := False;
+-   begin
+-      if Locking_Policy /= 'C' then
+-         return False;
+-      end if;
+-
+-      declare
+-         function geteuid return Integer;
+-         pragma Import (C, geteuid, "geteuid");
+-         Superuser : constant Boolean := geteuid = 0;
+-         Has_Cap : constant C.int := GNAT_has_cap_sys_nice;
+-         pragma Assert (Has_Cap in 0 | 1);
+-      begin
+-         Ceiling_Support := Superuser or else Has_Cap = 1;
+-      end;
+-
+-      return Ceiling_Support;
+-   end Get_Ceiling_Support;
+-
+-   pragma Warnings (Off, "non-static call not allowed in preelaborated unit");
+-   Ceiling_Support : constant Boolean := Get_Ceiling_Support;
+-   pragma Warnings (On, "non-static call not allowed in preelaborated unit");
+    --  True if the locking policy is Ceiling_Locking, and the current process
+    --  has permission to use this policy. The process has permission if it is
+    --  running as 'root', or if the capability was set by the setcap command,
+@@ -348,7 +313,9 @@ package body System.Task_Primitives.Operations is
+    -- Init_Mutex --
+    ----------------
+ 
++   pragma Warnings (Off, "formal parameter * is not referenced");
+    function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int is
++   pragma Warnings (On, "formal parameter * is not referenced");
+       Mutex_Attr : aliased pthread_mutexattr_t;
+       Result, Result_2 : C.int;
+ 
+@@ -360,16 +327,7 @@ package body System.Task_Primitives.Operations is
+          return Result;
+       end if;
+ 
+-      if Ceiling_Support then
+-         Result := pthread_mutexattr_setprotocol
+-           (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT);
+-         pragma Assert (Result = 0);
+-
+-         Result := pthread_mutexattr_setprioceiling
+-           (Mutex_Attr'Access, Prio_To_Linux_Prio (Prio));
+-         pragma Assert (Result = 0);
+-
+-      elsif Locking_Policy = 'I' then
++      if Locking_Policy = 'I' then
+          Result := pthread_mutexattr_setprotocol
+            (Mutex_Attr'Access, PTHREAD_PRIO_INHERIT);
+          pragma Assert (Result = 0);
+@@ -409,11 +367,6 @@ package body System.Task_Primitives.Operations is
+             Result := pthread_rwlockattr_init (RWlock_Attr'Access);
+             pragma Assert (Result = 0);
+ 
+-            Result := pthread_rwlockattr_setkind_np
+-              (RWlock_Attr'Access,
+-               PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP);
+-            pragma Assert (Result = 0);
+-
+             Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access);
+ 
+             pragma Assert (Result in 0 | ENOMEM);
+diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb
+index a857b67132af..1e2bb4c545ad 100644
+--- a/gcc/ada/libgnat/s-dwalin.adb
++++ b/gcc/ada/libgnat/s-dwalin.adb
+@@ -382,7 +382,7 @@ package body System.Dwarf_Lines is
+ 
+    function Low (C : Dwarf_Context) return Address is
+    begin
+-      return C.Low;
++      return To_Address (To_Integer (C.Low) + C.Load_Slide);
+    end Low;
+ 
+    ----------
+@@ -1210,19 +1210,21 @@ package body System.Dwarf_Lines is
+                --  Discard symbols whose length is 0
+                Sz := uint32 (Size (S));
+ 
+-               --  Try to filter symbols at the same address. This is a best
+-               --  effort as they might not be consecutive.
+-               Addr := uint32 (Value (S) - uint64 (C.Low));
+-               if Sz > 0 and then Addr /= Prev_Addr then
+-                  Nbr_Symbols := Nbr_Symbols + 1;
+-                  Prev_Addr   := Addr;
+-
+-                  if Phase = 2 then
+-                     C.Cache (Nbr_Symbols) :=
+-                       (First => Addr,
+-                        Size  => Sz,
+-                        Sym   => uint32 (Off (S)),
+-                        Line  => 0);
++               if Sz > 0 then
++                  --  Try to filter symbols at the same address. This is a best
++                  --  effort as they might not be consecutive.
++                  Addr := uint32 (Value (S) - uint64 (C.Low));
++                  if Addr /= Prev_Addr then
++                     Nbr_Symbols := Nbr_Symbols + 1;
++                     Prev_Addr   := Addr;
++
++                     if Phase = 2 then
++                        C.Cache (Nbr_Symbols) :=
++                          (First => Addr,
++                           Size  => Sz,
++                           Sym   => uint32 (Off (S)),
++                           Line  => 0);
++                     end if;
+                   end if;
+                end if;
+ 
+@@ -1267,6 +1269,10 @@ package body System.Dwarf_Lines is
+             --  Read table
+             loop
+                Read_Aranges_Entry (C, Ar_Start, Ar_Len);
++               --  Skip references to discarded sections
++               while Ar_Start = 0 and Ar_Len /= 0 loop
++                  Read_Aranges_Entry (C, Ar_Start, Ar_Len);
++               end loop;
+                exit when Ar_Start = 0 and Ar_Len = 0;
+ 
+                Len   := uint32 (Ar_Len);
+diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb
+index db7c5eb4cdd8..3cd60ecbc37b 100644
+--- a/gcc/ada/libgnat/s-trasym__dwarf.adb
++++ b/gcc/ada/libgnat/s-trasym__dwarf.adb
+@@ -123,7 +123,8 @@ package body System.Traceback.Symbolic is
+    --  Return the String contained in Item, up until the first NUL character
+ 
+    pragma Warnings (Off, "*Add_Module_To_Cache*");
+-   procedure Add_Module_To_Cache (Module_Name : String);
++   procedure Add_Module_To_Cache (Module_Name  : String;
++                                  Load_Address : System.Address);
+    --  To be called by Build_Cache_For_All_Modules to add a new module to the
+    --  list. May not be referenced.
+ 
+@@ -217,12 +218,13 @@ package body System.Traceback.Symbolic is
+    -- Add_Module_To_Cache --
+    -------------------------
+ 
+-   procedure Add_Module_To_Cache (Module_Name : String) is
++   procedure Add_Module_To_Cache (Module_Name  : String;
++                                  Load_Address : System.Address) is
+       Module  : Module_Cache_Acc;
+       Success : Boolean;
+    begin
+       Module := new Module_Cache;
+-      Init_Module (Module.all, Success, Module_Name);
++      Init_Module (Module.all, Success, Module_Name, Load_Address);
+       if not Success then
+          Free (Module);
+          return;
+diff --git a/gcc/ada/libgnat/s-tsmona__linux.adb b/gcc/ada/libgnat/s-tsmona__linux.adb
+index cbebd0652048..c882aa64a6e2 100644
+--- a/gcc/ada/libgnat/s-tsmona__linux.adb
++++ b/gcc/ada/libgnat/s-tsmona__linux.adb
+@@ -87,45 +87,49 @@ package body Module_Name is
+    -- Build_Cache_For_All_Modules --
+    ---------------------------------
+ 
+-   procedure Build_Cache_For_All_Modules is
+-      type link_map;
+-      type link_map_acc is access all link_map;
+-      pragma Convention (C, link_map_acc);
+-
+-      type link_map is record
+-         l_addr : Address;
+-         --  Base address of the shared object
+-
+-         l_name : Address;
+-         --  Null-terminated absolute file name
+-
+-         l_ld   : Address;
+-         --  Dynamic section
+-
+-         l_next, l_prev : link_map_acc;
+-         --  Chain
+-      end record;
+-      pragma Convention (C, link_map);
+-
+-      type r_debug_type is record
+-         r_version : Integer;
+-         r_map : link_map_acc;
+-      end record;
+-      pragma Convention (C, r_debug_type);
++   type dl_phdr_info is record
++      dlpi_addr  : Address;
++      dlpi_name  : Address;
++      dlpi_phdr  : Address;
++      dlpi_phnum : unsigned_short;
++   end record;
++   pragma Convention (C, dl_phdr_info);
++
++   type Callback_Type is access function
++     (info : not null access dl_phdr_info;
++      size : size_t;
++      data : Address) return int;
++   pragma Convention (C, Callback_Type);
++
++   function Build_Cache_Callback
++     (info : not null access dl_phdr_info;
++      size : size_t;
++      data : Address) return int;
++   pragma Convention (C, Build_Cache_Callback);
++
++   function Build_Cache_Callback
++     (info : not null access dl_phdr_info;
++      size : size_t;
++      data : Address) return int is
++      pragma Unreferenced (size);
++      pragma Unreferenced (data);
++   begin
++      if Big_String_Conv.To_Pointer (info.dlpi_name) (1) /= ASCII.NUL then
++         --  Discard non-file (like the executable itself or the gate).
++         Add_Module_To_Cache (Value (info.dlpi_name), info.dlpi_addr);
++      end if;
++      return 0;
++   end Build_Cache_Callback;
+ 
+-      r_debug : r_debug_type;
+-      pragma Import (C, r_debug, "_r_debug");
++   function dl_iterate_phdr
++     (callback : Callback_Type;
++      data     : Address) return int;
++   pragma Import (C, dl_iterate_phdr, "dl_iterate_phdr");
+ 
+-      lm : link_map_acc;
++   procedure Build_Cache_For_All_Modules is
++      unused : int;
+    begin
+-      lm := r_debug.r_map;
+-      while lm /= null loop
+-         if Big_String_Conv.To_Pointer (lm.l_name) (1) /= ASCII.NUL then
+-            --  Discard non-file (like the executable itself or the gate).
+-            Add_Module_To_Cache (Value (lm.l_name));
+-         end if;
+-         lm := lm.l_next;
+-      end loop;
++      unused := dl_iterate_phdr (Build_Cache_Callback'Access, Null_Address);
+    end Build_Cache_For_All_Modules;
+ 
+    ---------
+diff --git a/gcc/ada/mkdir.c b/gcc/ada/mkdir.c
+index c101d968a851..43cdd51e8320 100644
+--- a/gcc/ada/mkdir.c
++++ b/gcc/ada/mkdir.c
+@@ -34,6 +34,8 @@
+ #include <version.h>
+ #endif /* __vxworks */
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -53,8 +55,6 @@
+ #endif
+ #endif
+ 
+-#include "adaint.h"
+-
+ /*  This function provides a portable binding to the mkdir function.  */
+ 
+ int
+diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c
+index 70ad6cd3282a..eb92de1b2137 100644
+--- a/gcc/ada/raise.c
++++ b/gcc/ada/raise.c
+@@ -32,6 +32,8 @@
+ /* Shared routines to support exception handling.  __gnat_unhandled_terminate
+    is shared between all exception handling mechanisms.  */
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #include "tconfig.h"
+ #include "tsystem.h"
+@@ -40,7 +42,6 @@
+ #include "system.h"
+ #endif
+ 
+-#include "adaint.h"
+ #include "raise.h"
+ 
+ #ifdef __cplusplus
+diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c
+index 98b3901cb16f..98db6a14c2d5 100644
+--- a/gcc/ada/sysdep.c
++++ b/gcc/ada/sysdep.c
+@@ -52,6 +52,8 @@
+ #undef __linux__
+ #endif
+ 
++#include "adaint.h"
++
+ #ifdef IN_RTS
+ #define POSIX
+ #include "tconfig.h"
+@@ -72,8 +74,6 @@
+ extern struct tm *localtime_r(const time_t *, struct tm *);
+ #endif
+ 
+-#include "adaint.h"
+-
+ /* Don't use macros versions of this functions on VxWorks since they cause
+    imcompatible changes in some VxWorks versions */
+ #ifdef __vxworks
+diff --git a/gcc/ada/terminals.c b/gcc/ada/terminals.c
+index 7025f57d645e..074845584958 100644
+--- a/gcc/ada/terminals.c
++++ b/gcc/ada/terminals.c
+@@ -1112,7 +1112,6 @@ __gnat_setup_winsize (void *desc, int rows, int columns)
+    (HP-UX) */
+ #if !defined (__hpux__) && !defined (BSD) && !defined (__APPLE__) \
+   && !defined (__rtems__) && !defined (__QNXNTO__)
+-#   include <termio.h>
+ #endif
+ 
+ #include <sys/ioctl.h>
+@@ -1159,7 +1158,8 @@ __gnat_setup_winsize (void *desc, int rows, int columns)
+ #if defined (__APPLE__) || defined (BSD)
+ #define USE_OPENPTY
+ #elif defined (__linux__)
+-#define USE_GETPT
++#include <pty.h>
++#define USE_OPENPTY
+ #elif defined (__sun__)
+ #define USE_CLONE_DEVICE "/dev/ptmx"
+ #elif defined (_AIX)