--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/libgnat/s-tsmona__linux.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,188 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--  G N A T . T R A C E B A C K . S Y M B O L I C . M O D U L E _ N A M E   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2012-2017, AdaCore                     --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the GNU/Linux specific version of this package
+with Interfaces.C;              use Interfaces.C;
+
+with System.Address_Operations; use System.Address_Operations;
+
+separate (System.Traceback.Symbolic)
+
+package body Module_Name is
+
+   pragma Linker_Options ("-ldl");
+
+   function Is_Shared_Lib (Base : Address) return Boolean;
+   --  Returns True if a shared library
+
+   --  The principle is:
+
+   --  1. We get information about the module containing the address.
+
+   --  2. We check that the full pathname is pointing to a shared library.
+
+   --  3. for shared libraries, we return the non relocated address (so
+   --     the absolute address in the shared library).
+
+   --  4. we also return the full pathname of the module containing this
+   --     address.
+
+   -------------------
+   -- Is_Shared_Lib --
+   -------------------
+
+   function Is_Shared_Lib (Base : Address) return Boolean is
+      EI_NIDENT : constant := 16;
+      type u16 is mod 2 ** 16;
+
+      --  Just declare the needed header information, we just need to read the
+      --  type encoded in the second field.
+
+      type Elf32_Ehdr is record
+         e_ident : char_array (1 .. EI_NIDENT);
+         e_type  : u16;
+      end record;
+
+      ET_DYN : constant := 3; -- A shared lib if e_type = ET_DYN
+
+      Header : Elf32_Ehdr;
+      pragma Import (Ada, Header);
+      --  Suppress initialization in Normalized_Scalars mode
+      for Header'Address use Base;
+
+   begin
+      return Header.e_type = ET_DYN;
+   exception
+      when others =>
+         return False;
+   end Is_Shared_Lib;
+
+   ---------------------------------
+   -- 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);
+
+      r_debug : r_debug_type;
+      pragma Import (C, r_debug, "_r_debug");
+
+      lm : link_map_acc;
+   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;
+   end Build_Cache_For_All_Modules;
+
+   ---------
+   -- Get --
+   ---------
+
+   function Get (Addr : access System.Address) return String is
+
+      --  Dl_info record for Linux, used to get sym reloc offset
+
+      type Dl_info is record
+         dli_fname : System.Address;
+         dli_fbase : System.Address;
+         dli_sname : System.Address;
+         dli_saddr : System.Address;
+      end record;
+
+      function dladdr
+        (addr : System.Address;
+         info : not null access Dl_info) return int;
+      pragma Import (C, dladdr, "dladdr");
+      --  This is a Linux extension and not POSIX
+
+      info : aliased Dl_info;
+
+   begin
+      if dladdr (Addr.all, info'Access) /= 0 then
+
+         --  If we have a shared library we need to adjust the address to
+         --  be relative to the base address of the library.
+
+         if Is_Shared_Lib (info.dli_fbase) then
+            Addr.all := SubA (Addr.all, info.dli_fbase);
+         end if;
+
+         return Value (info.dli_fname);
+
+      --  Not found, fallback to executable name
+
+      else
+         return "";
+      end if;
+
+   exception
+      when others =>
+         return "";
+   end Get;
+
+   ------------------
+   -- Is_Supported --
+   ------------------
+
+   function Is_Supported return Boolean is
+   begin
+      return True;
+   end Is_Supported;
+
+end Module_Name;