s-dwalin.ads, [...]: New.

2017-09-08  Arnaud Charlet <charlet@adacore.com>

	* s-dwalin.ads, s-dwalin.adb, s-trasym-dwarf.adb, s-objrea.ads,
	s-objrea.adb, s-tsmona-linux.adb, s-tsmona-mingw.adb: New.
	* gcc-interface/Makefile.in: Enable s-trasym-dwarf.adb on x86*linux.

From-SVN: r251887

8 files changed, 5512 insertions, 0 deletions

diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 482259e..9ad7783 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -429,6 +429,25 @@ X86_64_TARGET_PAIRS = \
   a-numaux.adb<a-numaux-x86.adb \
   s-atocou.adb<s-atocou-builtin.adb
 
+# Implementation of symbolic traceback based on dwarf
+TRASYM_DWARF_UNIX_PAIRS = \
+  s-trasym.adb<s-trasym-dwarf.adb \
+  s-mmosin.ads<s-mmosin-unix.ads \
+  s-mmosin.adb<s-mmosin-unix.adb \
+  s-mmauni.ads<s-mmauni-long.ads
+
+TRASYM_DWARF_MINGW_PAIRS = \
+  s-trasym.adb<s-trasym-dwarf.adb \
+  s-mmosin.ads<s-mmosin-mingw.ads \
+  s-mmosin.adb<s-mmosin-mingw.adb
+
+TRASYM_DWARF_COMMON_OBJS = s-objrea$(objext) s-dwalin$(objext) s-mmap$(objext) \
+  s-mmosin$(objext)
+
+TRASYM_DWARF_UNIX_OBJS = $(TRASYM_DWARF_COMMON_OBJS) s-mmauni$(objext)
+
+TRASYM_DWARF_MINGW_OBJS = $(TRASYM_DWARF_COMMON_OBJS)
+
 # Shared library version
 LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)ada/gnatvsn.ads | sed -e 's/.*"\(.*\)".*/\1/'))
 
@@ -1085,7 +1104,9 @@ ifeq ($(strip $(filter-out %86 linux%,$(target_cpu) $(target_os))),)
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
   s-tpopsp.adb<s-tpopsp-tls.adb \
+  $(TRASYM_DWARF_UNIX_PAIRS) \
   g-sercom.adb<g-sercom-linux.adb \
+  s-tsmona.adb<s-tsmona-linux.adb \
   a-exetim.adb<a-exetim-posix.adb \
   a-exetim.ads<a-exetim-default.ads \
   s-linux.ads<s-linux.ads \
@@ -1111,6 +1132,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(target_cpu) $(target_os))),)
   EH_MECHANISM=-gcc
   THREADSLIB = -lpthread -lrt
   EXTRA_GNATRTL_NONTASKING_OBJS += g-sse.o g-ssvety.o
+  EXTRA_GNATRTL_NONTASKING_OBJS += $(TRASYM_DWARF_UNIX_OBJS)
   EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
 
   TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb
@@ -1907,6 +1929,8 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),)
   s-tpopsp.adb<s-tpopsp-tls.adb \
   s-taspri.ads<s-taspri-posix.ads \
   g-sercom.adb<g-sercom-linux.adb \
+  $(TRASYM_DWARF_UNIX_PAIRS) \
+  s-tsmona.adb<s-tsmona-linux.adb \
   $(ATOMICS_TARGET_PAIRS) \
   $(X86_64_TARGET_PAIRS) \
   system.ads<system-linux-x86.ads
@@ -1914,6 +1938,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(target_cpu) $(target_os))),)
   TOOLS_TARGET_PAIRS = indepsw.adb<indepsw-gnu.adb
 
   EXTRA_GNATRTL_NONTASKING_OBJS += g-sse.o g-ssvety.o
+  EXTRA_GNATRTL_NONTASKING_OBJS += $(TRASYM_DWARF_UNIX_OBJS)
   EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
 
   EH_MECHANISM=-gcc
diff --git a/gcc/ada/s-dwalin.adb b/gcc/ada/s-dwalin.adb
new file mode 100644
index 0000000..1791b2d
--- /dev/null
+++ b/gcc/ada/s-dwalin.adb
@@ -0,0 +1,1627 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                   S Y S T E M . D W A R F _ L I N E S                    --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2009-2017, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we can get
+--  elaboration circularities when polling is turned on
+
+with Ada.Characters.Handling;
+with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+with Ada.Unchecked_Deallocation;
+with Ada.Containers.Generic_Array_Sort;
+
+with Interfaces; use Interfaces;
+
+with System;                   use System;
+with System.Storage_Elements;  use System.Storage_Elements;
+with System.Address_Image;
+with System.IO;                use System.IO;
+with System.Object_Reader;     use System.Object_Reader;
+with System.Traceback_Entries; use System.Traceback_Entries;
+with System.Mmap;              use System.Mmap;
+with System.Bounded_Strings;   use System.Bounded_Strings;
+
+package body System.Dwarf_Lines is
+
+   SSU : constant := System.Storage_Unit;
+
+   function String_Length (Str : Str_Access) return Natural;
+   --  Return the length of the C string Str
+
+   ---------------------------------
+   -- DWARF Parser Implementation --
+   ---------------------------------
+
+   procedure Read_Initial_Length
+     (S    : in out Mapped_Stream;
+      Len  :    out Offset;
+      Is64 :    out Boolean);
+   --  Read initial length as specified by Dwarf-4 7.2.2
+
+   procedure Read_Section_Offset
+     (S    : in out Mapped_Stream;
+      Len  :    out Offset;
+      Is64 :        Boolean);
+   --  Read a section offset, as specified by Dwarf-4 7.4
+
+   procedure Read_Aranges_Entry
+     (C     : in out Dwarf_Context;
+      Start :    out Integer_Address;
+      Len   :    out Storage_Count);
+   --  Read a single .debug_aranges pair
+
+   procedure Read_Aranges_Header
+     (C           : in out Dwarf_Context;
+      Info_Offset :    out Offset;
+      Success     :    out Boolean);
+   --  Read .debug_aranges header
+
+   procedure Aranges_Lookup
+     (C           : in out Dwarf_Context;
+      Addr        :        Address;
+      Info_Offset :    out Offset;
+      Success     :    out Boolean);
+   --  Search for Addr in .debug_aranges and return offset Info_Offset in
+   --  .debug_info.
+
+   procedure Skip_Form
+     (S      : in out Mapped_Stream;
+      Form   :        uint32;
+      Is64   :        Boolean;
+      Ptr_Sz :        uint8);
+   --  Advance offset in S for Form.
+
+   procedure Seek_Abbrev
+     (C             : in out Dwarf_Context;
+      Abbrev_Offset :        Offset;
+      Abbrev_Num    :        uint32);
+   --  Seek to abbrev Abbrev_Num (starting from Abbrev_Offset)
+
+   procedure Debug_Info_Lookup
+     (C           : in out Dwarf_Context;
+      Info_Offset :        Offset;
+      Line_Offset :    out Offset;
+      Success     :    out Boolean);
+   --  Search for stmt_list tag in Info_Offset and set Line_Offset to the
+   --  offset in .debug_lines. Only look at the first DIE, which should be
+   --  a compilation unit.
+
+   procedure Initialize_Pass (C : in out Dwarf_Context);
+   --  Seek to the first byte of the first prologue and prepare to make a pass
+   --  over the line number entries.
+
+   procedure Initialize_State_Machine (C : in out Dwarf_Context);
+   --  Set all state machine registers to their specified initial values
+
+   procedure Parse_Prologue (C : in out Dwarf_Context);
+   --  Decode a DWARF statement program prologue
+
+   procedure Read_And_Execute_Isn
+     (C    : in out Dwarf_Context;
+      Done :    out Boolean);
+   --  Read an execute a statement program instruction
+
+   function To_File_Name
+     (C    : in out Dwarf_Context;
+      Code :        uint32) return String;
+   --  Extract a file name from the prologue
+
+   type Callback is access procedure (C : in out Dwarf_Context);
+   procedure For_Each_Row (C : in out Dwarf_Context; F : Callback);
+   --  Traverse each .debug_line entry with a callback
+
+   procedure Dump_Row (C : in out Dwarf_Context);
+   --  Dump a single row
+
+   function "<" (Left, Right : Search_Entry) return Boolean;
+   --  For sorting Search_Entry
+
+   procedure Sort_Search_Array is new Ada.Containers.Generic_Array_Sort
+     (Index_Type   => Natural,
+      Element_Type => Search_Entry,
+      Array_Type   => Search_Array);
+
+   procedure Symbolic_Address
+     (C           : in out Dwarf_Context;
+      Addr        :        Address;
+      Dir_Name    :    out Str_Access;
+      File_Name   :    out Str_Access;
+      Subprg_Name :    out String_Ptr_Len;
+      Line_Num    :    out Natural);
+   --  Symbolize one address
+
+   -----------------------
+   --  DWARF constants  --
+   -----------------------
+
+   --  6.2.5.2 Standard Opcodes
+
+   DW_LNS_copy               : constant := 1;
+   DW_LNS_advance_pc         : constant := 2;
+   DW_LNS_advance_line       : constant := 3;
+   DW_LNS_set_file           : constant := 4;
+   DW_LNS_set_column         : constant := 5;
+   DW_LNS_negate_stmt        : constant := 6;
+   DW_LNS_set_basic_block    : constant := 7;
+   DW_LNS_const_add_pc       : constant := 8;
+   DW_LNS_fixed_advance_pc   : constant := 9;
+   DW_LNS_set_prologue_end   : constant := 10;
+   DW_LNS_set_epilogue_begin : constant := 11;
+   DW_LNS_set_isa            : constant := 12;
+
+   --  6.2.5.3 Extended Opcodes
+
+   DW_LNE_end_sequence : constant := 1;
+   DW_LNE_set_address  : constant := 2;
+   DW_LNE_define_file  : constant := 3;
+
+   --  From the DWARF version 4 public review draft
+
+   DW_LNE_set_discriminator : constant := 4;
+
+   --  Attribute encodings
+
+   DW_TAG_Compile_Unit : constant := 16#11#;
+
+   DW_AT_Stmt_List : constant := 16#10#;
+
+   DW_FORM_addr         : constant := 16#01#;
+   DW_FORM_block2       : constant := 16#03#;
+   DW_FORM_block4       : constant := 16#04#;
+   DW_FORM_data2        : constant := 16#05#;
+   DW_FORM_data4        : constant := 16#06#;
+   DW_FORM_data8        : constant := 16#07#;
+   DW_FORM_string       : constant := 16#08#;
+   DW_FORM_block        : constant := 16#09#;
+   DW_FORM_block1       : constant := 16#0a#;
+   DW_FORM_data1        : constant := 16#0b#;
+   DW_FORM_flag         : constant := 16#0c#;
+   DW_FORM_sdata        : constant := 16#0d#;
+   DW_FORM_strp         : constant := 16#0e#;
+   DW_FORM_udata        : constant := 16#0f#;
+   DW_FORM_ref_addr     : constant := 16#10#;
+   DW_FORM_ref1         : constant := 16#11#;
+   DW_FORM_ref2         : constant := 16#12#;
+   DW_FORM_ref4         : constant := 16#13#;
+   DW_FORM_ref8         : constant := 16#14#;
+   DW_FORM_ref_udata    : constant := 16#15#;
+   DW_FORM_indirect     : constant := 16#16#;
+   DW_FORM_sec_offset   : constant := 16#17#;
+   DW_FORM_exprloc      : constant := 16#18#;
+   DW_FORM_flag_present : constant := 16#19#;
+   DW_FORM_ref_sig8     : constant := 16#20#;
+
+   ---------
+   -- "<" --
+   ---------
+
+   function "<" (Left, Right : Search_Entry) return Boolean is
+   begin
+      return Left.First < Right.First;
+   end "<";
+
+   -----------
+   -- Close --
+   -----------
+
+   procedure Close (C : in out Dwarf_Context) is
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Object_File,
+         Object_File_Access);
+      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+        (Search_Array,
+         Search_Array_Access);
+   begin
+      if C.Has_Debug then
+         Close (C.Lines);
+         Close (C.Abbrev);
+         Close (C.Info);
+         Close (C.Aranges);
+      end if;
+
+      Close (C.Obj.all);
+      Unchecked_Deallocation (C.Obj);
+
+      Unchecked_Deallocation (C.Cache);
+   end Close;
+
+   ----------
+   -- Dump --
+   ----------
+
+   procedure Dump (C : in out Dwarf_Context) is
+   begin
+      For_Each_Row (C, Dump_Row'Access);
+   end Dump;
+
+   --------------
+   -- Dump_Row --
+   --------------
+
+   procedure Dump_Row (C : in out Dwarf_Context) is
+      PC  : constant Integer_Address := Integer_Address (C.Registers.Address);
+      Off : Offset;
+   begin
+      Tell (C.Lines, Off);
+
+      Put (System.Address_Image (To_Address (PC)));
+      Put (" ");
+      Put (To_File_Name (C, C.Registers.File));
+      Put (":");
+
+      declare
+         Image : constant String := uint32'Image (C.Registers.Line);
+      begin
+         Put_Line (Image (2 .. Image'Last));
+      end;
+
+      Seek (C.Lines, Off);
+   end Dump_Row;
+
+   procedure Dump_Cache (C : Dwarf_Context) is
+      Cache : constant Search_Array_Access := C.Cache;
+      S     : Object_Symbol;
+      Name  : String_Ptr_Len;
+   begin
+      if Cache = null then
+         Put_Line ("No cache");
+         return;
+      end if;
+      for I in Cache'Range loop
+         Put (System.Address_Image (C.Low + Storage_Count (Cache (I).First)));
+         Put (" - ");
+         Put
+           (System.Address_Image
+              (C.Low + Storage_Count (Cache (I).First + Cache (I).Size)));
+         Put (" l@");
+         Put
+           (System.Address_Image
+              (To_Address (Integer_Address (Cache (I).Line))));
+         Put (": ");
+         S    := Read_Symbol (C.Obj.all, Offset (Cache (I).Sym));
+         Name := Object_Reader.Name (C.Obj.all, S);
+         Put (String (Name.Ptr (1 .. Name.Len)));
+         New_Line;
+      end loop;
+   end Dump_Cache;
+
+   ------------------
+   -- For_Each_Row --
+   ------------------
+
+   procedure For_Each_Row (C : in out Dwarf_Context; F : Callback) is
+      Done : Boolean;
+
+   begin
+      Initialize_Pass (C);
+
+      loop
+         Read_And_Execute_Isn (C, Done);
+
+         if C.Registers.Is_Row then
+            F.all (C);
+         end if;
+
+         exit when Done;
+      end loop;
+   end For_Each_Row;
+
+   ---------------------
+   -- Initialize_Pass --
+   ---------------------
+
+   procedure Initialize_Pass (C : in out Dwarf_Context) is
+   begin
+      Seek (C.Lines, 0);
+      C.Next_Prologue := 0;
+
+      Initialize_State_Machine (C);
+   end Initialize_Pass;
+
+   ------------------------------
+   -- Initialize_State_Machine --
+   ------------------------------
+
+   procedure Initialize_State_Machine (C : in out Dwarf_Context) is
+   begin
+      C.Registers :=
+        (Address        => 0,
+         File           => 1,
+         Line           => 1,
+         Column         => 0,
+         Is_Stmt        => C.Prologue.Default_Is_Stmt = 0,
+         Basic_Block    => False,
+         End_Sequence   => False,
+         Prologue_End   => False,
+         Epilogue_Begin => False,
+         ISA            => 0,
+         Is_Row         => False);
+   end Initialize_State_Machine;
+
+   ---------------
+   -- Is_Inside --
+   ---------------
+
+   function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean is
+   begin
+      return Addr >= C.Low and Addr <= C.High;
+   end Is_Inside;
+
+   ---------
+   -- Low --
+   ---------
+
+   function Low (C : Dwarf_Context) return Address is
+   begin
+      return C.Low;
+   end Low;
+
+   ----------
+   -- Open --
+   ----------
+
+   procedure Open
+     (File_Name :     String;
+      C         : out Dwarf_Context;
+      Success   : out Boolean)
+   is
+      Line_Sec, Info_Sec, Abbrev_Sec, Aranges_Sec : Object_Section;
+      Hi, Lo                                      : uint64;
+   begin
+      --  Not a success by default
+
+      Success := False;
+
+      --  Open file
+
+      C.Obj := Open (File_Name, C.In_Exception);
+
+      if C.Obj = null then
+         return;
+      end if;
+
+      Success := True;
+
+      --  Get memory bounds
+
+      Get_Memory_Bounds (C.Obj.all, Lo, Hi);
+      C.Low  := Address (Lo);
+      C.High := Address (Hi);
+
+      --  Create a stream for debug sections
+
+      if Format (C.Obj.all) = XCOFF32 then
+         Line_Sec    := Get_Section (C.Obj.all, ".dwline");
+         Abbrev_Sec  := Get_Section (C.Obj.all, ".dwabrev");
+         Info_Sec    := Get_Section (C.Obj.all, ".dwinfo");
+         Aranges_Sec := Get_Section (C.Obj.all, ".dwarnge");
+      else
+         Line_Sec    := Get_Section (C.Obj.all, ".debug_line");
+         Abbrev_Sec  := Get_Section (C.Obj.all, ".debug_abbrev");
+         Info_Sec    := Get_Section (C.Obj.all, ".debug_info");
+         Aranges_Sec := Get_Section (C.Obj.all, ".debug_aranges");
+      end if;
+
+      if Line_Sec = Null_Section
+        or else Abbrev_Sec = Null_Section
+        or else Info_Sec = Null_Section
+        or else Aranges_Sec = Null_Section
+      then
+         C.Has_Debug := False;
+         return;
+      end if;
+
+      C.Lines   := Create_Stream (C.Obj.all, Line_Sec);
+      C.Abbrev  := Create_Stream (C.Obj.all, Abbrev_Sec);
+      C.Info    := Create_Stream (C.Obj.all, Info_Sec);
+      C.Aranges := Create_Stream (C.Obj.all, Aranges_Sec);
+
+      --  All operations are successful, context is valid
+
+      C.Has_Debug := True;
+   end Open;
+
+   --------------------
+   -- Parse_Prologue --
+   --------------------
+
+   procedure Parse_Prologue (C : in out Dwarf_Context) is
+      Char : uint8;
+      Prev : uint8;
+      --  The most recently read character and the one preceding it
+
+      Dummy : uint32;
+      --  Destination for reads we don't care about
+
+      Buf : Buffer;
+      Off : Offset;
+
+      First_Byte_Of_Prologue : Offset;
+      Last_Byte_Of_Prologue  : Offset;
+
+      Max_Op_Per_Insn : uint8;
+      pragma Unreferenced (Max_Op_Per_Insn);
+
+      Prologue : Line_Info_Prologue renames C.Prologue;
+
+   begin
+      Tell (C.Lines, First_Byte_Of_Prologue);
+      Prologue.Unit_Length := Read (C.Lines);
+      Tell (C.Lines, Off);
+      C.Next_Prologue := Off + Offset (Prologue.Unit_Length);
+
+      Prologue.Version         := Read (C.Lines);
+      Prologue.Prologue_Length := Read (C.Lines);
+      Tell (C.Lines, Last_Byte_Of_Prologue);
+      Last_Byte_Of_Prologue :=
+        Last_Byte_Of_Prologue + Offset (Prologue.Prologue_Length) - 1;
+
+      Prologue.Min_Isn_Length := Read (C.Lines);
+
+      if Prologue.Version >= 4 then
+         Max_Op_Per_Insn := Read (C.Lines);
+      end if;
+
+      Prologue.Default_Is_Stmt := Read (C.Lines);
+      Prologue.Line_Base       := Read (C.Lines);
+      Prologue.Line_Range      := Read (C.Lines);
+      Prologue.Opcode_Base     := Read (C.Lines);
+
+      --  Opcode_Lengths is an array of Opcode_Base bytes specifying the number
+      --  of LEB128 operands for each of the standard opcodes.
+
+      for J in 1 .. uint32 (Prologue.Opcode_Base - 1) loop
+         Prologue.Opcode_Lengths (J) := Read (C.Lines);
+      end loop;
+
+      --  The include directories table follows. This is a list of null
+      --  terminated strings terminated by a double null. We only store
+      --  its offset for later decoding.
+
+      Tell (C.Lines, Prologue.Includes_Offset);
+      Char := Read (C.Lines);
+
+      if Char /= 0 then
+         loop
+            Prev := Char;
+            Char := Read (C.Lines);
+            exit when Char = 0 and Prev = 0;
+         end loop;
+      end if;
+
+      --  The file_names table is next. Each record is a null terminated string
+      --  for the file name, an unsigned LEB128 directory index, an unsigned
+      --  LEB128 modification time, and an LEB128 file length. The table is
+      --  terminated by a null byte.
+
+      Tell (C.Lines, Prologue.File_Names_Offset);
+
+      loop
+         --  Read the filename
+
+         Read_C_String (C.Lines, Buf);
+         exit when Buf (0) = 0;
+         Dummy := Read_LEB128 (C.Lines); --  Skip the directory index.
+         Dummy := Read_LEB128 (C.Lines); --  Skip the modification time.
+         Dummy := Read_LEB128 (C.Lines); --  Skip the file length.
+      end loop;
+
+      --  Check we're where we think we are. This sanity check ensures we think
+      --  the prologue ends where the prologue says it does. It we aren't then
+      --  we've probably gotten out of sync somewhere.
+
+      Tell (C.Lines, Off);
+
+      if Prologue.Unit_Length /= 0
+        and then Off /= Last_Byte_Of_Prologue + 1
+      then
+         raise Dwarf_Error with "Parse error reading DWARF information";
+      end if;
+   end Parse_Prologue;
+
+   --------------------------
+   -- Read_And_Execute_Isn --
+   --------------------------
+
+   procedure Read_And_Execute_Isn
+     (C    : in out Dwarf_Context;
+      Done :    out Boolean)
+   is
+      Opcode          : uint8;
+      Extended_Opcode : uint8;
+      uint32_Operand  : uint32;
+      int32_Operand   : int32;
+      uint16_Operand  : uint16;
+      Off             : Offset;
+
+      Extended_Length : uint32;
+      pragma Unreferenced (Extended_Length);
+
+      Obj : Object_File renames C.Obj.all;
+      Registers : Line_Info_Registers renames C.Registers;
+      Prologue : Line_Info_Prologue renames C.Prologue;
+
+   begin
+      Done             := False;
+      Registers.Is_Row := False;
+
+      if Registers.End_Sequence then
+         Initialize_State_Machine (C);
+      end if;
+
+      --  Read the next prologue
+
+      Tell (C.Lines, Off);
+      while Off = C.Next_Prologue loop
+         Initialize_State_Machine (C);
+         Parse_Prologue (C);
+         Tell (C.Lines, Off);
+         exit when Off + 4 >= Length (C.Lines);
+      end loop;
+
+      --  Test whether we're done
+
+      Tell (C.Lines, Off);
+
+      --  We are finished when we either reach the end of the section, or we
+      --  have reached zero padding at the end of the section.
+
+      if Prologue.Unit_Length = 0 or else Off + 4 >= Length (C.Lines) then
+         Done := True;
+         return;
+      end if;
+
+      --  Read and interpret an instruction
+
+      Opcode := Read (C.Lines);
+
+      --  Extended opcodes
+
+      if Opcode = 0 then
+         Extended_Length := Read_LEB128 (C.Lines);
+         Extended_Opcode := Read (C.Lines);
+
+         case Extended_Opcode is
+            when DW_LNE_end_sequence =>
+
+               --  Mark the end of a sequence of source locations
+
+               Registers.End_Sequence := True;
+               Registers.Is_Row       := True;
+
+            when DW_LNE_set_address =>
+
+               --  Set the program counter to a word
+
+               Registers.Address := Read_Address (Obj, C.Lines);
+
+            when DW_LNE_define_file =>
+
+               --  Not implemented
+
+               raise Dwarf_Error with "DWARF operator not implemented";
+
+            when DW_LNE_set_discriminator =>
+
+               --  Ignored
+
+               int32_Operand := Read_LEB128 (C.Lines);
+
+            when others =>
+
+               --  Fail on an unrecognized opcode
+
+               raise Dwarf_Error with "DWARF operator not implemented";
+         end case;
+
+      --  Standard opcodes
+
+      elsif Opcode < Prologue.Opcode_Base then
+         case Opcode is
+
+            --  Append a row to the line info matrix
+
+            when DW_LNS_copy =>
+               Registers.Basic_Block := False;
+               Registers.Is_Row      := True;
+
+            --  Add an unsigned word to the program counter
+
+            when DW_LNS_advance_pc =>
+               uint32_Operand    := Read_LEB128 (C.Lines);
+               Registers.Address :=
+                 Registers.Address +
+                 uint64 (uint32_Operand * uint32 (Prologue.Min_Isn_Length));
+
+            --  Add a signed word to the current source line
+
+            when DW_LNS_advance_line =>
+               int32_Operand  := Read_LEB128 (C.Lines);
+               Registers.Line :=
+                 uint32 (int32 (Registers.Line) + int32_Operand);
+
+            --  Set the current source file
+
+            when DW_LNS_set_file =>
+               uint32_Operand := Read_LEB128 (C.Lines);
+               Registers.File := uint32_Operand;
+
+            --  Set the current source column
+
+            when DW_LNS_set_column =>
+               uint32_Operand   := Read_LEB128 (C.Lines);
+               Registers.Column := uint32_Operand;
+
+            --  Toggle the "is statement" flag. GCC doesn't seem to set this???
+
+            when DW_LNS_negate_stmt =>
+               Registers.Is_Stmt := not Registers.Is_Stmt;
+
+            --  Mark the beginning of a basic block
+
+            when DW_LNS_set_basic_block =>
+               Registers.Basic_Block := True;
+
+            --  Advance the program counter as by the special opcode 255
+
+            when DW_LNS_const_add_pc =>
+               Registers.Address :=
+                 Registers.Address +
+                 uint64
+                   (((255 - Prologue.Opcode_Base) / Prologue.Line_Range) *
+                    Prologue.Min_Isn_Length);
+
+            --  Advance the program counter by a constant
+
+            when DW_LNS_fixed_advance_pc =>
+               uint16_Operand    := Read (C.Lines);
+               Registers.Address :=
+                 Registers.Address + uint64 (uint16_Operand);
+
+            --  The following are not implemented and ignored
+
+            when DW_LNS_set_prologue_end =>
+               null;
+
+            when DW_LNS_set_epilogue_begin =>
+               null;
+
+            when DW_LNS_set_isa =>
+               null;
+
+            --  Anything else is an error
+
+            when others =>
+               raise Dwarf_Error with "DWARF operator not implemented";
+         end case;
+
+      --  Decode a special opcode. This is a line and address increment encoded
+      --  in a single byte 'special opcode' as described in 6.2.5.1.
+
+      else
+         declare
+            Address_Increment : int32;
+            Line_Increment    : int32;
+
+         begin
+            Opcode := Opcode - Prologue.Opcode_Base;
+
+            --  The adjusted opcode is a uint8 encoding an address increment
+            --  and a signed line increment. The upperbound is allowed to be
+            --  greater than int8'last so we decode using int32 directly to
+            --  prevent overflows.
+
+            Address_Increment :=
+              int32 (Opcode / Prologue.Line_Range) *
+              int32 (Prologue.Min_Isn_Length);
+            Line_Increment :=
+              int32 (Prologue.Line_Base) +
+              int32 (Opcode mod Prologue.Line_Range);
+
+            Registers.Address :=
+              Registers.Address + uint64 (Address_Increment);
+            Registers.Line := uint32 (int32 (Registers.Line) + Line_Increment);
+            Registers.Basic_Block    := False;
+            Registers.Prologue_End   := False;
+            Registers.Epilogue_Begin := False;
+            Registers.Is_Row         := True;
+         end;
+      end if;
+
+   exception
+      when Dwarf_Error =>
+
+         --  In case of errors during parse, just stop reading
+
+         Registers.Is_Row := False;
+         Done             := True;
+   end Read_And_Execute_Isn;
+
+   ----------------------
+   -- Set_Load_Address --
+   ----------------------
+
+   procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address) is
+   begin
+      if Addr = Null_Address then
+         return;
+      else
+         C.Load_Slide :=
+           To_Integer (Addr) - Integer_Address (Get_Load_Address (C.Obj.all));
+
+         C.Low  := To_Address (To_Integer (C.Low) + C.Load_Slide);
+         C.High := To_Address (To_Integer (C.High) + C.Load_Slide);
+      end if;
+   end Set_Load_Address;
+
+   ------------------
+   -- To_File_Name --
+   ------------------
+
+   function To_File_Name
+     (C    : in out Dwarf_Context;
+      Code :        uint32) return String
+   is
+      Buf : Buffer;
+      J   : uint32;
+
+      Dir_Idx : uint32;
+      pragma Unreferenced (Dir_Idx);
+
+      Mod_Time : uint32;
+      pragma Unreferenced (Mod_Time);
+
+      Length : uint32;
+      pragma Unreferenced (Length);
+
+   begin
+      Seek (C.Lines, C.Prologue.File_Names_Offset);
+
+      --  Find the entry
+
+      J := 0;
+      loop
+         J := J + 1;
+         Read_C_String (C.Lines, Buf);
+
+         if Buf (Buf'First) = 0 then
+            return "???";
+         end if;
+
+         Dir_Idx  := Read_LEB128 (C.Lines);
+         Mod_Time := Read_LEB128 (C.Lines);
+         Length   := Read_LEB128 (C.Lines);
+         exit when J = Code;
+      end loop;
+
+      return To_String (Buf);
+   end To_File_Name;
+
+   -------------------------
+   -- Read_Initial_Length --
+   -------------------------
+
+   procedure Read_Initial_Length
+     (S    : in out Mapped_Stream;
+      Len  :    out Offset;
+      Is64 :    out Boolean)
+   is
+      Len32 : uint32;
+      Len64 : uint64;
+   begin
+      Len32 := Read (S);
+      if Len32 < 16#ffff_fff0# then
+         Is64 := False;
+         Len  := Offset (Len32);
+      elsif Len32 < 16#ffff_ffff# then
+         --  Invalid length
+         raise Constraint_Error;
+      else
+         Is64  := True;
+         Len64 := Read (S);
+         Len   := Offset (Len64);
+      end if;
+   end Read_Initial_Length;
+
+   -------------------------
+   -- Read_Section_Offset --
+   -------------------------
+
+   procedure Read_Section_Offset
+     (S    : in out Mapped_Stream;
+      Len  :    out Offset;
+      Is64 :        Boolean)
+   is
+   begin
+      if Is64 then
+         Len := Offset (uint64'(Read (S)));
+      else
+         Len := Offset (uint32'(Read (S)));
+      end if;
+   end Read_Section_Offset;
+
+   --------------------
+   -- Aranges_Lookup --
+   --------------------
+
+   procedure Aranges_Lookup
+     (C           : in out Dwarf_Context;
+      Addr        :        Address;
+      Info_Offset :    out Offset;
+      Success     :    out Boolean)
+   is
+   begin
+      Seek (C.Aranges, 0);
+
+      while Tell (C.Aranges) < Length (C.Aranges) loop
+         Read_Aranges_Header (C, Info_Offset, Success);
+         exit when not Success;
+
+         loop
+            declare
+               Start : Integer_Address;
+               Len   : Storage_Count;
+            begin
+               Read_Aranges_Entry (C, Start, Len);
+               exit when Start = 0 and Len = 0;
+               if Addr >= To_Address (Start)
+                 and then Addr < To_Address (Start) + Len
+               then
+                  Success := True;
+                  return;
+               end if;
+            end;
+         end loop;
+      end loop;
+      Success := False;
+   end Aranges_Lookup;
+
+   ---------------
+   -- Skip_Form --
+   ---------------
+
+   procedure Skip_Form
+     (S      : in out Mapped_Stream;
+      Form   :        uint32;
+      Is64   :        Boolean;
+      Ptr_Sz :        uint8)
+   is
+      Skip : Offset;
+   begin
+      case Form is
+         when DW_FORM_addr =>
+            Skip := Offset (Ptr_Sz);
+         when DW_FORM_block2 =>
+            Skip := Offset (uint16'(Read (S)));
+         when DW_FORM_block4 =>
+            Skip := Offset (uint32'(Read (S)));
+         when DW_FORM_data2 | DW_FORM_ref2 =>
+            Skip := 2;
+         when DW_FORM_data4 | DW_FORM_ref4 =>
+            Skip := 4;
+         when DW_FORM_data8 | DW_FORM_ref8 | DW_FORM_ref_sig8 =>
+            Skip := 8;
+         when DW_FORM_string =>
+            while uint8'(Read (S)) /= 0 loop
+               null;
+            end loop;
+            return;
+         when DW_FORM_block | DW_FORM_exprloc =>
+            Skip := Offset (uint32'(Read_LEB128 (S)));
+         when DW_FORM_block1 | DW_FORM_ref1 =>
+            Skip := Offset (uint8'(Read (S)));
+         when DW_FORM_data1 | DW_FORM_flag =>
+            Skip := 1;
+         when DW_FORM_sdata =>
+            declare
+               Val : constant int32 := Read_LEB128 (S);
+               pragma Unreferenced (Val);
+            begin
+               return;
+            end;
+         when DW_FORM_strp | DW_FORM_ref_addr | DW_FORM_sec_offset =>
+            Skip := (if Is64 then 8 else 4);
+         when DW_FORM_udata | DW_FORM_ref_udata =>
+            declare
+               Val : constant uint32 := Read_LEB128 (S);
+               pragma Unreferenced (Val);
+            begin
+               return;
+            end;
+         when DW_FORM_flag_present =>
+            return;
+         when DW_FORM_indirect =>
+            raise Constraint_Error;
+         when others =>
+            raise Constraint_Error;
+      end case;
+      Seek (S, Tell (S) + Skip);
+   end Skip_Form;
+
+   -----------------
+   -- Seek_Abbrev --
+   -----------------
+
+   procedure Seek_Abbrev
+     (C             : in out Dwarf_Context;
+      Abbrev_Offset :        Offset;
+      Abbrev_Num    :        uint32)
+   is
+      Num       : uint32;
+      Abbrev    : uint32;
+      Tag       : uint32;
+      Has_Child : uint8;
+      pragma Unreferenced (Abbrev, Tag, Has_Child);
+   begin
+      Seek (C.Abbrev, Abbrev_Offset);
+
+      Num := 1;
+
+      loop
+         exit when Num = Abbrev_Num;
+
+         Abbrev    := Read_LEB128 (C.Abbrev);
+         Tag       := Read_LEB128 (C.Abbrev);
+         Has_Child := Read (C.Abbrev);
+
+         loop
+            declare
+               Name : constant uint32 := Read_LEB128 (C.Abbrev);
+               Form : constant uint32 := Read_LEB128 (C.Abbrev);
+            begin
+               exit when Name = 0 and Form = 0;
+            end;
+         end loop;
+
+         Num := Num + 1;
+      end loop;
+   end Seek_Abbrev;
+
+   -----------------------
+   -- Debug_Info_Lookup --
+   -----------------------
+
+   procedure Debug_Info_Lookup
+     (C           : in out Dwarf_Context;
+      Info_Offset :        Offset;
+      Line_Offset :    out Offset;
+      Success     :    out Boolean)
+   is
+      Unit_Length   : Offset;
+      Is64          : Boolean;
+      Version       : uint16;
+      Abbrev_Offset : Offset;
+      Addr_Sz       : uint8;
+      Abbrev        : uint32;
+      Has_Child     : uint8;
+      pragma Unreferenced (Has_Child);
+   begin
+      Success := False;
+
+      Seek (C.Info, Info_Offset);
+
+      Read_Initial_Length (C.Info, Unit_Length, Is64);
+
+      Version := Read (C.Info);
+      if Version not in 2 .. 4 then
+         return;
+      end if;
+
+      Read_Section_Offset (C.Info, Abbrev_Offset, Is64);
+
+      Addr_Sz := Read (C.Info);
+      if Addr_Sz /= (Address'Size / SSU) then
+         return;
+      end if;
+
+      --  Read DIEs
+
+      loop
+         Abbrev := Read_LEB128 (C.Info);
+         exit when Abbrev /= 0;
+      end loop;
+
+      --  Read abbrev table
+
+      Seek_Abbrev (C, Abbrev_Offset, Abbrev);
+
+      --  First ULEB128 is the abbrev code
+
+      if Read_LEB128 (C.Abbrev) /= Abbrev then
+         --  Ill formed abbrev table
+         return;
+      end if;
+
+      --  Then the tag
+
+      if Read_LEB128 (C.Abbrev) /= uint32'(DW_TAG_Compile_Unit) then
+         --  Expect compile unit
+         return;
+      end if;
+
+      --  Then the has child flag
+
+      Has_Child := Read (C.Abbrev);
+
+      loop
+         declare
+            Name : constant uint32 := Read_LEB128 (C.Abbrev);
+            Form : constant uint32 := Read_LEB128 (C.Abbrev);
+         begin
+            exit when Name = 0 and Form = 0;
+            if Name = DW_AT_Stmt_List then
+               case Form is
+                  when DW_FORM_sec_offset =>
+                     Read_Section_Offset (C.Info, Line_Offset, Is64);
+                  when DW_FORM_data4 =>
+                     Line_Offset := Offset (uint32'(Read (C.Info)));
+                  when DW_FORM_data8 =>
+                     Line_Offset := Offset (uint64'(Read (C.Info)));
+                  when others =>
+                     --  Unhandled form
+                     return;
+               end case;
+
+               Success := True;
+               return;
+            else
+               Skip_Form (C.Info, Form, Is64, Addr_Sz);
+            end if;
+         end;
+      end loop;
+
+      return;
+   end Debug_Info_Lookup;
+
+   -------------------------
+   -- Read_Aranges_Header --
+   -------------------------
+
+   procedure Read_Aranges_Header
+     (C           : in out Dwarf_Context;
+      Info_Offset :    out Offset;
+      Success     :    out Boolean)
+   is
+      Unit_Length : Offset;
+      Is64        : Boolean;
+      Version     : uint16;
+      Sz          : uint8;
+   begin
+      Success := False;
+
+      Read_Initial_Length (C.Aranges, Unit_Length, Is64);
+
+      Version := Read (C.Aranges);
+      if Version /= 2 then
+         return;
+      end if;
+
+      Read_Section_Offset (C.Aranges, Info_Offset, Is64);
+
+      --  Read address_size (ubyte)
+
+      Sz := Read (C.Aranges);
+      if Sz /= (Address'Size / SSU) then
+         return;
+      end if;
+
+      --  Read segment_size (ubyte)
+
+      Sz := Read (C.Aranges);
+      if Sz /= 0 then
+         return;
+      end if;
+
+      --  Handle alignment on twice the address size
+      declare
+         Cur_Off : constant Offset := Tell (C.Aranges);
+         Align   : constant Offset := 2 * Address'Size / SSU;
+         Space   : constant Offset := Cur_Off mod Align;
+      begin
+         if Space /= 0 then
+            Seek (C.Aranges, Cur_Off + Align - Space);
+         end if;
+      end;
+
+      Success := True;
+   end Read_Aranges_Header;
+
+   ------------------------
+   -- Read_Aranges_Entry --
+   ------------------------
+
+   procedure Read_Aranges_Entry
+     (C     : in out Dwarf_Context;
+      Start :    out Integer_Address;
+      Len   :    out Storage_Count)
+   is
+   begin
+      --  Read table
+      if Address'Size = 32 then
+         declare
+            S, L : uint32;
+         begin
+            S     := Read (C.Aranges);
+            L     := Read (C.Aranges);
+            Start := Integer_Address (S);
+            Len   := Storage_Count (L);
+         end;
+      elsif Address'Size = 64 then
+         declare
+            S, L : uint64;
+         begin
+            S     := Read (C.Aranges);
+            L     := Read (C.Aranges);
+            Start := Integer_Address (S);
+            Len   := Storage_Count (L);
+         end;
+      else
+         raise Constraint_Error;
+      end if;
+   end Read_Aranges_Entry;
+
+   ------------------
+   -- Enable_Cache --
+   ------------------
+
+   procedure Enable_Cache (C : in out Dwarf_Context) is
+      Cache : Search_Array_Access;
+   begin
+      --  Phase 1: count number of symbols. Phase 2: fill the cache.
+      declare
+         S               : Object_Symbol;
+         Sz              : uint32;
+         Addr, Prev_Addr : uint32;
+         Nbr_Symbols     : Natural;
+      begin
+         for Phase in 1 .. 2 loop
+            Nbr_Symbols := 0;
+            S           := First_Symbol (C.Obj.all);
+            Prev_Addr   := uint32'Last;
+            while S /= Null_Symbol loop
+               --  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);
+                  end if;
+               end if;
+
+               S := Next_Symbol (C.Obj.all, S);
+            end loop;
+
+            if Phase = 1 then
+               --  Allocate the cache
+               Cache   := new Search_Array (1 .. Nbr_Symbols);
+               C.Cache := Cache;
+            end if;
+         end loop;
+         pragma Assert (Nbr_Symbols = C.Cache'Last);
+      end;
+
+      --  Sort the cache.
+      Sort_Search_Array (C.Cache.all);
+
+      --  Set line offsets
+      if not C.Has_Debug then
+         return;
+      end if;
+      declare
+         Info_Offset : Offset;
+         Line_Offset : Offset;
+         Success     : Boolean;
+         Ar_Start    : Integer_Address;
+         Ar_Len      : Storage_Count;
+         Start, Len  : uint32;
+         First, Last : Natural;
+         Mid         : Natural;
+      begin
+         Seek (C.Aranges, 0);
+
+         while Tell (C.Aranges) < Length (C.Aranges) loop
+            Read_Aranges_Header (C, Info_Offset, Success);
+            exit when not Success;
+
+            Debug_Info_Lookup (C, Info_Offset, Line_Offset, Success);
+            exit when not Success;
+
+            --  Read table
+            loop
+               Read_Aranges_Entry (C, Ar_Start, Ar_Len);
+               exit when Ar_Start = 0 and Ar_Len = 0;
+
+               Len   := uint32 (Ar_Len);
+               Start := uint32 (Ar_Start - To_Integer (C.Low));
+
+               --  Search START in the array
+               First := Cache'First;
+               Last  := Cache'Last;
+               Mid := First;  --  In case of array with one element
+               while First < Last loop
+                  Mid := First + (Last - First) / 2;
+                  if Start < Cache (Mid).First then
+                     Last := Mid - 1;
+                  elsif Start >= Cache (Mid).First + Cache (Mid).Size then
+                     First := Mid + 1;
+                  else
+                     exit;
+                  end if;
+               end loop;
+
+               --  Fill info.
+
+               --  There can be overlapping symbols
+               while Mid > Cache'First
+                 and then Cache (Mid - 1).First <= Start
+                 and then Cache (Mid - 1).First + Cache (Mid - 1).Size > Start
+               loop
+                  Mid := Mid - 1;
+               end loop;
+               while Mid <= Cache'Last loop
+                  if Start < Cache (Mid).First + Cache (Mid).Size
+                    and then Start + Len > Cache (Mid).First
+                  then
+                     --  MID is within the bounds
+                     Cache (Mid).Line := uint32 (Line_Offset);
+                  elsif Start + Len <= Cache (Mid).First then
+                     --  Over
+                     exit;
+                  end if;
+                  Mid := Mid + 1;
+               end loop;
+            end loop;
+         end loop;
+      end;
+   end Enable_Cache;
+
+   ----------------------
+   -- Symbolic_Address --
+   ----------------------
+
+   procedure Symbolic_Address
+     (C           : in out Dwarf_Context;
+      Addr        :        Address;
+      Dir_Name    :    out Str_Access;
+      File_Name   :    out Str_Access;
+      Subprg_Name :    out String_Ptr_Len;
+      Line_Num    :    out Natural)
+   is
+      procedure Set_Result (Match : Line_Info_Registers);
+      --  Set results using match
+
+      procedure Set_Result (Match : Line_Info_Registers) is
+         Dir_Idx : uint32;
+         J       : uint32;
+
+         Mod_Time : uint32;
+         pragma Unreferenced (Mod_Time);
+
+         Length : uint32;
+         pragma Unreferenced (Length);
+
+      begin
+         Seek (C.Lines, C.Prologue.File_Names_Offset);
+
+         --  Find the entry
+
+         J := 0;
+         loop
+            J         := J + 1;
+            File_Name := Read_C_String (C.Lines);
+
+            if File_Name (File_Name'First) = ASCII.NUL then
+               --  End of file list, so incorrect entry
+               return;
+            end if;
+
+            Dir_Idx  := Read_LEB128 (C.Lines);
+            Mod_Time := Read_LEB128 (C.Lines);
+            Length   := Read_LEB128 (C.Lines);
+            exit when J = Match.File;
+         end loop;
+
+         if Dir_Idx = 0 then
+            --  No directory
+            Dir_Name := null;
+
+         else
+            Seek (C.Lines, C.Prologue.Includes_Offset);
+
+            J := 0;
+            loop
+               J        := J + 1;
+               Dir_Name := Read_C_String (C.Lines);
+
+               if Dir_Name (Dir_Name'First) = ASCII.NUL then
+                  --  End of directory list, so ill-formed table
+                  return;
+               end if;
+
+               exit when J = Dir_Idx;
+
+            end loop;
+         end if;
+
+         Line_Num := Natural (Match.Line);
+      end Set_Result;
+
+      Addr_Int     : constant Integer_Address := To_Integer (Addr);
+      Previous_Row : Line_Info_Registers;
+      Info_Offset  : Offset;
+      Line_Offset  : Offset;
+      Success      : Boolean;
+      Done         : Boolean;
+      S            : Object_Symbol;
+   begin
+      --  Initialize result
+      Dir_Name    := null;
+      File_Name   := null;
+      Subprg_Name := (null, 0);
+      Line_Num    := 0;
+
+      if C.Cache /= null then
+         --  Look in the cache
+         declare
+            Addr_Off         : constant uint32 := uint32 (Addr - C.Low);
+            First, Last, Mid : Natural;
+         begin
+            First := C.Cache'First;
+            Last  := C.Cache'Last;
+            while First <= Last loop
+               Mid := First + (Last - First) / 2;
+               if Addr_Off < C.Cache (Mid).First then
+                  Last := Mid - 1;
+               elsif Addr_Off >= C.Cache (Mid).First + C.Cache (Mid).Size then
+                  First := Mid + 1;
+               else
+                  exit;
+               end if;
+            end loop;
+            if Addr_Off >= C.Cache (Mid).First
+              and then Addr_Off < C.Cache (Mid).First + C.Cache (Mid).Size
+            then
+               Line_Offset := Offset (C.Cache (Mid).Line);
+               S := Read_Symbol (C.Obj.all, Offset (C.Cache (Mid).Sym));
+               Subprg_Name := Object_Reader.Name (C.Obj.all, S);
+            else
+               --  Not found
+               return;
+            end if;
+         end;
+      else
+         --  Search symbol
+         S := First_Symbol (C.Obj.all);
+         while S /= Null_Symbol loop
+            if Spans (S, uint64 (Addr_Int)) then
+               Subprg_Name := Object_Reader.Name (C.Obj.all, S);
+               exit;
+            end if;
+
+            S := Next_Symbol (C.Obj.all, S);
+         end loop;
+
+         --  Search address in aranges table
+
+         Aranges_Lookup (C, Addr, Info_Offset, Success);
+         if not Success then
+            return;
+         end if;
+
+         --  Search stmt_list in info table
+
+         Debug_Info_Lookup (C, Info_Offset, Line_Offset, Success);
+         if not Success then
+            return;
+         end if;
+      end if;
+
+      Seek (C.Lines, Line_Offset);
+      C.Next_Prologue := 0;
+      Initialize_State_Machine (C);
+      Parse_Prologue (C);
+
+      --  Advance to the first entry
+
+      loop
+         Read_And_Execute_Isn (C, Done);
+
+         if C.Registers.Is_Row then
+            Previous_Row := C.Registers;
+            exit;
+         end if;
+
+         exit when Done;
+      end loop;
+
+      --  Read the rest of the entries
+
+      while Tell (C.Lines) < C.Next_Prologue loop
+         Read_And_Execute_Isn (C, Done);
+
+         if C.Registers.Is_Row then
+            if not Previous_Row.End_Sequence
+              and then Addr_Int >= Integer_Address (Previous_Row.Address)
+              and then Addr_Int < Integer_Address (C.Registers.Address)
+            then
+               Set_Result (Previous_Row);
+               return;
+
+            elsif Addr_Int = Integer_Address (C.Registers.Address) then
+               Set_Result (C.Registers);
+               return;
+            end if;
+
+            Previous_Row := C.Registers;
+         end if;
+
+         exit when Done;
+      end loop;
+   end Symbolic_Address;
+
+   -------------------
+   -- String_Length --
+   -------------------
+
+   function String_Length (Str : Str_Access) return Natural is
+   begin
+      for I in Str'Range loop
+         if Str (I) = ASCII.NUL then
+            return I - Str'First;
+         end if;
+      end loop;
+      return Str'Last;
+   end String_Length;
+
+   ------------------------
+   -- Symbolic_Traceback --
+   ------------------------
+
+   procedure Symbolic_Traceback
+     (Cin          :        Dwarf_Context;
+      Traceback    :        AET.Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Symbol_Found : in out Boolean;
+      Res          : in out System.Bounded_Strings.Bounded_String)
+   is
+      use Ada.Characters.Handling;
+      C    : Dwarf_Context := Cin;
+      Addr : Address;
+
+      Dir_Name    : Str_Access;
+      File_Name   : Str_Access;
+      Subprg_Name : String_Ptr_Len;
+      Line_Num    : Natural;
+      Off         : Natural;
+   begin
+      if not C.Has_Debug then
+         Symbol_Found := False;
+         return;
+      else
+         Symbol_Found := True;
+      end if;
+
+      for J in Traceback'Range loop
+         --  If the buffer is full, no need to do any useless work
+         exit when Is_Full (Res);
+
+         Addr := PC_For (Traceback (J));
+         Symbolic_Address
+           (C,
+            To_Address (To_Integer (Addr) + C.Load_Slide),
+            Dir_Name,
+            File_Name,
+            Subprg_Name,
+            Line_Num);
+
+         if File_Name /= null then
+            declare
+               Last   : constant Natural := String_Length (File_Name);
+               Is_Ada : constant Boolean :=
+                 Last > 3
+                 and then
+                   To_Upper (String (File_Name (Last - 3 .. Last - 1))) =
+                   ".AD";
+               --  True if this is an Ada file. This doesn't take into account
+               --  nonstandard file-naming conventions, but that's OK; this is
+               --  purely cosmetic. It covers at least .ads, .adb, and .ada.
+
+               Line_Image : constant String := Natural'Image (Line_Num);
+            begin
+               if Subprg_Name.Len /= 0 then
+                  --  For Ada code, Symbol_Image is in all lower case; we don't
+                  --  have the case from the original source code. But the best
+                  --  guess is Mixed_Case, so convert to that.
+
+                  if Is_Ada then
+                     declare
+                        Symbol_Image : String :=
+                          Object_Reader.Decoded_Ada_Name
+                            (C.Obj.all,
+                             Subprg_Name);
+                     begin
+                        for K in Symbol_Image'Range loop
+                           if K = Symbol_Image'First
+                             or else not
+                             (Is_Letter (Symbol_Image (K - 1))
+                              or else Is_Digit (Symbol_Image (K - 1)))
+                           then
+                              Symbol_Image (K) := To_Upper (Symbol_Image (K));
+                           end if;
+                        end loop;
+                        Append (Res, Symbol_Image);
+                     end;
+                  else
+                     Off := Strip_Leading_Char (C.Obj.all, Subprg_Name);
+
+                     Append
+                       (Res,
+                        String (Subprg_Name.Ptr (Off .. Subprg_Name.Len)));
+                  end if;
+                  Append (Res, ' ');
+               end if;
+
+               Append (Res, "at ");
+               Append (Res, String (File_Name (1 .. Last)));
+               Append (Res, ':');
+               Append (Res, Line_Image (2 .. Line_Image'Last));
+            end;
+         else
+            if Suppress_Hex then
+               Append (Res, "...");
+            else
+               Append_Address (Res, Addr);
+            end if;
+
+            if Subprg_Name.Len > 0 then
+               Off := Strip_Leading_Char (C.Obj.all, Subprg_Name);
+
+               Append (Res, ' ');
+               Append (Res, String (Subprg_Name.Ptr (Off .. Subprg_Name.Len)));
+            end if;
+
+            Append (Res, " at ???");
+         end if;
+
+         Append (Res, ASCII.LF);
+      end loop;
+   end Symbolic_Traceback;
+end System.Dwarf_Lines;
diff --git a/gcc/ada/s-dwalin.ads b/gcc/ada/s-dwalin.ads
new file mode 100644
index 0000000..3608fef
--- /dev/null
+++ b/gcc/ada/s-dwalin.ads
@@ -0,0 +1,191 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                   S Y S T E M . D W A R F _ L I N E S                    --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--           Copyright (C) 2009-2017, Free Software Foundation, Inc.        --
+--                                                                          --
+-- 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 package provides routines to read DWARF line number information from
+--  a generic object file with as little overhead as possible. This allows
+--  conversions from PC addresses to human readable source locations.
+--
+--  Objects must be built with debugging information, however only the
+--  .debug_line section of the object file is referenced. In cases where object
+--  size is a consideration it's possible to strip all other .debug sections,
+--  which will decrease the size of the object significantly.
+
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we can get
+--  elaboration circularities when polling is turned on
+
+with Ada.Exceptions.Traceback;
+
+with System.Object_Reader;
+with System.Storage_Elements;
+with System.Bounded_Strings;
+
+package System.Dwarf_Lines is
+
+   package AET renames Ada.Exceptions.Traceback;
+   package SOR renames System.Object_Reader;
+
+   type Dwarf_Context (In_Exception : Boolean := False) is private;
+   --  Type encapsulation the state of the Dwarf reader. When In_Exception
+   --  is True we are parsing as part of a exception handler decorator, we do
+   --  not want an exception to be raised, the parsing is done safely skipping
+   --  DWARF file that cannot be read or with stripped debug section for
+   --  example.
+
+   procedure Open
+     (File_Name :     String;
+      C         : out Dwarf_Context;
+      Success   : out Boolean);
+   procedure Close (C : in out Dwarf_Context);
+   --  Open and close files
+
+   procedure Set_Load_Address (C : in out Dwarf_Context; Addr : Address);
+   --  Set the load address of a file. This is used to rebase PIE (Position
+   --  Independant Executable) binaries.
+
+   function Is_Inside (C : Dwarf_Context; Addr : Address) return Boolean;
+   pragma Inline (Is_Inside);
+   --  Return true iff Addr is within the module
+
+   function Low (C : Dwarf_Context) return Address;
+   pragma Inline (Low);
+   --  Return the lowest address of C
+
+   procedure Dump (C : in out Dwarf_Context);
+   --  Dump each row found in the object's .debug_lines section to standard out
+
+   procedure Dump_Cache (C : Dwarf_Context);
+   --  Dump the cache (if present)
+
+   procedure Enable_Cache (C : in out Dwarf_Context);
+   --  Read symbols information to speed up Symbolic_Traceback.
+
+   procedure Symbolic_Traceback
+     (Cin          :        Dwarf_Context;
+      Traceback    :        AET.Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Symbol_Found : in out Boolean;
+      Res          : in out System.Bounded_Strings.Bounded_String);
+   --  Generate a string for a traceback suitable for displaying to the user.
+   --  If one or more symbols are found, Symbol_Found is set to True. This
+   --  allows the caller to fall back to hexadecimal addresses.
+
+   Dwarf_Error : exception;
+   --  Raised if a problem is encountered parsing DWARF information. Can be a
+   --  result of a logic error or malformed DWARF information.
+
+private
+   --  The following section numbers reference
+
+   --    "DWARF Debugging Information Format, Version 3"
+
+   --  published by the Standards Group, http://freestandards.org.
+
+   --  6.2.2 State Machine Registers
+
+   type Line_Info_Registers is record
+      Address        : SOR.uint64;
+      File           : SOR.uint32;
+      Line           : SOR.uint32;
+      Column         : SOR.uint32;
+      Is_Stmt        : Boolean;
+      Basic_Block    : Boolean;
+      End_Sequence   : Boolean;
+      Prologue_End   : Boolean;
+      Epilogue_Begin : Boolean;
+      ISA            : SOR.uint32;
+      Is_Row         : Boolean;
+   end record;
+
+   --  6.2.4 The Line Number Program Prologue
+
+   MAX_OPCODE_LENGTHS : constant := 256;
+
+   type Opcodes_Lengths_Array is
+     array (SOR.uint32 range 1 .. MAX_OPCODE_LENGTHS) of SOR.uint8;
+
+   type Line_Info_Prologue is record
+      Unit_Length       : SOR.uint32;
+      Version           : SOR.uint16;
+      Prologue_Length   : SOR.uint32;
+      Min_Isn_Length    : SOR.uint8;
+      Default_Is_Stmt   : SOR.uint8;
+      Line_Base         : SOR.int8;
+      Line_Range        : SOR.uint8;
+      Opcode_Base       : SOR.uint8;
+      Opcode_Lengths    : Opcodes_Lengths_Array;
+      Includes_Offset   : SOR.Offset;
+      File_Names_Offset : SOR.Offset;
+   end record;
+
+   type Search_Entry is record
+      First : SOR.uint32;
+      Size  : SOR.uint32;
+      --  Function bounds as offset to the base address.
+
+      Sym : SOR.uint32;
+      --  Symbol offset to get the name.
+
+      Line : SOR.uint32;
+      --  Dwarf line offset.
+   end record;
+
+   type Search_Array is array (Natural range <>) of Search_Entry;
+
+   type Search_Array_Access is access Search_Array;
+
+   type Dwarf_Context (In_Exception : Boolean := False) is record
+      Load_Slide : System.Storage_Elements.Integer_Address := 0;
+      Low, High  : Address;
+      --  Bounds of the module
+
+      Obj : SOR.Object_File_Access;
+      --  The object file containing dwarf sections
+
+      Has_Debug : Boolean;
+      --  True if all debug sections are available
+
+      Cache : Search_Array_Access;
+      --  Quick access to symbol and debug info (when present).
+
+      Lines   : SOR.Mapped_Stream;
+      Aranges : SOR.Mapped_Stream;
+      Info    : SOR.Mapped_Stream;
+      Abbrev  : SOR.Mapped_Stream;
+      --  Dwarf line, aranges, info and abbrev sections
+
+      Prologue      : Line_Info_Prologue;
+      Registers     : Line_Info_Registers;
+      Next_Prologue : SOR.Offset;
+      --  State for lines
+   end record;
+
+end System.Dwarf_Lines;
diff --git a/gcc/ada/s-objrea.adb b/gcc/ada/s-objrea.adb
new file mode 100644
index 0000000..451abcd
--- /dev/null
+++ b/gcc/ada/s-objrea.adb
@@ -0,0 +1,2246 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 S Y S T E M . O B J E C T _ R E A D E R                  --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--         Copyright (C) 2009-2017, Free Software Foundation, Inc.          --
+--                                                                          --
+-- 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Conversion;
+
+with Interfaces.C;
+
+with System.CRTL;
+
+package body System.Object_Reader is
+   use Interfaces;
+   use Interfaces.C;
+   use System.Mmap;
+
+   SSU : constant := System.Storage_Unit;
+
+   function To_int32 is new Ada.Unchecked_Conversion (uint32, int32);
+
+   function Trim_Trailing_Nuls (Str : String) return String;
+   --  Return a copy of a string with any trailing NUL characters truncated
+
+   procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32);
+   --  Check that the SIZE bytes at the current offset are still in the stream
+
+   -------------------------------------
+   -- ELF object file format handling --
+   -------------------------------------
+
+   generic
+      type uword is mod <>;
+
+   package ELF_Ops is
+
+      --  ELF version codes
+
+      ELFCLASS32 : constant := 1;  --  32 bit ELF
+      ELFCLASS64 : constant := 2;  --  64 bit ELF
+
+      --  ELF machine codes
+
+      EM_NONE        : constant :=  0; --  No machine
+      EM_SPARC       : constant :=  2; --  SUN SPARC
+      EM_386         : constant :=  3; --  Intel 80386
+      EM_MIPS        : constant :=  8; --  MIPS RS3000 Big-Endian
+      EM_MIPS_RS3_LE : constant := 10; --  MIPS RS3000 Little-Endian
+      EM_SPARC32PLUS : constant := 18; --  Sun SPARC 32+
+      EM_PPC         : constant := 20; --  PowerPC
+      EM_PPC64       : constant := 21; --  PowerPC 64-bit
+      EM_ARM         : constant := 40; --  ARM
+      EM_SPARCV9     : constant := 43; --  SPARC v9 64-bit
+      EM_IA_64       : constant := 50; --  Intel Merced
+      EM_X86_64      : constant := 62; --  AMD x86-64 architecture
+
+      EN_NIDENT  : constant := 16;
+
+      type E_Ident_Type is array (0 .. EN_NIDENT - 1) of uint8;
+
+      type Header is record
+         E_Ident     : E_Ident_Type; -- Magic number and other info
+         E_Type      : uint16;       -- Object file type
+         E_Machine   : uint16;       -- Architecture
+         E_Version   : uint32;       -- Object file version
+         E_Entry     : uword;        -- Entry point virtual address
+         E_Phoff     : uword;        -- Program header table file offset
+         E_Shoff     : uword;        -- Section header table file offset
+         E_Flags     : uint32;       -- Processor-specific flags
+         E_Ehsize    : uint16;       -- ELF header size in bytes
+         E_Phentsize : uint16;       -- Program header table entry size
+         E_Phnum     : uint16;       -- Program header table entry count
+         E_Shentsize : uint16;       -- Section header table entry size
+         E_Shnum     : uint16;       -- Section header table entry count
+         E_Shstrndx  : uint16;       -- Section header string table index
+      end record;
+
+      type Section_Header is record
+         Sh_Name      : uint32; -- Section name string table index
+         Sh_Type      : uint32; -- Section type
+         Sh_Flags     : uword;  -- Section flags
+         Sh_Addr      : uword;  -- Section virtual addr at execution
+         Sh_Offset    : uword;  -- Section file offset
+         Sh_Size      : uword;  -- Section size in bytes
+         Sh_Link      : uint32; -- Link to another section
+         Sh_Info      : uint32; -- Additional section information
+         Sh_Addralign : uword;  -- Section alignment
+         Sh_Entsize   : uword;  -- Entry size if section holds table
+      end record;
+
+      SHF_ALLOC : constant := 2;
+
+      type Symtab_Entry32 is record
+         St_Name  : uint32;  --  Name (string table index)
+         St_Value : uint32;  --  Value
+         St_Size  : uint32;  --  Size in bytes
+         St_Info  : uint8;   --  Type and binding attributes
+         St_Other : uint8;   --  Undefined
+         St_Shndx : uint16;  --  Defining section
+      end record;
+
+      type Symtab_Entry64 is record
+         St_Name  : uint32;  --  Name (string table index)
+         St_Info  : uint8;   --  Type and binding attributes
+         St_Other : uint8;   --  Undefined
+         St_Shndx : uint16;  --  Defining section
+         St_Value : uint64;  --  Value
+         St_Size  : uint64;  --  Size in bytes
+      end record;
+
+      function Read_Header (F : in out Mapped_Stream) return Header;
+      --  Read a header from an ELF format object
+
+      function First_Symbol
+        (Obj : in out ELF_Object_File) return Object_Symbol;
+      --  Return the first element in the symbol table, or Null_Symbol if the
+      --  symbol table is empty.
+
+      function Read_Symbol
+        (Obj : in out ELF_Object_File;
+         Off : Offset) return Object_Symbol;
+      --  Read a symbol at offset Off
+
+      function Name
+        (Obj : in out ELF_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len;
+      --  Return the name of the symbol
+
+      function Name
+        (Obj : in out ELF_Object_File;
+         Sec : Object_Section) return String;
+      --  Return the name of a section
+
+      function Get_Section
+        (Obj   : in out ELF_Object_File;
+         Shnum : uint32) return Object_Section;
+      --  Fetch a section by index from zero
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return ELF_Object_File;
+      --  Initialize an object file
+
+   end ELF_Ops;
+
+   -----------------------------------
+   -- PECOFF object format handling --
+   -----------------------------------
+
+   package PECOFF_Ops is
+
+      --  Constants and data layout are taken from the document "Microsoft
+      --  Portable Executable and Common Object File Format Specification"
+      --  Revision 8.1.
+
+      Signature_Loc_Offset : constant := 16#3C#;
+      --  Offset of pointer to the file signature
+
+      Size_Of_Standard_Header_Fields : constant := 16#18#;
+      --  Length in bytes of the standard header record
+
+      Function_Symbol_Type : constant := 16#20#;
+      --  Type field value indicating a symbol refers to a function
+
+      Not_Function_Symbol_Type : constant := 16#00#;
+      --  Type field value indicating a symbol does not refer to a function
+
+      type Magic_Array is array (0 .. 3) of uint8;
+      --  Array of magic numbers from the header
+
+      --  Magic numbers for PECOFF variants
+
+      VARIANT_PE32      : constant := 16#010B#;
+      VARIANT_PE32_PLUS : constant := 16#020B#;
+
+      --  PECOFF machine codes
+
+      IMAGE_FILE_MACHINE_I386  : constant := 16#014C#;
+      IMAGE_FILE_MACHINE_IA64  : constant := 16#0200#;
+      IMAGE_FILE_MACHINE_AMD64 : constant := 16#8664#;
+
+      --  PECOFF Data layout
+
+      type Header is record
+         Magics               : Magic_Array;
+         Machine              : uint16;
+         NumberOfSections     : uint16;
+         TimeDateStamp        : uint32;
+         PointerToSymbolTable : uint32;
+         NumberOfSymbols      : uint32;
+         SizeOfOptionalHeader : uint16;
+         Characteristics      : uint16;
+         Variant              : uint16;
+      end record;
+
+      pragma Pack (Header);
+
+      type Optional_Header_PE32 is record
+         Magic                       : uint16;
+         MajorLinkerVersion          : uint8;
+         MinorLinkerVersion          : uint8;
+         SizeOfCode                  : uint32;
+         SizeOfInitializedData       : uint32;
+         SizeOfUninitializedData     : uint32;
+         AddressOfEntryPoint         : uint32;
+         BaseOfCode                  : uint32;
+         BaseOfData                  : uint32; --  Note: not in PE32+
+         ImageBase                   : uint32;
+         SectionAlignment            : uint32;
+         FileAlignment               : uint32;
+         MajorOperatingSystemVersion : uint16;
+         MinorOperationSystemVersion : uint16;
+         MajorImageVersion           : uint16;
+         MinorImageVersion           : uint16;
+         MajorSubsystemVersion       : uint16;
+         MinorSubsystemVersion       : uint16;
+         Win32VersionValue           : uint32;
+         SizeOfImage                 : uint32;
+         SizeOfHeaders               : uint32;
+         Checksum                    : uint32;
+         Subsystem                   : uint16;
+         DllCharacteristics          : uint16;
+         SizeOfStackReserve          : uint32;
+         SizeOfStackCommit           : uint32;
+         SizeOfHeapReserve           : uint32;
+         SizeOfHeapCommit            : uint32;
+         LoaderFlags                 : uint32;
+         NumberOfRvaAndSizes         : uint32;
+      end record;
+      pragma Pack (Optional_Header_PE32);
+      pragma Assert (Optional_Header_PE32'Size = 96 * SSU);
+
+      type Optional_Header_PE64 is record
+         Magic                       : uint16;
+         MajorLinkerVersion          : uint8;
+         MinorLinkerVersion          : uint8;
+         SizeOfCode                  : uint32;
+         SizeOfInitializedData       : uint32;
+         SizeOfUninitializedData     : uint32;
+         AddressOfEntryPoint         : uint32;
+         BaseOfCode                  : uint32;
+         ImageBase                   : uint64;
+         SectionAlignment            : uint32;
+         FileAlignment               : uint32;
+         MajorOperatingSystemVersion : uint16;
+         MinorOperationSystemVersion : uint16;
+         MajorImageVersion           : uint16;
+         MinorImageVersion           : uint16;
+         MajorSubsystemVersion       : uint16;
+         MinorSubsystemVersion       : uint16;
+         Win32VersionValue           : uint32;
+         SizeOfImage                 : uint32;
+         SizeOfHeaders               : uint32;
+         Checksum                    : uint32;
+         Subsystem                   : uint16;
+         DllCharacteristics          : uint16;
+         SizeOfStackReserve          : uint64;
+         SizeOfStackCommit           : uint64;
+         SizeOfHeapReserve           : uint64;
+         SizeOfHeapCommit            : uint64;
+         LoaderFlags                 : uint32;
+         NumberOfRvaAndSizes         : uint32;
+      end record;
+      pragma Pack (Optional_Header_PE64);
+      pragma Assert (Optional_Header_PE64'Size = 112 * SSU);
+
+      subtype Name_Str is String (1 .. 8);
+
+      type Section_Header is record
+         Name                 : Name_Str;
+         VirtualSize          : uint32;
+         VirtualAddress       : uint32;
+         SizeOfRawData        : uint32;
+         PointerToRawData     : uint32;
+         PointerToRelocations : uint32;
+         PointerToLinenumbers : uint32;
+         NumberOfRelocations  : uint16;
+         NumberOfLinenumbers  : uint16;
+         Characteristics      : uint32;
+      end record;
+
+      pragma Pack (Section_Header);
+
+      IMAGE_SCN_CNT_CODE : constant := 16#0020#;
+
+      type Symtab_Entry is record
+         Name                  : Name_Str;
+         Value                 : uint32;
+         SectionNumber         : int16;
+         TypeField             : uint16;
+         StorageClass          : uint8;
+         NumberOfAuxSymbols    : uint8;
+      end record;
+
+      pragma Pack (Symtab_Entry);
+
+      type Auxent_Section is record
+         Length              : uint32;
+         NumberOfRelocations : uint16;
+         NumberOfLinenumbers : uint16;
+         CheckSum            : uint32;
+         Number              : uint16;
+         Selection           : uint8;
+         Unused1             : uint8;
+         Unused2             : uint8;
+         Unused3             : uint8;
+      end record;
+
+      for Auxent_Section'Size use 18 * 8;
+
+      function Read_Header (F : in out Mapped_Stream) return Header;
+      --  Read the object file header
+
+      function First_Symbol
+        (Obj : in out PECOFF_Object_File) return Object_Symbol;
+      --  Return the first element in the symbol table, or Null_Symbol if the
+      --  symbol table is empty.
+
+      function Read_Symbol
+        (Obj : in out PECOFF_Object_File;
+         Off : Offset) return Object_Symbol;
+      --  Read a symbol at offset Off
+
+      function Name
+        (Obj : in out PECOFF_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len;
+      --  Return the name of the symbol
+
+      function Name
+        (Obj : in out PECOFF_Object_File;
+         Sec : Object_Section) return String;
+      --  Return the name of a section
+
+      function Get_Section
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return Object_Section;
+      --  Fetch a section by index from zero
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return PECOFF_Object_File;
+      --  Initialize an object file
+
+   end PECOFF_Ops;
+
+   -------------------------------------
+   -- XCOFF-32 object format handling --
+   -------------------------------------
+
+   package XCOFF32_Ops is
+
+      --  XCOFF Data layout
+
+      type Header is record
+         f_magic  : uint16;
+         f_nscns  : uint16;
+         f_timdat : uint32;
+         f_symptr : uint32;
+         f_nsyms  : uint32;
+         f_opthdr : uint16;
+         f_flags  : uint16;
+      end record;
+
+      type Auxiliary_Header is record
+         o_mflag      : uint16;
+         o_vstamp     : uint16;
+         o_tsize      : uint32;
+         o_dsize      : uint32;
+         o_bsize      : uint32;
+         o_entry      : uint32;
+         o_text_start : uint32;
+         o_data_start : uint32;
+         o_toc        : uint32;
+         o_snentry    : uint16;
+         o_sntext     : uint16;
+         o_sndata     : uint16;
+         o_sntoc      : uint16;
+         o_snloader   : uint16;
+         o_snbss      : uint16;
+         o_algntext   : uint16;
+         o_algndata   : uint16;
+         o_modtype    : uint16;
+         o_cpuflag    : uint8;
+         o_cputype    : uint8;
+         o_maxstack   : uint32;
+         o_maxdata    : uint32;
+         o_debugger   : uint32;
+         o_flags      : uint8;
+         o_sntdata    : uint16;
+         o_sntbss     : uint16;
+      end record;
+      pragma Unreferenced (Auxiliary_Header);
+      --  Not used, but not removed (just in case)
+
+      subtype Name_Str is String (1 .. 8);
+
+      type Section_Header is record
+         s_name    : Name_Str;
+         s_paddr   : uint32;
+         s_vaddr   : uint32;
+         s_size    : uint32;
+         s_scnptr  : uint32;
+         s_relptr  : uint32;
+         s_lnnoptr : uint32;
+         s_nreloc  : uint16;
+         s_nlnno   : uint16;
+         s_flags   : uint32;
+      end record;
+
+      pragma Pack (Section_Header);
+
+      STYP_TEXT : constant := 16#0020#;
+
+      type Symbol_Entry is record
+         n_name   : Name_Str;
+         n_value  : uint32;
+         n_scnum  : uint16;
+         n_type   : uint16;
+         n_sclass : uint8;
+         n_numaux : uint8;
+      end record;
+      for Symbol_Entry'Size use 18 * 8;
+
+      type Aux_Entry is record
+         x_scnlen   : uint32;
+         x_parmhash : uint32;
+         x_snhash   : uint16;
+         x_smtyp    : uint8;
+         x_smclass  : uint8;
+         x_stab     : uint32;
+         x_snstab   : uint16;
+      end record;
+      for Aux_Entry'Size use 18 * 8;
+
+      pragma Pack (Aux_Entry);
+
+      C_EXT     : constant := 2;
+      C_HIDEXT  : constant := 107;
+      C_WEAKEXT : constant := 111;
+
+      XTY_LD : constant := 2;
+      --  Magic constant should be documented, especially since it's changed???
+
+      function Read_Header (F : in out Mapped_Stream) return Header;
+      --  Read the object file header
+
+      function First_Symbol
+        (Obj : in out XCOFF32_Object_File) return Object_Symbol;
+      --  Return the first element in the symbol table, or Null_Symbol if the
+      --  symbol table is empty.
+
+      function Read_Symbol
+        (Obj : in out XCOFF32_Object_File;
+         Off : Offset) return Object_Symbol;
+      --  Read a symbol at offset Off
+
+      function Name
+        (Obj : in out XCOFF32_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len;
+      --  Return the name of the symbol
+
+      function Name
+        (Obj : in out XCOFF32_Object_File;
+         Sec : Object_Section) return String;
+      --  Return the name of a section
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return XCOFF32_Object_File;
+      --  Initialize an object file
+
+      function Get_Section
+          (Obj   : in out XCOFF32_Object_File;
+           Index : uint32) return Object_Section;
+      --  Fetch a section by index from zero
+
+   end XCOFF32_Ops;
+
+   -------------
+   -- ELF_Ops --
+   -------------
+
+   package body ELF_Ops is
+
+      function Get_String_Table (Obj : in out ELF_Object_File)
+                                return Object_Section;
+      --  Fetch the section containing the string table
+
+      function Get_Symbol_Table (Obj : in out ELF_Object_File)
+                                return Object_Section;
+      --  Fetch the section containing the symbol table
+
+      function Read_Section_Header
+        (Obj   : in out ELF_Object_File;
+         Shnum : uint32) return Section_Header;
+      --  Read the header for an ELF format object section indexed from zero
+
+      ------------------
+      -- First_Symbol --
+      ------------------
+
+      function First_Symbol
+        (Obj : in out ELF_Object_File) return Object_Symbol
+      is
+      begin
+         if Obj.Symtab_Last = 0 then
+            return Null_Symbol;
+         else
+            return Read_Symbol (Obj, 0);
+         end if;
+      end First_Symbol;
+
+      -----------------
+      -- Get_Section --
+      -----------------
+
+      function Get_Section
+        (Obj   : in out ELF_Object_File;
+         Shnum : uint32) return Object_Section
+      is
+         SHdr : constant Section_Header := Read_Section_Header (Obj, Shnum);
+      begin
+         return (Shnum,
+                 Offset (SHdr.Sh_Offset),
+                 uint64 (SHdr.Sh_Addr),
+                 uint64 (SHdr.Sh_Size),
+                 (SHdr.Sh_Flags and SHF_ALLOC) /= 0);
+      end Get_Section;
+
+      ------------------------
+      --  Get_String_Table  --
+      ------------------------
+
+      function Get_String_Table
+        (Obj : in out ELF_Object_File) return Object_Section
+      is
+      begin
+         --  All cases except MIPS IRIX, string table located in .strtab
+
+         if Obj.Arch /= MIPS then
+            return Get_Section (Obj, ".strtab");
+
+         --  On IRIX only .dynstr is available
+
+         else
+            return Get_Section (Obj, ".dynstr");
+         end if;
+      end Get_String_Table;
+
+      ------------------------
+      --  Get_Symbol_Table  --
+      ------------------------
+
+      function Get_Symbol_Table
+        (Obj : in out ELF_Object_File) return Object_Section
+      is
+      begin
+         --  All cases except MIPS IRIX, symbol table located in .symtab
+
+         if Obj.Arch /= MIPS then
+            return Get_Section (Obj, ".symtab");
+
+         --  On IRIX, symbol table located somewhere other than .symtab
+
+         else
+            return Get_Section (Obj, ".dynsym");
+         end if;
+      end Get_Symbol_Table;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return ELF_Object_File
+      is
+         Res : ELF_Object_File
+           (Format => (case uword'Size is
+                         when 64 => ELF64,
+                         when 32 => ELF32,
+                         when others => raise Program_Error));
+         Sec : Object_Section;
+      begin
+         Res.MF := F;
+         Res.In_Exception := In_Exception;
+         Res.Num_Sections := uint32 (Hdr.E_Shnum);
+
+         case Hdr.E_Machine is
+            when EM_SPARC
+               | EM_SPARC32PLUS
+            =>
+               Res.Arch := SPARC;
+
+            when EM_386 =>
+               Res.Arch := i386;
+
+            when EM_MIPS
+               | EM_MIPS_RS3_LE
+            =>
+               Res.Arch := MIPS;
+
+            when EM_PPC =>
+               Res.Arch := PPC;
+
+            when EM_PPC64 =>
+               Res.Arch := PPC64;
+
+            when EM_SPARCV9 =>
+               Res.Arch := SPARC64;
+
+            when EM_IA_64 =>
+               Res.Arch := IA64;
+
+            when EM_X86_64 =>
+               Res.Arch := x86_64;
+
+            when others =>
+               raise Format_Error with "unrecognized architecture";
+         end case;
+
+         --  Map section table and section string table
+         Res.Sectab_Stream := Create_Stream
+           (F, File_Size (Hdr.E_Shoff),
+            File_Size (Hdr.E_Shnum) * File_Size (Hdr.E_Shentsize));
+         Sec := Get_Section (Res, uint32 (Hdr.E_Shstrndx));
+         Res.Secstr_Stream := Create_Stream (Res, Sec);
+
+         --  Map symbol and string table
+         Sec := Get_Symbol_Table (Res);
+         Res.Symtab_Stream := Create_Stream (Res, Sec);
+         Res.Symtab_Last := Offset (Sec.Size);
+
+         Sec := Get_String_Table (Res);
+         Res.Symstr_Stream := Create_Stream (Res, Sec);
+
+         return Res;
+      end Initialize;
+
+      -----------------
+      -- Read_Header --
+      -----------------
+
+      function Read_Header (F : in out Mapped_Stream) return Header is
+         Hdr : Header;
+      begin
+         Seek (F, 0);
+         Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU));
+         return Hdr;
+      end Read_Header;
+
+      -------------------------
+      -- Read_Section_Header --
+      -------------------------
+
+      function Read_Section_Header
+        (Obj   : in out ELF_Object_File;
+         Shnum : uint32) return Section_Header
+      is
+         Shdr : Section_Header;
+      begin
+         Seek (Obj.Sectab_Stream, Offset (Shnum * Section_Header'Size / SSU));
+         Read_Raw (Obj.Sectab_Stream, Shdr'Address, Section_Header'Size / SSU);
+         return Shdr;
+      end Read_Section_Header;
+
+      -----------------
+      -- Read_Symbol --
+      -----------------
+
+      function Read_Symbol
+        (Obj : in out ELF_Object_File;
+         Off : Offset) return Object_Symbol
+      is
+         ST_Entry32 : Symtab_Entry32;
+         ST_Entry64 : Symtab_Entry64;
+         Res        : Object_Symbol;
+
+      begin
+         Seek (Obj.Symtab_Stream, Off);
+
+         case uword'Size is
+            when 32 =>
+               Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address,
+                         uint32 (ST_Entry32'Size / SSU));
+               Res := (Off,
+                       Off + ST_Entry32'Size / SSU,
+                       uint64 (ST_Entry32.St_Value),
+                       uint64 (ST_Entry32.St_Size));
+
+            when 64 =>
+               Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address,
+                         uint32 (ST_Entry64'Size / SSU));
+               Res := (Off,
+                       Off + ST_Entry64'Size / SSU,
+                       ST_Entry64.St_Value,
+                       ST_Entry64.St_Size);
+
+            when others =>
+               raise Program_Error;
+         end case;
+
+         return Res;
+      end Read_Symbol;
+
+      ----------
+      -- Name --
+      ----------
+
+      function Name
+        (Obj : in out ELF_Object_File;
+         Sec : Object_Section) return String
+      is
+         SHdr : Section_Header;
+      begin
+         SHdr := Read_Section_Header (Obj, Sec.Num);
+         return Offset_To_String (Obj.Secstr_Stream, Offset (SHdr.Sh_Name));
+      end Name;
+
+      function Name
+        (Obj : in out ELF_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len
+      is
+         ST_Entry32 : Symtab_Entry32;
+         ST_Entry64 : Symtab_Entry64;
+         Name_Off   : Offset;
+
+      begin
+         --  Test that this symbol is not null
+
+         if Sym = Null_Symbol then
+            return (null, 0);
+         end if;
+
+         --  Read the symbol table entry
+
+         Seek (Obj.Symtab_Stream, Sym.Off);
+
+         case uword'Size is
+            when 32 =>
+               Read_Raw (Obj.Symtab_Stream, ST_Entry32'Address,
+                         uint32 (ST_Entry32'Size / SSU));
+               Name_Off := Offset (ST_Entry32.St_Name);
+
+            when 64 =>
+               Read_Raw (Obj.Symtab_Stream, ST_Entry64'Address,
+                         uint32 (ST_Entry64'Size / SSU));
+               Name_Off := Offset (ST_Entry64.St_Name);
+
+            when others =>
+               raise Program_Error;
+         end case;
+
+         --  Fetch the name from the string table
+
+         Seek (Obj.Symstr_Stream, Name_Off);
+         return Read (Obj.Symstr_Stream);
+      end Name;
+
+   end ELF_Ops;
+
+   package ELF32_Ops is new ELF_Ops (uint32);
+   package ELF64_Ops is new ELF_Ops (uint64);
+
+   ----------------
+   -- PECOFF_Ops --
+   ----------------
+
+   package body PECOFF_Ops is
+
+      function Decode_Name
+        (Obj      : in out PECOFF_Object_File;
+         Raw_Name : String) return String;
+      --  A section name is an 8 byte field padded on the right with null
+      --  characters, or a '\' followed by an ASCII decimal string indicating
+      --  an offset in to the string table. This routine decodes this
+
+      function Get_Section_Virtual_Address
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return uint64;
+      --  Fetch the address at which a section is loaded
+
+      function Read_Section_Header
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return Section_Header;
+      --  Read a header from section table
+
+      function String_Table
+        (Obj   : in out PECOFF_Object_File;
+         Index : Offset) return String;
+      --  Return an entry from the string table
+
+      -----------------
+      -- Decode_Name --
+      -----------------
+
+      function Decode_Name
+        (Obj      : in out PECOFF_Object_File;
+         Raw_Name : String) return String
+      is
+         Name_Or_Ref : constant String := Trim_Trailing_Nuls (Raw_Name);
+         Off         : Offset;
+
+      begin
+         --  We should never find a symbol with a zero length name. If we do it
+         --  probably means we are not parsing the symbol table correctly. If
+         --  this happens we raise a fatal error.
+
+         if Name_Or_Ref'Length = 0 then
+            raise Format_Error with
+              "found zero length symbol in symbol table";
+         end if;
+
+         if Name_Or_Ref (1) /= '/' then
+            return Name_Or_Ref;
+         else
+            Off := Offset'Value (Name_Or_Ref (2 .. Name_Or_Ref'Last));
+            return String_Table (Obj, Off);
+         end if;
+      end Decode_Name;
+
+      ------------------
+      -- First_Symbol --
+      ------------------
+
+      function First_Symbol
+        (Obj : in out PECOFF_Object_File) return Object_Symbol is
+      begin
+         --  Return Null_Symbol in the case that the symbol table is empty
+
+         if Obj.Symtab_Last = 0 then
+            return Null_Symbol;
+         end if;
+
+         return Read_Symbol (Obj, 0);
+      end First_Symbol;
+
+      -----------------
+      -- Get_Section --
+      -----------------
+
+      function Get_Section
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return Object_Section
+      is
+         Sec : constant Section_Header := Read_Section_Header (Obj, Index);
+      begin
+         --  Use VirtualSize instead of SizeOfRawData. The latter is rounded to
+         --  the page size, so it may add garbage to the content. On the other
+         --  side, the former may be larger than the latter in case of 0
+         --  padding.
+
+         return (Index,
+                 Offset (Sec.PointerToRawData),
+                 uint64 (Sec.VirtualAddress) + Obj.ImageBase,
+                 uint64 (Sec.VirtualSize),
+                 (Sec.Characteristics and IMAGE_SCN_CNT_CODE) /= 0);
+      end Get_Section;
+
+      ---------------------------------
+      -- Get_Section_Virtual_Address --
+      ---------------------------------
+
+      function Get_Section_Virtual_Address
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return uint64
+      is
+         Sec : Section_Header;
+
+      begin
+         --  Try cache
+
+         if Index = Obj.GSVA_Sec then
+            return Obj.GSVA_Addr;
+         end if;
+
+         Obj.GSVA_Sec := Index;
+         Sec := Read_Section_Header (Obj, Index);
+         Obj.GSVA_Addr := Obj.ImageBase + uint64 (Sec.VirtualAddress);
+         return Obj.GSVA_Addr;
+      end Get_Section_Virtual_Address;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return PECOFF_Object_File
+      is
+         Res        : PECOFF_Object_File
+           (Format => (case Hdr.Variant is
+                         when PECOFF_Ops.VARIANT_PE32 => PECOFF,
+                         when PECOFF_Ops.VARIANT_PE32_PLUS => PECOFF_PLUS,
+                         when others => raise Program_Error
+                                          with "unrecognized PECOFF variant"));
+         Symtab_Size : constant Offset :=
+           Offset (Hdr.NumberOfSymbols) * (Symtab_Entry'Size / SSU);
+         Strtab_Size : uint32;
+         Hdr_Offset : Offset;
+         Opt_Offset : File_Size;
+         Opt_Stream : Mapped_Stream;
+      begin
+         Res.MF := F;
+         Res.In_Exception := In_Exception;
+
+         case Hdr.Machine is
+            when PECOFF_Ops.IMAGE_FILE_MACHINE_I386  =>
+               Res.Arch := i386;
+            when PECOFF_Ops.IMAGE_FILE_MACHINE_IA64  =>
+               Res.Arch := IA64;
+            when PECOFF_Ops.IMAGE_FILE_MACHINE_AMD64 =>
+               Res.Arch := x86_64;
+            when others =>
+               raise Format_Error with "unrecognized architecture";
+         end case;
+
+         Res.Num_Sections := uint32 (Hdr.NumberOfSections);
+
+         --  Map symbol table and the first following word (which is the length
+         --  of the string table).
+
+         Res.Symtab_Last  := Symtab_Size;
+         Res.Symtab_Stream := Create_Stream
+           (F,
+            File_Size (Hdr.PointerToSymbolTable),
+            File_Size (Symtab_Size + 4));
+
+         --  Map string table. The first 4 bytes are the length of the string
+         --  table and are part of it.
+
+         Seek (Res.Symtab_Stream, Symtab_Size);
+         Strtab_Size := Read (Res.Symtab_Stream);
+         Res.Symstr_Stream := Create_Stream
+           (F,
+            File_Size (Hdr.PointerToSymbolTable) + File_Size (Symtab_Size),
+            File_Size (Strtab_Size));
+
+         --  Map section table
+
+         Opt_Stream := Create_Stream (Res.Mf, Signature_Loc_Offset, 4);
+         Hdr_Offset := Offset (uint32'(Read (Opt_Stream)));
+         Close (Opt_Stream);
+         Res.Sectab_Stream := Create_Stream
+           (F,
+            File_Size (Hdr_Offset +
+                         Size_Of_Standard_Header_Fields +
+                         Offset (Hdr.SizeOfOptionalHeader)),
+            File_Size (Res.Num_Sections)
+              * File_Size (Section_Header'Size / SSU));
+
+         --  Read optional header and extract image base
+
+         Opt_Offset := File_Size (Hdr_Offset + Size_Of_Standard_Header_Fields);
+
+         if Res.Format = PECOFF then
+            declare
+               Opt_32 : Optional_Header_PE32;
+            begin
+               Opt_Stream := Create_Stream
+                 (Res.Mf, Opt_Offset, Opt_32'Size / SSU);
+               Read_Raw
+                 (Opt_Stream, Opt_32'Address, uint32 (Opt_32'Size / SSU));
+               Res.ImageBase := uint64 (Opt_32.ImageBase);
+               Close (Opt_Stream);
+            end;
+
+         else
+            declare
+               Opt_64 : Optional_Header_PE64;
+            begin
+               Opt_Stream := Create_Stream
+                 (Res.Mf, Opt_Offset, Opt_64'Size / SSU);
+               Read_Raw
+                 (Opt_Stream, Opt_64'Address, uint32 (Opt_64'Size / SSU));
+               Res.ImageBase := Opt_64.ImageBase;
+               Close (Opt_Stream);
+            end;
+         end if;
+
+         return Res;
+      end Initialize;
+
+      -----------------
+      -- Read_Symbol --
+      -----------------
+
+      function Read_Symbol
+        (Obj : in out PECOFF_Object_File;
+         Off : Offset) return Object_Symbol
+      is
+         ST_Entry  : Symtab_Entry;
+         ST_Last   : Symtab_Entry;
+         Aux_Entry : Auxent_Section;
+         Sz        : constant Offset := ST_Entry'Size / SSU;
+         Result    : Object_Symbol;
+         Noff      : Offset;
+         Sym_Off   : Offset;
+
+      begin
+         --  Seek to the successor of Prev
+
+         Noff := Off;
+
+         loop
+            Sym_Off := Noff;
+
+            Seek (Obj.Symtab_Stream, Sym_Off);
+            Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, uint32 (Sz));
+
+            --  Skip AUX entries
+
+            Noff := Noff + Offset (1 + ST_Entry.NumberOfAuxSymbols) * Sz;
+
+            exit when ST_Entry.TypeField = Function_Symbol_Type
+              and then ST_Entry.SectionNumber > 0;
+
+            if Noff >= Obj.Symtab_Last then
+               return Null_Symbol;
+            end if;
+         end loop;
+
+         --  Construct the symbol
+
+         Result :=
+           (Off   => Sym_Off,
+            Next  => Noff,
+            Value => uint64 (ST_Entry.Value),
+            Size  => 0);
+
+         --  Set the size as accurately as possible
+
+         --  The size of a symbol is not directly available so we try scanning
+         --  to the next function and assuming the code ends there.
+
+         loop
+            --  Read symbol and AUX entries
+
+            Sym_Off := Noff;
+            Seek (Obj.Symtab_Stream, Sym_Off);
+            Read_Raw (Obj.Symtab_Stream, ST_Last'Address, uint32 (Sz));
+
+            for I in 1 .. ST_Last.NumberOfAuxSymbols loop
+               Read_Raw (Obj.Symtab_Stream, Aux_Entry'Address, uint32 (Sz));
+            end loop;
+
+            Noff := Noff + Offset (1 + ST_Last.NumberOfAuxSymbols) * Sz;
+
+            if ST_Last.TypeField = Function_Symbol_Type then
+               if ST_Last.SectionNumber = ST_Entry.SectionNumber
+                 and then ST_Last.Value >= ST_Entry.Value
+               then
+                  --  Symbol is a function past ST_Entry
+
+                  Result.Size := uint64 (ST_Last.Value - ST_Entry.Value);
+
+               else
+                  --  Not correlated function
+
+                  Result.Next := Sym_Off;
+               end if;
+
+               exit;
+
+            elsif ST_Last.SectionNumber = ST_Entry.SectionNumber
+              and then ST_Last.TypeField = Not_Function_Symbol_Type
+              and then ST_Last.StorageClass = 3
+              and then ST_Last.NumberOfAuxSymbols = 1
+            then
+               --  Symbol is a section
+
+               Result.Size := uint64 (ST_Last.Value + Aux_Entry.Length
+                                        - ST_Entry.Value);
+               Result.Next := Noff;
+               exit;
+            end if;
+
+            exit when Noff >= Obj.Symtab_Last;
+         end loop;
+
+         --  Relocate the address
+
+         Result.Value :=
+           Result.Value + Get_Section_Virtual_Address
+                            (Obj, uint32 (ST_Entry.SectionNumber - 1));
+
+         return Result;
+      end Read_Symbol;
+
+      ------------------
+      -- Read_Header  --
+      ------------------
+
+      function Read_Header (F : in out Mapped_Stream) return Header is
+         Hdr : Header;
+         Off : int32;
+
+      begin
+         --  Skip the MSDOS stub, and seek directly to the file offset
+
+         Seek (F, Signature_Loc_Offset);
+         Off := Read (F);
+
+         --  Read the COFF file header
+
+         Seek (F, Offset (Off));
+         Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU));
+         return Hdr;
+      end Read_Header;
+
+      -------------------------
+      -- Read_Section_Header --
+      -------------------------
+
+      function Read_Section_Header
+        (Obj   : in out PECOFF_Object_File;
+         Index : uint32) return Section_Header
+      is
+         Sec : Section_Header;
+      begin
+         Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU));
+         Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU);
+         return Sec;
+      end Read_Section_Header;
+
+      ----------
+      -- Name --
+      ----------
+
+      function Name
+        (Obj : in out PECOFF_Object_File;
+         Sec : Object_Section) return String
+      is
+         Shdr : constant Section_Header := Read_Section_Header (Obj, Sec.Num);
+      begin
+         return Decode_Name (Obj, Shdr.Name);
+      end Name;
+
+      -------------------
+      -- String_Table  --
+      -------------------
+
+      function String_Table
+        (Obj   : in out PECOFF_Object_File;
+         Index : Offset) return String is
+      begin
+         --  An index of zero is used to represent an empty string, as the
+         --  first word of the string table is specified to contain the length
+         --  of the table rather than its contents.
+
+         if Index = 0 then
+            return "";
+
+         else
+            return Offset_To_String (Obj.Symstr_Stream, Index);
+         end if;
+      end String_Table;
+
+      ----------
+      -- Name --
+      ----------
+
+      function Name
+        (Obj : in out PECOFF_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len
+      is
+         ST_Entry : Symtab_Entry;
+
+      begin
+         Seek (Obj.Symtab_Stream, Sym.Off);
+         Read_Raw (Obj.Symtab_Stream, ST_Entry'Address, ST_Entry'Size / SSU);
+
+         declare
+            --  Symbol table entries are packed and Table_Entry.Name may not be
+            --  sufficiently aligned to interpret as a 32 bit word, so it is
+            --  copied to a temporary
+
+            Aligned_Name : Name_Str := ST_Entry.Name;
+            for Aligned_Name'Alignment use 4;
+
+            First_Word : uint32;
+            pragma Import (Ada, First_Word);
+            --  Suppress initialization in Normalized_Scalars mode
+            for First_Word'Address use Aligned_Name (1)'Address;
+
+            Second_Word : uint32;
+            pragma Import (Ada, Second_Word);
+            --  Suppress initialization in Normalized_Scalars mode
+            for Second_Word'Address use Aligned_Name (5)'Address;
+
+         begin
+            if First_Word = 0 then
+               --  Second word is an offset in the symbol table
+               if Second_Word = 0 then
+                  return (null, 0);
+               else
+                  Seek (Obj.Symstr_Stream, int64 (Second_Word));
+                  return Read (Obj.Symstr_Stream);
+               end if;
+            else
+               --  Inlined symbol name
+               Seek (Obj.Symtab_Stream, Sym.Off);
+               return To_String_Ptr_Len (Read (Obj.Symtab_Stream), 8);
+            end if;
+         end;
+      end Name;
+
+   end PECOFF_Ops;
+
+   -----------------
+   -- XCOFF32_Ops --
+   -----------------
+
+   package body XCOFF32_Ops is
+
+      function Read_Section_Header
+        (Obj   : in out XCOFF32_Object_File;
+         Index : uint32) return Section_Header;
+      --  Read a header from section table
+
+      -----------------
+      -- Read_Symbol --
+      -----------------
+
+      function Read_Symbol
+        (Obj : in out XCOFF32_Object_File;
+         Off : Offset) return Object_Symbol
+      is
+         Sym     : Symbol_Entry;
+         Sz      : constant Offset := Symbol_Entry'Size / SSU;
+         Aux     : Aux_Entry;
+         Result  : Object_Symbol;
+         Noff    : Offset;
+         Sym_Off : Offset;
+
+         procedure Read_LD_Symbol;
+         --  Read the next LD symbol
+
+         --------------------
+         -- Read_LD_Symbol --
+         --------------------
+
+         procedure Read_LD_Symbol is
+         begin
+            loop
+               Sym_Off := Noff;
+
+               Read_Raw (Obj.Symtab_Stream, Sym'Address, uint32 (Sz));
+
+               Noff := Noff + Offset (1 + Sym.n_numaux) * Sz;
+
+               for J in 1 .. Sym.n_numaux loop
+                  Read_Raw (Obj.Symtab_Stream, Aux'Address, uint32 (Sz));
+               end loop;
+
+               exit when Noff >= Obj.Symtab_Last;
+
+               exit when Sym.n_numaux = 1
+                 and then Sym.n_scnum /= 0
+                 and then (Sym.n_sclass = C_EXT
+                           or else Sym.n_sclass = C_HIDEXT
+                           or else Sym.n_sclass = C_WEAKEXT)
+                 and then Aux.x_smtyp = XTY_LD;
+            end loop;
+         end Read_LD_Symbol;
+
+      --  Start of processing for Read_Symbol
+
+      begin
+         Seek (Obj.Symtab_Stream, Off);
+         Noff := Off;
+         Read_LD_Symbol;
+
+         if Noff >= Obj.Symtab_Last then
+            return Null_Symbol;
+         end if;
+
+         --  Construct the symbol
+
+         Result := (Off   => Sym_Off,
+                    Next  => Noff,
+                    Value => uint64 (Sym.n_value),
+                    Size  => 0);
+
+         --  Look for the next symbol to compute the size
+
+         Read_LD_Symbol;
+
+         if Noff >= Obj.Symtab_Last then
+            return Null_Symbol;
+         end if;
+
+         Result.Size := uint64 (Sym.n_value) - Result.Value;
+         Result.Next := Sym_Off;
+         return Result;
+      end Read_Symbol;
+
+      ------------------
+      -- First_Symbol --
+      ------------------
+
+      function First_Symbol
+        (Obj : in out XCOFF32_Object_File) return Object_Symbol
+      is
+      begin
+         --  Return Null_Symbol in the case that the symbol table is empty
+
+         if Obj.Symtab_Last = 0 then
+            return Null_Symbol;
+         end if;
+
+         return Read_Symbol (Obj, 0);
+      end First_Symbol;
+
+      ----------------
+      -- Initialize --
+      ----------------
+
+      function Initialize
+        (F            : Mapped_File;
+         Hdr          : Header;
+         In_Exception : Boolean) return XCOFF32_Object_File
+      is
+         Res : XCOFF32_Object_File (Format => XCOFF32);
+         Strtab_Sz : uint32;
+      begin
+         Res.Mf := F;
+         Res.In_Exception := In_Exception;
+
+         Res.Arch := PPC;
+
+         --  Map sections table
+         Res.Num_Sections := uint32 (Hdr.f_nscns);
+         Res.Sectab_Stream := Create_Stream
+           (F,
+            File_Size (Header'Size / SSU) + File_Size (Hdr.f_opthdr),
+            File_Size (Hdr.f_nscns) * (Section_Header'Size / SSU));
+
+         --  Map symbols table
+         Res.Symtab_Last := Offset (Hdr.f_nscns) * (Symbol_Entry'Size / SSU);
+         Res.Symtab_Stream := Create_Stream
+           (F,
+            File_Size (Hdr.f_symptr),
+            File_Size (Res.Symtab_Last) + 4);
+
+         --  Map string table
+         Seek (Res.Symtab_Stream, Res.Symtab_Last);
+         Strtab_Sz := Read (Res.Symtab_Stream);
+         Res.Symstr_Stream := Create_Stream
+           (F,
+            File_Size (Res.Symtab_Last) + 4,
+            File_Size (Strtab_Sz) - 4);
+
+         return Res;
+      end Initialize;
+
+      -----------------
+      -- Get_Section --
+      -----------------
+
+      function Get_Section
+        (Obj   : in out XCOFF32_Object_File;
+         Index : uint32) return Object_Section
+      is
+         Sec : constant Section_Header := Read_Section_Header (Obj, Index);
+      begin
+         return (Index, Offset (Sec.s_scnptr),
+                 uint64 (Sec.s_vaddr),
+                 uint64 (Sec.s_size),
+                 (Sec.s_flags and STYP_TEXT) /= 0);
+      end Get_Section;
+
+      -----------------
+      -- Read_Header --
+      -----------------
+
+      function Read_Header (F : in out Mapped_Stream) return Header is
+         Hdr : Header;
+      begin
+         Seek (F, 0);
+         Read_Raw (F, Hdr'Address, uint32 (Hdr'Size / SSU));
+         return Hdr;
+      end Read_Header;
+
+      -------------------------
+      -- Read_Section_Header --
+      -------------------------
+
+      function Read_Section_Header
+        (Obj   : in out XCOFF32_Object_File;
+         Index : uint32) return Section_Header
+      is
+         Sec     : Section_Header;
+
+      begin
+         --  Seek to the end of the object header
+
+         Seek (Obj.Sectab_Stream, Offset (Index * Section_Header'Size / SSU));
+
+         --  Read the section
+
+         Read_Raw (Obj.Sectab_Stream, Sec'Address, Section_Header'Size / SSU);
+
+         return Sec;
+      end Read_Section_Header;
+
+      ----------
+      -- Name --
+      ----------
+
+      function Name
+        (Obj : in out XCOFF32_Object_File;
+         Sec : Object_Section) return String
+      is
+         Hdr : Section_Header;
+      begin
+         Hdr := Read_Section_Header (Obj, Sec.Num);
+         return Trim_Trailing_Nuls (Hdr.s_name);
+      end Name;
+
+      ----------
+      -- Name --
+      ----------
+
+      function Name
+        (Obj : in out XCOFF32_Object_File;
+         Sym : Object_Symbol) return String_Ptr_Len
+      is
+         Symbol  : Symbol_Entry;
+
+      begin
+         Seek (Obj.Symtab_Stream, Sym.Off);
+         Read_Raw (Obj.Symtab_Stream, Symbol'Address, Symbol'Size / SSU);
+
+         declare
+            First_Word : uint32;
+            pragma Import (Ada, First_Word);
+            --  Suppress initialization in Normalized_Scalars mode
+            for First_Word'Address use Symbol.n_name (1)'Address;
+
+            Second_Word : uint32;
+            pragma Import (Ada, Second_Word);
+            --  Suppress initialization in Normalized_Scalars mode
+            for Second_Word'Address use Symbol.n_name (5)'Address;
+
+         begin
+            if First_Word = 0 then
+               if Second_Word = 0 then
+                  return (null, 0);
+               else
+                  Seek (Obj.Symstr_Stream, int64 (Second_Word));
+                  return Read (Obj.Symstr_Stream);
+               end if;
+            else
+               Seek (Obj.Symtab_Stream, Sym.Off);
+               return To_String_Ptr_Len (Read (Obj.Symstr_Stream), 8);
+            end if;
+         end;
+      end Name;
+   end XCOFF32_Ops;
+
+   ----------
+   -- Arch --
+   ----------
+
+   function Arch (Obj : Object_File) return Object_Arch is
+   begin
+      return Obj.Arch;
+   end Arch;
+
+   function Create_Stream
+     (Mf : Mapped_File;
+      File_Offset : File_Size;
+      File_Length : File_Size)
+     return Mapped_Stream
+   is
+      Region : Mapped_Region;
+   begin
+      Read (Mf, Region, File_Offset, File_Length, False);
+      return (Region, 0, Offset (File_Length));
+   end Create_Stream;
+
+   function Create_Stream
+     (Obj : Object_File;
+      Sec : Object_Section) return Mapped_Stream is
+   begin
+      return Create_Stream (Obj.Mf, File_Size (Sec.Off), File_Size (Sec.Size));
+   end Create_Stream;
+
+   procedure Tell (Obj : in out Mapped_Stream; Off : out Offset) is
+   begin
+      Off := Obj.Off;
+   end Tell;
+
+   function Tell (Obj : Mapped_Stream) return Offset is
+   begin
+      return Obj.Off;
+   end Tell;
+
+   function Length (Obj : Mapped_Stream) return Offset is
+   begin
+      return Obj.Len;
+   end Length;
+
+   -----------
+   -- Close --
+   -----------
+
+   procedure Close (S : in out Mapped_Stream) is
+   begin
+      Free (S.Region);
+   end Close;
+
+   procedure Close (Obj : in out Object_File) is
+   begin
+      Close (Obj.Symtab_Stream);
+      Close (Obj.Symstr_Stream);
+      Close (Obj.Sectab_Stream);
+
+      case Obj.Format is
+         when ELF =>
+            Close (Obj.Secstr_Stream);
+         when Any_PECOFF =>
+            null;
+         when XCOFF32 =>
+            null;
+      end case;
+
+      Close (Obj.Mf);
+   end Close;
+
+   ------------------------
+   -- Strip_Leading_Char --
+   ------------------------
+
+   function Strip_Leading_Char
+     (Obj : in out Object_File;
+      Sym : String_Ptr_Len) return Positive is
+   begin
+      if (Obj.Format = PECOFF  and then Sym.Ptr (1) = '_')
+        or else
+        (Obj.Format = XCOFF32 and then Sym.Ptr (1) = '.')
+      then
+         return 2;
+      else
+         return 1;
+      end if;
+   end Strip_Leading_Char;
+
+   ----------------------
+   -- Decoded_Ada_Name --
+   ----------------------
+
+   function Decoded_Ada_Name
+     (Obj : in out Object_File;
+      Sym : String_Ptr_Len) return String
+   is
+      procedure gnat_decode
+        (Coded_Name_Addr : Address;
+         Ada_Name_Addr   : Address;
+         Verbose         : int);
+      pragma Import (C, gnat_decode, "__gnat_decode");
+
+      subtype size_t is Interfaces.C.size_t;
+
+      Sym_Name : constant String :=
+        String (Sym.Ptr (1 .. Sym.Len)) & ASCII.NUL;
+      Decoded : char_array (0 .. size_t (Sym.Len) * 2 + 60);
+      Off     : Natural;
+   begin
+      --  In the PECOFF case most but not all symbol table entries have an
+      --  extra leading underscore. In this case we trim it.
+
+      Off := Strip_Leading_Char (Obj, Sym);
+
+      gnat_decode (Sym_Name (Off)'Address, Decoded'Address, 0);
+
+      return To_Ada (Decoded);
+   end Decoded_Ada_Name;
+
+   ------------------
+   -- First_Symbol --
+   ------------------
+
+   function First_Symbol (Obj : in out Object_File) return Object_Symbol is
+   begin
+      case Obj.Format is
+         when ELF32      => return ELF32_Ops.First_Symbol   (Obj);
+         when ELF64      => return ELF64_Ops.First_Symbol   (Obj);
+         when Any_PECOFF => return PECOFF_Ops.First_Symbol  (Obj);
+         when XCOFF32    => return XCOFF32_Ops.First_Symbol (Obj);
+      end case;
+   end First_Symbol;
+
+   ------------
+   -- Format --
+   ------------
+
+   function Format (Obj : Object_File) return Object_Format is
+   begin
+      return Obj.Format;
+   end Format;
+
+   ----------------------
+   -- Get_Load_Address --
+   ----------------------
+
+   function Get_Load_Address (Obj : Object_File) return uint64 is
+   begin
+      raise Format_Error with "Get_Load_Address not implemented";
+      return 0;
+   end Get_Load_Address;
+
+   -----------------
+   -- Get_Section --
+   -----------------
+
+   function Get_Section
+     (Obj   : in out Object_File;
+      Shnum : uint32) return Object_Section is
+   begin
+      case Obj.Format is
+         when ELF32      => return ELF32_Ops.Get_Section   (Obj, Shnum);
+         when ELF64      => return ELF64_Ops.Get_Section   (Obj, Shnum);
+         when Any_PECOFF => return PECOFF_Ops.Get_Section  (Obj, Shnum);
+         when XCOFF32    => return XCOFF32_Ops.Get_Section (Obj, Shnum);
+      end case;
+   end Get_Section;
+
+   function Get_Section
+     (Obj      : in out Object_File;
+      Sec_Name : String) return Object_Section
+   is
+      Sec : Object_Section;
+
+   begin
+      for J in 0 .. Obj.Num_Sections - 1 loop
+         Sec := Get_Section (Obj, J);
+
+         if Name (Obj, Sec) = Sec_Name then
+            return Sec;
+         end if;
+      end loop;
+
+      if Obj.In_Exception then
+         return Null_Section;
+      else
+         raise Format_Error with "could not find section in object file";
+      end if;
+   end Get_Section;
+
+   -----------------------
+   -- Get_Memory_Bounds --
+   -----------------------
+
+   procedure Get_Memory_Bounds
+     (Obj   : in out Object_File;
+      Low, High : out uint64) is
+      Sec : Object_Section;
+   begin
+      --  First set as an empty range
+      Low := uint64'Last;
+      High := uint64'First;
+
+      for Idx in 1 .. Num_Sections (Obj) loop
+         Sec := Get_Section (Obj, Idx - 1);
+         if Sec.Flag_Alloc then
+            if Sec.Addr < Low then
+               Low := Sec.Addr;
+            end if;
+            if Sec.Addr + Sec.Size > High then
+               High := Sec.Addr + Sec.Size;
+            end if;
+         end if;
+      end loop;
+   end Get_Memory_Bounds;
+
+   ----------
+   -- Name --
+   ----------
+
+   function Name
+     (Obj : in out Object_File;
+      Sec : Object_Section) return String is
+   begin
+      case Obj.Format is
+         when ELF32      => return ELF32_Ops.Name   (Obj, Sec);
+         when ELF64      => return ELF64_Ops.Name   (Obj, Sec);
+         when Any_PECOFF => return PECOFF_Ops.Name  (Obj, Sec);
+         when XCOFF32    => return XCOFF32_Ops.Name (Obj, Sec);
+      end case;
+   end Name;
+
+   function Name
+     (Obj : in out Object_File;
+      Sym : Object_Symbol) return String_Ptr_Len is
+   begin
+      case Obj.Format is
+         when ELF32      => return ELF32_Ops.Name   (Obj, Sym);
+         when ELF64      => return ELF64_Ops.Name   (Obj, Sym);
+         when Any_PECOFF => return PECOFF_Ops.Name  (Obj, Sym);
+         when XCOFF32    => return XCOFF32_Ops.Name (Obj, Sym);
+      end case;
+   end Name;
+
+   -----------------
+   -- Next_Symbol --
+   -----------------
+
+   function Next_Symbol
+     (Obj  : in out Object_File;
+      Prev : Object_Symbol) return Object_Symbol is
+   begin
+      --  Test whether we've reached the end of the symbol table
+
+      if Prev.Next >= Obj.Symtab_Last then
+         return Null_Symbol;
+      end if;
+
+      return Read_Symbol (Obj, Prev.Next);
+   end Next_Symbol;
+
+   ---------
+   -- Num --
+   ---------
+
+   function Num (Sec : Object_Section) return uint32 is
+   begin
+      return Sec.Num;
+   end Num;
+
+   ------------------
+   -- Num_Sections --
+   ------------------
+
+   function Num_Sections (Obj : Object_File) return uint32 is
+   begin
+      return Obj.Num_Sections;
+   end Num_Sections;
+
+   ---------
+   -- Off --
+   ---------
+
+   function Off (Sec : Object_Section) return Offset is
+   begin
+      return Sec.Off;
+   end Off;
+
+   function Off (Sym : Object_Symbol) return Offset is
+   begin
+      return Sym.Off;
+   end Off;
+
+   ----------------------
+   -- Offset_To_String --
+   ----------------------
+
+   function Offset_To_String
+     (S : in out Mapped_Stream;
+      Off : Offset) return String
+   is
+      Buf     : Buffer;
+   begin
+      Seek (S, Off);
+      Read_C_String (S, Buf);
+      return To_String (Buf);
+   end Offset_To_String;
+
+   ----------
+   -- Open --
+   ----------
+
+   function Open
+     (File_Name    : String;
+      In_Exception : Boolean := False) return Object_File_Access
+   is
+      F          : Mapped_File;
+      Hdr_Stream : Mapped_Stream;
+
+   begin
+      --  Open the file
+
+      F := Open_Read_No_Exception (File_Name);
+
+      if F = Invalid_Mapped_File then
+         if In_Exception then
+            return null;
+         else
+            raise IO_Error with "could not open object file";
+         end if;
+      end if;
+
+      Hdr_Stream := Create_Stream (F, 0, 4096);
+
+      declare
+         Hdr : constant ELF32_Ops.Header := ELF32_Ops.Read_Header (Hdr_Stream);
+
+      begin
+         --  Look for the magic numbers for the ELF case
+
+         if Hdr.E_Ident (0) = 16#7F#              and then
+            Hdr.E_Ident (1) = Character'Pos ('E') and then
+            Hdr.E_Ident (2) = Character'Pos ('L') and then
+            Hdr.E_Ident (3) = Character'Pos ('F') and then
+            Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS32
+         then
+            Close (Hdr_Stream);
+            return new Object_File'
+                  (ELF32_Ops.Initialize (F, Hdr, In_Exception));
+         end if;
+      end;
+
+      declare
+         Hdr : constant ELF64_Ops.Header :=
+           ELF64_Ops.Read_Header (Hdr_Stream);
+
+      begin
+         --  Look for the magic numbers for the ELF case
+
+         if Hdr.E_Ident (0) = 16#7F#              and then
+            Hdr.E_Ident (1) = Character'Pos ('E') and then
+            Hdr.E_Ident (2) = Character'Pos ('L') and then
+            Hdr.E_Ident (3) = Character'Pos ('F') and then
+            Hdr.E_Ident (4) = ELF32_Ops.ELFCLASS64
+         then
+            Close (Hdr_Stream);
+            return new Object_File'
+                         (ELF64_Ops.Initialize (F, Hdr, In_Exception));
+         end if;
+      end;
+
+      declare
+         Hdr : constant PECOFF_Ops.Header :=
+           PECOFF_Ops.Read_Header (Hdr_Stream);
+
+      begin
+         --  Test the magic numbers
+
+         if Hdr.Magics (0) = Character'Pos ('P') and then
+            Hdr.Magics (1) = Character'Pos ('E') and then
+            Hdr.Magics (2) = 0                   and then
+            Hdr.Magics (3) = 0
+         then
+            Close (Hdr_Stream);
+            return new Object_File'
+                         (PECOFF_Ops.Initialize (F, Hdr, In_Exception));
+         end if;
+
+      exception
+         --  If this is not a PECOFF file then we've done a seek and read to a
+         --  random address, possibly raising IO_Error
+
+         when IO_Error =>
+            null;
+      end;
+
+      declare
+         Hdr : constant XCOFF32_Ops.Header :=
+           XCOFF32_Ops.Read_Header (Hdr_Stream);
+
+      begin
+         --  Test the magic numbers
+
+         if Hdr.f_magic = 8#0737# then
+            Close (Hdr_Stream);
+            return new Object_File'
+                         (XCOFF32_Ops.Initialize (F, Hdr, In_Exception));
+         end if;
+      end;
+
+      Close (Hdr_Stream);
+
+      if In_Exception then
+         return null;
+      else
+         raise Format_Error with "unrecognized object format";
+      end if;
+   end Open;
+
+   ----------
+   -- Read --
+   ----------
+
+   function Read (S : in out Mapped_Stream) return Mmap.Str_Access
+   is
+      function To_Str_Access is
+         new Ada.Unchecked_Conversion (Address, Str_Access);
+   begin
+      return To_Str_Access (Data (S.Region) (Natural (S.Off + 1))'Address);
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return String_Ptr_Len is
+   begin
+      return To_String_Ptr_Len (Read (S));
+   end Read;
+
+   procedure Check_Read_Offset (S : in out Mapped_Stream; Size : uint32) is
+   begin
+      if S.Off + Offset (Size) > Offset (Last (S.Region)) then
+         raise IO_Error with "could not read from object file";
+      end if;
+   end Check_Read_Offset;
+
+   procedure Read_Raw
+     (S    : in out Mapped_Stream;
+      Addr : Address;
+      Size : uint32)
+   is
+      function To_Str_Access is
+         new Ada.Unchecked_Conversion (Address, Str_Access);
+
+      Sz : constant Offset := Offset (Size);
+   begin
+      --  Check size
+
+      pragma Debug (Check_Read_Offset (S, Size));
+
+      --  Copy data
+
+      To_Str_Access (Addr) (1 .. Positive (Sz)) :=
+        Data (S.Region) (Positive (S.Off + 1) .. Positive (S.Off + Sz));
+
+      --  Update offset
+
+      S.Off := S.Off + Sz;
+   end Read_Raw;
+
+   function Read (S : in out Mapped_Stream) return uint8 is
+      Data : uint8;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return uint16 is
+      Data : uint16;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return uint32 is
+      Data : uint32;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return uint64 is
+      Data : uint64;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return int8 is
+      Data : int8;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return int16 is
+      Data : int16;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return int32 is
+      Data : int32;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   function Read (S : in out Mapped_Stream) return int64 is
+      Data : int64;
+   begin
+      Read_Raw (S, Data'Address, Data'Size / SSU);
+      return Data;
+   end Read;
+
+   ------------------
+   -- Read_Address --
+   ------------------
+
+   function Read_Address
+     (Obj : Object_File; S : in out Mapped_Stream) return uint64 is
+      Address_32 : uint32;
+      Address_64 : uint64;
+
+   begin
+      case Obj.Arch is
+         when i386
+            | MIPS
+            | PPC
+            | SPARC
+         =>
+            Address_32 := Read (S);
+            return uint64 (Address_32);
+
+         when IA64
+            | PPC64
+            | SPARC64
+            | x86_64
+         =>
+            Address_64 := Read (S);
+            return Address_64;
+
+         when Unknown =>
+            raise Format_Error with "unrecognized machine architecture";
+      end case;
+   end Read_Address;
+
+   -------------------
+   -- Read_C_String --
+   -------------------
+
+   procedure Read_C_String (S : in out Mapped_Stream; B : out Buffer) is
+      J : Integer := 0;
+
+   begin
+      loop
+         --  Handle overflow case
+
+         if J = B'Last then
+            B (J) := 0;
+            exit;
+         end if;
+
+         B (J) := Read (S);
+         exit when B (J) = 0;
+         J := J + 1;
+      end loop;
+   end Read_C_String;
+
+   -------------------
+   -- Read_C_String --
+   -------------------
+
+   function Read_C_String (S : in out Mapped_Stream) return Str_Access is
+      Res : constant Str_Access := Read (S);
+
+   begin
+      for J in Res'Range loop
+         if S.Off + Offset (J - 1) > Offset (Last (S.Region)) then
+            raise IO_Error with "could not read from object file";
+         end if;
+
+         if Res (J) = ASCII.NUL then
+            S.Off := S.Off + Offset (J);
+            return Res;
+         end if;
+      end loop;
+
+      --  Overflow case
+      raise Constraint_Error;
+   end Read_C_String;
+
+   -----------------
+   -- Read_LEB128 --
+   -----------------
+
+   function Read_LEB128 (S : in out Mapped_Stream) return uint32 is
+      B     : uint8;
+      Shift : Integer := 0;
+      Res   : uint32 := 0;
+
+   begin
+      loop
+         B := Read (S);
+         Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift);
+         exit when (B and 16#80#) = 0;
+         Shift := Shift + 7;
+      end loop;
+
+      return Res;
+   end Read_LEB128;
+
+   function Read_LEB128 (S : in out Mapped_Stream) return int32 is
+      B     : uint8;
+      Shift : Integer := 0;
+      Res   : uint32 := 0;
+
+   begin
+      loop
+         B := Read (S);
+         Res := Res or Shift_Left (uint32 (B and 16#7f#), Shift);
+         Shift := Shift + 7;
+         exit when (B and 16#80#) = 0;
+      end loop;
+
+      if Shift < 32 and then (Res and Shift_Left (1, Shift - 1)) /= 0 then
+         Res := Res or Shift_Left (-1, Shift);
+      end if;
+
+      return To_int32 (Res);
+   end Read_LEB128;
+
+   -----------------
+   -- Read_Symbol --
+   -----------------
+
+   function Read_Symbol
+     (Obj : in out Object_File;
+      Off : Offset) return Object_Symbol is
+   begin
+      case Obj.Format is
+         when ELF32      => return ELF32_Ops.Read_Symbol   (Obj, Off);
+         when ELF64      => return ELF64_Ops.Read_Symbol   (Obj, Off);
+         when Any_PECOFF => return PECOFF_Ops.Read_Symbol  (Obj, Off);
+         when XCOFF32    => return XCOFF32_Ops.Read_Symbol (Obj, Off);
+      end case;
+   end Read_Symbol;
+
+   ----------
+   -- Seek --
+   ----------
+
+   procedure Seek (S : in out Mapped_Stream; Off : Offset) is
+   begin
+      if Off < 0 or else Off > Offset (Last (S.Region)) then
+         raise IO_Error with "could not seek to offset in object file";
+      end if;
+
+      S.Off := Off;
+   end Seek;
+
+   ----------
+   -- Size --
+   ----------
+
+   function Size (Sec : Object_Section) return uint64 is
+   begin
+      return Sec.Size;
+   end Size;
+
+   function Size (Sym : Object_Symbol) return uint64 is
+   begin
+      return Sym.Size;
+   end Size;
+
+   ------------
+   -- Strlen --
+   ------------
+
+   function Strlen (Buf : Buffer) return int32 is
+   begin
+      return int32 (CRTL.strlen (Buf'Address));
+   end Strlen;
+
+   -----------
+   -- Spans --
+   -----------
+
+   function Spans (Sym : Object_Symbol; Addr : uint64) return Boolean is
+   begin
+      return Addr >= Sym.Value and then Addr < Sym.Value + Sym.Size;
+   end Spans;
+
+   ---------------
+   -- To_String --
+   ---------------
+
+   function To_String (Buf : Buffer) return String is
+      Result : String (1 .. Integer (CRTL.strlen (Buf'Address)));
+      for Result'Address use Buf'Address;
+      pragma Import (Ada, Result);
+
+   begin
+      return Result;
+   end To_String;
+
+   -----------------------
+   -- To_String_Ptr_Len --
+   -----------------------
+
+   function To_String_Ptr_Len
+     (Ptr : Mmap.Str_Access;
+      Max_Len : Natural := Natural'Last) return String_Ptr_Len is
+   begin
+      for I in 1 .. Max_Len loop
+         if Ptr (I) = ASCII.NUL then
+            return (Ptr, I - 1);
+         end if;
+      end loop;
+      return (Ptr, Max_Len);
+   end To_String_Ptr_Len;
+
+   ------------------------
+   -- Trim_Trailing_Nuls --
+   ------------------------
+
+   function Trim_Trailing_Nuls (Str : String) return String is
+   begin
+      for J in Str'Range loop
+         if Str (J) = ASCII.NUL then
+            return Str (Str'First .. J - 1);
+         end if;
+      end loop;
+
+      return Str;
+   end Trim_Trailing_Nuls;
+
+   -----------
+   -- Value --
+   -----------
+
+   function Value (Sym : Object_Symbol) return uint64 is
+   begin
+      return Sym.Value;
+   end Value;
+
+end System.Object_Reader;
diff --git a/gcc/ada/s-objrea.ads b/gcc/ada/s-objrea.ads
new file mode 100644
index 0000000..1d48536
--- /dev/null
+++ b/gcc/ada/s-objrea.ads
@@ -0,0 +1,451 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                 S Y S T E M . O B J E C T _ R E A D E R                  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2009-2017, Free Software Foundation, Inc.         --
+--                                                                          --
+-- 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 package implements a simple, minimal overhead reader for object files
+--  composed of sections of untyped heterogeneous binary data.
+
+with Interfaces;
+with System.Mmap;
+
+package System.Object_Reader is
+
+   --------------
+   --  Limits  --
+   --------------
+
+   BUFFER_SIZE : constant := 8 * 1024;
+
+   ------------------
+   -- Object files --
+   ------------------
+
+   type Object_File (<>) is private;
+
+   type Object_File_Access is access Object_File;
+
+   ---------------------
+   -- Object sections --
+   ----------------------
+
+   type Object_Section is private;
+
+   Null_Section : constant Object_Section;
+
+   --------------------
+   -- Object symbols --
+   --------------------
+
+   type Object_Symbol is private;
+
+   ------------------------
+   -- Object format type --
+   ------------------------
+
+   type Object_Format is
+     (ELF32,
+      --  Object format is 32-bit ELF
+
+      ELF64,
+      --  Object format is 64-bit ELF
+
+      PECOFF,
+      --  Object format is Microsoft PECOFF
+
+      PECOFF_PLUS,
+      --  Object format is Microsoft PECOFF+
+
+      XCOFF32);
+      --  Object format is AIX 32-bit XCOFF
+
+   --  PECOFF | PECOFF_PLUS appears so often as a case choice, would
+   --  seem a good idea to have a subtype name covering these two choices ???
+
+   ------------------------------
+   -- Object architecture type --
+   ------------------------------
+
+   type Object_Arch is
+     (Unknown,
+      --  The target architecture has not yet been determined
+
+      SPARC,
+      --  32-bit SPARC
+
+      SPARC64,
+      --  64-bit SPARC
+
+      i386,
+      --  Intel IA32
+
+      MIPS,
+      --  MIPS Technologies MIPS
+
+      x86_64,
+      --  x86-64 (64-bit AMD/Intel)
+
+      IA64,
+      --  Intel IA64
+
+      PPC,
+      --  32-bit PowerPC
+
+      PPC64);
+      --  64-bit PowerPC
+
+   ------------------
+   -- Target types --
+   ------------------
+
+   subtype Offset is Interfaces.Integer_64;
+
+   subtype uint8  is Interfaces.Unsigned_8;
+   subtype uint16 is Interfaces.Unsigned_16;
+   subtype uint32 is Interfaces.Unsigned_32;
+   subtype uint64 is Interfaces.Unsigned_64;
+
+   subtype int8  is Interfaces.Integer_8;
+   subtype int16 is Interfaces.Integer_16;
+   subtype int32 is Interfaces.Integer_32;
+   subtype int64 is Interfaces.Integer_64;
+
+   type Buffer is array (0 .. BUFFER_SIZE - 1) of uint8;
+
+   type String_Ptr_Len is record
+      Ptr : Mmap.Str_Access;
+      Len : Natural;
+   end record;
+   --  A string made from a pointer and a length. Not all strings for name
+   --  are C strings: COFF inlined symbol names have a max length of 8.
+
+   -------------------------------------------
+   -- Operations on buffers of untyped data --
+   -------------------------------------------
+
+   function To_String (Buf : Buffer) return String;
+   --  Construct string from C style null-terminated string stored in a buffer
+
+   function To_String_Ptr_Len
+     (Ptr : Mmap.Str_Access;
+      Max_Len : Natural := Natural'Last) return String_Ptr_Len;
+   --  Convert PTR to a String_Ptr_Len.
+
+   function Strlen (Buf : Buffer) return int32;
+   --  Return the length of a C style null-terminated string
+
+   -------------------------
+   -- Opening and closing --
+   -------------------------
+
+   function Open
+     (File_Name    : String;
+      In_Exception : Boolean := False) return Object_File_Access;
+   --  Open the object file and initialize the reader. In_Exception is true
+   --  when the parsing is done as part of an exception handler decorator. In
+   --  this mode we do not want to raise an exception.
+
+   procedure Close (Obj : in out Object_File);
+   --  Close the object file
+
+   -----------------------
+   -- Sequential access --
+   -----------------------
+
+   type Mapped_Stream is private;
+   --  Provide an abstraction of a stream on a memory mapped file
+
+   function Create_Stream (Mf : System.Mmap.Mapped_File;
+                           File_Offset : System.Mmap.File_Size;
+                           File_Length : System.Mmap.File_Size)
+                          return Mapped_Stream;
+   --  Create a stream from Mf
+
+   procedure Close (S : in out Mapped_Stream);
+   --  Close the stream (deallocate memory)
+
+   procedure Read_Raw
+     (S   : in out Mapped_Stream;
+      Addr  : Address;
+      Size  : uint32);
+   pragma Inline (Read_Raw);
+   --  Read a number of fixed sized records
+
+   procedure Seek (S : in out Mapped_Stream; Off : Offset);
+   --  Seek to an absolute offset in bytes
+
+   procedure Tell (Obj : in out Mapped_Stream; Off : out Offset)
+     with Inline;
+   function Tell (Obj : Mapped_Stream) return Offset
+     with Inline;
+   --  Fetch the current offset
+
+   function Length (Obj : Mapped_Stream) return Offset
+     with Inline;
+   --  Length of the stream
+
+   function Read (S : in out Mapped_Stream) return Mmap.Str_Access;
+   --  Provide a pointer in memory at the current offset
+
+   function Read (S : in out Mapped_Stream) return String_Ptr_Len;
+   --  Provide a pointer in memory at the current offset
+
+   function Read (S : in out Mapped_Stream) return uint8;
+   function Read (S : in out Mapped_Stream) return uint16;
+   function Read (S : in out Mapped_Stream) return uint32;
+   function Read (S : in out Mapped_Stream) return uint64;
+   function Read (S : in out Mapped_Stream) return int8;
+   function Read (S : in out Mapped_Stream) return int16;
+   function Read (S : in out Mapped_Stream) return int32;
+   function Read (S : in out Mapped_Stream) return int64;
+   --  Read a scalar
+
+   function Read_Address
+     (Obj : Object_File; S : in out Mapped_Stream) return uint64;
+   --  Read either a 64 or 32 bit address from the file stream depending on the
+   --  address size of the target architecture and promote it to a 64 bit type.
+
+   function Read_LEB128 (S : in out Mapped_Stream) return uint32;
+   function Read_LEB128 (S : in out Mapped_Stream) return int32;
+   --  Read a value encoding in Little-Endian Base 128 format
+
+   procedure Read_C_String (S : in out Mapped_Stream; B : out Buffer);
+   function Read_C_String (S : in out Mapped_Stream) return Mmap.Str_Access;
+   --  Read a C style NULL terminated string
+
+   function Offset_To_String
+     (S : in out Mapped_Stream;
+      Off : Offset) return String;
+   --  Construct a string from a C style NULL terminated string located at an
+   --  offset into the object file.
+
+   ------------------------
+   -- Object information --
+   ------------------------
+
+   function Arch (Obj : Object_File) return Object_Arch;
+   --  Return the object architecture
+
+   function Format (Obj : Object_File) return Object_Format;
+   --  Return the object file format
+
+   function Get_Load_Address (Obj : Object_File) return uint64;
+   --  Return the load address defined in Obj. May raise Format_Error if not
+   --  implemented
+
+   function Num_Sections (Obj : Object_File) return uint32;
+   --  Return the number of sections composing the object file
+
+   function Get_Section
+     (Obj   : in out Object_File;
+      Shnum : uint32) return Object_Section;
+   --  Return the Nth section (numbered from zero)
+
+   function Get_Section
+     (Obj      : in out Object_File;
+      Sec_Name : String) return Object_Section;
+   --  Return a section by name
+
+   function Create_Stream
+     (Obj : Object_File;
+      Sec : Object_Section) return Mapped_Stream;
+   --  Create a stream for section Sec
+
+   procedure Get_Memory_Bounds
+     (Obj   : in out Object_File;
+      Low, High : out uint64);
+   --  Return the low and high addresses of the code for the object file. Can
+   --  be used to check if an address in within this object file. This
+   --  procedure is not efficient and the result should be saved to avoid
+   --  recomputation.
+
+   -------------------------
+   -- Section information --
+   -------------------------
+
+   function Name
+     (Obj : in out Object_File;
+      Sec : Object_Section) return String;
+   --  Return the name of a section as a string
+
+   function Size (Sec : Object_Section) return uint64;
+   --  Return the size of a section in bytes
+
+   function Num (Sec : Object_Section) return uint32;
+   --  Return the index of a section from zero
+
+   function Off (Sec : Object_Section) return Offset;
+   --  Return the byte offset of the section within the object
+
+   ------------------------------
+   -- Symbol table information --
+   ------------------------------
+
+   Null_Symbol : constant Object_Symbol;
+   --  An empty symbol table entry.
+
+   function First_Symbol (Obj : in out Object_File) return Object_Symbol;
+   --  Return the first element in the symbol table or Null_Symbol if the
+   --  symbol table is empty.
+
+   function Next_Symbol
+     (Obj  : in out Object_File;
+      Prev : Object_Symbol) return Object_Symbol;
+   --  Return the element following Prev in the symbol table, or Null_Symbol if
+   --  Prev is the last symbol in the table.
+
+   function Read_Symbol
+     (Obj : in out Object_File;
+      Off : Offset) return Object_Symbol;
+   --  Read symbol at Off
+
+   function Name
+     (Obj : in out Object_File;
+      Sym : Object_Symbol) return String_Ptr_Len;
+   --  Return the name of the symbol
+
+   function Decoded_Ada_Name
+     (Obj : in out Object_File;
+      Sym : String_Ptr_Len) return String;
+   --  Return the decoded name of a symbol encoded as per exp_dbug.ads
+
+   function Strip_Leading_Char
+     (Obj : in out Object_File;
+      Sym : String_Ptr_Len) return Positive;
+   --  Return the index of the first character to decode the name. This can
+   --  strip one character for ABI with a prefix (like x86 for PECOFF).
+
+   function Value (Sym : Object_Symbol) return uint64;
+   --  Return the name of the symbol
+
+   function Size (Sym : Object_Symbol) return uint64;
+   --  Return the size of the symbol in bytes
+
+   function Spans (Sym : Object_Symbol; Addr : uint64) return Boolean;
+   --  Determine whether a particular address corresponds to the range
+   --  referenced by this symbol.
+
+   function Off (Sym : Object_Symbol) return Offset;
+   --  Return the offset of the symbol.
+
+   ----------------
+   -- Exceptions --
+   ----------------
+
+   IO_Error : exception;
+   --  Input/Output error reading file
+
+   Format_Error : exception;
+   --  Encountered a problem parsing the object
+
+private
+   type Mapped_Stream is record
+      Region : System.Mmap.Mapped_Region;
+      Off    : Offset;
+      Len    : Offset;
+   end record;
+
+   subtype ELF is Object_Format range ELF32 .. ELF64;
+   subtype Any_PECOFF is Object_Format range PECOFF .. PECOFF_PLUS;
+
+   type Object_File (Format : Object_Format) is record
+      Mf           : System.Mmap.Mapped_File :=
+                        System.Mmap.Invalid_Mapped_File;
+      Arch         : Object_Arch := Unknown;
+
+      Num_Sections : uint32 := 0;
+      --  Number of sections
+
+      Symtab_Last : Offset;       --  Last offset of symbol table
+
+      In_Exception : Boolean := False;
+      --  True if the parsing is done as part of an exception handler
+
+      Sectab_Stream : Mapped_Stream;
+      --  Section table
+
+      Symtab_Stream : Mapped_Stream;
+      --  Symbol table
+
+      Symstr_Stream : Mapped_Stream;
+      --  Symbol strings
+
+      case Format is
+         when ELF =>
+            Secstr_Stream : Mapped_Stream;
+            --  Section strings
+         when Any_PECOFF =>
+            ImageBase   : uint64;       --  ImageBase value from header
+
+            --  Cache for latest result of Get_Section_Virtual_Address
+
+            GSVA_Sec  : uint32 := uint32'Last;
+            GSVA_Addr : uint64;
+         when XCOFF32 =>
+            null;
+      end case;
+   end record;
+
+   subtype ELF_Object_File is Object_File; -- with
+   --  Predicate => ELF_Object_File.Format in ELF;
+   subtype PECOFF_Object_File is Object_File; -- with
+   --  Predicate => PECOFF_Object_File.Format in Any_PECOFF;
+   subtype XCOFF32_Object_File is Object_File; -- with
+   --  Predicate => XCOFF32_Object_File.Format in XCOFF32;
+   --  ???Above predicates cause the compiler to crash when instantiating
+   --  ELF64_Ops (see package body).
+
+   type Object_Section is record
+      Num        : uint32 := 0;
+      --  Section index in the section table
+
+      Off        : Offset := 0;
+      --  First byte of the section in the object file
+
+      Addr       : uint64 := 0;
+      --  Load address of the section. Valid only when Flag_Alloc is true.
+
+      Size       : uint64 := 0;
+      --  Length of the section in bytes
+
+      Flag_Alloc : Boolean := False;
+      --  True if the section is mapped in memory by the OS loader
+   end record;
+
+   Null_Section : constant Object_Section := (0, 0, 0, 0, False);
+
+   type Object_Symbol is record
+      Off   : Offset := 0;  --  Offset of underlying symbol on disk
+      Next  : Offset := 0;  --  Offset of the following symbol
+      Value : uint64 := 0;  --  Value associated with this symbol
+      Size  : uint64 := 0;  --  Size of the referenced entity
+   end record;
+
+   Null_Symbol : constant Object_Symbol := (0, 0, 0, 0);
+end System.Object_Reader;
diff --git a/gcc/ada/s-trasym-dwarf.adb b/gcc/ada/s-trasym-dwarf.adb
new file mode 100644
index 0000000..9655722
--- /dev/null
+++ b/gcc/ada/s-trasym-dwarf.adb
@@ -0,0 +1,689 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--           S Y S T E M . T R A C E B A C K . S Y M B O L I C              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 1999-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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Run-time symbolic traceback support for targets using DWARF debug data
+
+pragma Polling (Off);
+--  We must turn polling off for this unit, because otherwise we can get
+--  elaboration circularities when polling is turned on.
+
+with Ada.Unchecked_Deallocation;
+
+with Ada.Exceptions.Traceback; use Ada.Exceptions.Traceback;
+with Ada.Containers.Generic_Array_Sort;
+
+with System.Address_To_Access_Conversions;
+with System.Soft_Links;
+with System.CRTL;
+with System.Dwarf_Lines;
+with System.Exception_Traces;
+with System.Standard_Library;
+with System.Traceback_Entries;
+with System.Strings;
+with System.Bounded_Strings;
+
+package body System.Traceback.Symbolic is
+
+   use System.Bounded_Strings;
+   use System.Dwarf_Lines;
+
+   subtype Big_String is String (Positive);
+   --  To deal with C strings
+
+   package Big_String_Conv is new System.Address_To_Access_Conversions
+     (Big_String);
+
+   type Module_Cache;
+   type Module_Cache_Acc is access all Module_Cache;
+
+   type Module_Cache is record
+      Name : Strings.String_Access;
+      --  Name of the module
+
+      C : Dwarf_Context (In_Exception => True);
+      --  Context to symbolize an address within this module
+
+      Chain : Module_Cache_Acc;
+   end record;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Module_Cache,
+      Module_Cache_Acc);
+
+   Cache_Chain : Module_Cache_Acc;
+   --  Simply linked list of modules
+
+   type Module_Array is array (Natural range <>) of Module_Cache_Acc;
+   type Module_Array_Acc is access Module_Array;
+
+   Modules_Cache : Module_Array_Acc;
+   --  Sorted array of cached modules (if not null)
+
+   Exec_Module : aliased Module_Cache;
+   --  Context for the executable
+
+   type Init_State is (Uninitialized, Initialized, Failed);
+   Exec_Module_State : Init_State := Uninitialized;
+   --  How Exec_Module is initialized
+
+   procedure Init_Exec_Module;
+   --  Initialize Exec_Module if not already initialized
+
+   function Symbolic_Traceback
+     (Traceback    : System.Traceback_Entries.Tracebacks_Array;
+      Suppress_Hex : Boolean) return String;
+   function Symbolic_Traceback
+     (E            : Ada.Exceptions.Exception_Occurrence;
+      Suppress_Hex : Boolean) return String;
+   --  Suppress_Hex means do not print any hexadecimal addresses, even if the
+   --  symbol is not available.
+
+   function Lt (Left, Right : Module_Cache_Acc) return Boolean;
+   --  Sort function for Module_Cache
+
+   procedure Init_Module
+     (Module       : out Module_Cache;
+      Success      : out Boolean;
+      Module_Name  :     String;
+      Load_Address :     Address := Null_Address);
+   --  Initialize Module
+
+   procedure Close_Module (Module : in out Module_Cache);
+   --  Finalize Module
+
+   function Value (Item : System.Address) return String;
+   --  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);
+   --  To be called by Build_Cache_For_All_Modules to add a new module to the
+   --  list. May not be referenced.
+
+   package Module_Name is
+
+      procedure Build_Cache_For_All_Modules;
+      --  Create the cache for all current modules
+
+      function Get (Addr : access System.Address) return String;
+      --  Returns the module name for the given address, Addr may be updated
+      --  to be set relative to a shared library. This depends on the platform.
+      --  Returns an empty string for the main executable.
+
+      function Is_Supported return Boolean;
+      pragma Inline (Is_Supported);
+      --  Returns True if Module_Name is supported, so if the traceback is
+      --  supported for shared libraries.
+
+   end Module_Name;
+
+   package body Module_Name is separate;
+
+   function Executable_Name return String;
+   --  Returns the executable name as reported by argv[0]. If gnat_argv not
+   --  initialized or if argv[0] executable not found in path, function returns
+   --  an empty string.
+
+   function Get_Executable_Load_Address return System.Address;
+   pragma Import
+     (C,
+      Get_Executable_Load_Address,
+      "__gnat_get_executable_load_address");
+   --  Get the load address of the executable, or Null_Address if not known
+
+   procedure Hexa_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String);
+   --  Non-symbolic traceback (simply write addresses in hexa)
+
+   procedure Symbolic_Traceback_No_Lock
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String);
+   --  Like the public Symbolic_Traceback_No_Lock except there is no provision
+   --  against concurrent accesses.
+
+   procedure Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Module       :        Module_Cache;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String);
+   --  Returns the Traceback for a given module
+
+   procedure Multi_Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String);
+   --  Build string containing symbolic traceback for the given call chain
+
+   procedure Multi_Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Module       :        Module_Cache;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String);
+   --  Likewise but using Module
+
+   Max_String_Length : constant := 4096;
+   --  Arbitrary limit on Bounded_Str length
+
+   -----------
+   -- Value --
+   -----------
+
+   function Value (Item : System.Address) return String is
+   begin
+      if Item /= Null_Address then
+         for J in Big_String'Range loop
+            if Big_String_Conv.To_Pointer (Item) (J) = ASCII.NUL then
+               return Big_String_Conv.To_Pointer (Item) (1 .. J - 1);
+            end if;
+         end loop;
+      end if;
+
+      return "";
+   end Value;
+
+   -------------------------
+   -- Add_Module_To_Cache --
+   -------------------------
+
+   procedure Add_Module_To_Cache (Module_Name : String) is
+      Module  : Module_Cache_Acc;
+      Success : Boolean;
+   begin
+      Module := new Module_Cache;
+      Init_Module (Module.all, Success, Module_Name);
+      if not Success then
+         Free (Module);
+         return;
+      end if;
+      Module.Chain := Cache_Chain;
+      Cache_Chain  := Module;
+   end Add_Module_To_Cache;
+
+   ----------------------
+   -- Init_Exec_Module --
+   ----------------------
+
+   procedure Init_Exec_Module is
+   begin
+      if Exec_Module_State = Uninitialized then
+         declare
+            Exec_Path : constant String  := Executable_Name;
+            Exec_Load : constant Address := Get_Executable_Load_Address;
+            Success   : Boolean;
+         begin
+            Init_Module (Exec_Module, Success, Exec_Path, Exec_Load);
+
+            if Success then
+               Exec_Module_State := Initialized;
+            else
+               Exec_Module_State := Failed;
+            end if;
+         end;
+      end if;
+   end Init_Exec_Module;
+
+   --------
+   -- Lt --
+   --------
+
+   function Lt (Left, Right : Module_Cache_Acc) return Boolean is
+   begin
+      return Low (Left.C) < Low (Right.C);
+   end Lt;
+
+   -----------------------------
+   -- Module_Cache_Array_Sort --
+   -----------------------------
+
+   procedure Module_Cache_Array_Sort is new Ada.Containers.Generic_Array_Sort
+     (Natural,
+      Module_Cache_Acc,
+      Module_Array,
+      Lt);
+
+   ------------------
+   -- Enable_Cache --
+   ------------------
+
+   procedure Enable_Cache (Include_Modules : Boolean := False) is
+   begin
+      --  Can be called at most once
+      if Cache_Chain /= null then
+         return;
+      end if;
+
+      --  Add all modules
+      Init_Exec_Module;
+      Cache_Chain := Exec_Module'Access;
+
+      if Include_Modules then
+         Module_Name.Build_Cache_For_All_Modules;
+      end if;
+
+      --  Build and fill the array of modules
+      declare
+         Count  : Natural;
+         Module : Module_Cache_Acc;
+      begin
+         for Phase in 1 .. 2 loop
+            Count  := 0;
+            Module := Cache_Chain;
+            while Module /= null loop
+               Count := Count + 1;
+
+               if Phase = 1 then
+                  Enable_Cache (Module.C);
+               else
+                  Modules_Cache (Count) := Module;
+               end if;
+               Module := Module.Chain;
+            end loop;
+
+            if Phase = 1 then
+               Modules_Cache := new Module_Array (1 .. Count);
+            end if;
+         end loop;
+      end;
+
+      --  Sort the array
+      Module_Cache_Array_Sort (Modules_Cache.all);
+   end Enable_Cache;
+
+   ---------------------
+   -- Executable_Name --
+   ---------------------
+
+   function Executable_Name return String is
+      --  We have to import gnat_argv as an Address to match the type of
+      --  gnat_argv in the binder generated file. Otherwise, we get spurious
+      --  warnings about type mismatch when LTO is turned on.
+
+      Gnat_Argv : System.Address;
+      pragma Import (C, Gnat_Argv, "gnat_argv");
+
+      type Argv_Array is array (0 .. 0) of System.Address;
+      package Conv is new System.Address_To_Access_Conversions (Argv_Array);
+
+      function locate_exec_on_path (A : System.Address) return System.Address;
+      pragma Import (C, locate_exec_on_path, "__gnat_locate_exec_on_path");
+
+   begin
+      if Gnat_Argv = Null_Address then
+         return "";
+      end if;
+
+      declare
+         Addr : constant System.Address :=
+           locate_exec_on_path (Conv.To_Pointer (Gnat_Argv) (0));
+         Result : constant String := Value (Addr);
+
+      begin
+         --  The buffer returned by locate_exec_on_path was allocated using
+         --  malloc, so we should use free to release the memory.
+
+         if Addr /= Null_Address then
+            System.CRTL.free (Addr);
+         end if;
+
+         return Result;
+      end;
+   end Executable_Name;
+
+   ------------------
+   -- Close_Module --
+   ------------------
+
+   procedure Close_Module (Module : in out Module_Cache) is
+   begin
+      Close (Module.C);
+      Strings.Free (Module.Name);
+   end Close_Module;
+
+   -----------------
+   -- Init_Module --
+   -----------------
+
+   procedure Init_Module
+     (Module       : out Module_Cache;
+      Success      : out Boolean;
+      Module_Name  :     String;
+      Load_Address :     Address := Null_Address)
+   is
+   begin
+      --  Early return if the module is not known
+
+      if Module_Name = "" then
+         Success := False;
+         return;
+      end if;
+
+      Open (Module_Name, Module.C, Success);
+
+      --  If a module can't be opened just return now, we just cannot give more
+      --  information in this case.
+
+      if not Success then
+         return;
+      end if;
+
+      Set_Load_Address (Module.C, Load_Address);
+
+      Module.Name := new String'(Module_Name);
+   end Init_Module;
+
+   -------------------------------
+   -- Module_Symbolic_Traceback --
+   -------------------------------
+
+   procedure Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Module       :        Module_Cache;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String)
+   is
+      Success : Boolean := False;
+   begin
+      if Symbolic.Module_Name.Is_Supported then
+         Append (Res, '[');
+         Append (Res, Module.Name.all);
+         Append (Res, ']' & ASCII.LF);
+      end if;
+
+      Dwarf_Lines.Symbolic_Traceback
+        (Module.C,
+         Traceback,
+         Suppress_Hex,
+         Success,
+         Res);
+
+      if not Success then
+         Hexa_Traceback (Traceback, Suppress_Hex, Res);
+      end if;
+
+      --  We must not allow an unhandled exception here, since this function
+      --  may be installed as a decorator for all automatic exceptions.
+
+   exception
+      when others =>
+         return;
+   end Module_Symbolic_Traceback;
+
+   -------------------------------------
+   -- Multi_Module_Symbolic_Traceback --
+   -------------------------------------
+
+   procedure Multi_Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String)
+   is
+      F : constant Natural := Traceback'First;
+   begin
+      if Traceback'Length = 0 or else Is_Full (Res) then
+         return;
+      end if;
+
+      if Modules_Cache /= null then
+         --  Search in the cache
+
+         declare
+            Addr        : constant Address := Traceback (F);
+            Hi, Lo, Mid : Natural;
+         begin
+            Lo := Modules_Cache'First;
+            Hi := Modules_Cache'Last;
+            while Lo <= Hi loop
+               Mid := (Lo + Hi) / 2;
+               if Addr < Low (Modules_Cache (Mid).C) then
+                  Hi := Mid - 1;
+               elsif Is_Inside (Modules_Cache (Mid).C, Addr) then
+                  Multi_Module_Symbolic_Traceback
+                    (Traceback,
+                     Modules_Cache (Mid).all,
+                     Suppress_Hex,
+                     Res);
+                  return;
+               else
+                  Lo := Mid + 1;
+               end if;
+            end loop;
+
+            --  Not found
+            Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
+            Multi_Module_Symbolic_Traceback
+              (Traceback (F + 1 .. Traceback'Last),
+               Suppress_Hex,
+               Res);
+         end;
+      else
+
+         --  First try the executable
+         if Is_Inside (Exec_Module.C, Traceback (F)) then
+            Multi_Module_Symbolic_Traceback
+              (Traceback,
+               Exec_Module,
+               Suppress_Hex,
+               Res);
+            return;
+         end if;
+
+         --  Otherwise, try a shared library
+         declare
+            Addr    : aliased System.Address := Traceback (F);
+            M_Name  : constant String        := Module_Name.Get (Addr'Access);
+            Module  : Module_Cache;
+            Success : Boolean;
+         begin
+            Init_Module (Module, Success, M_Name, System.Null_Address);
+            if Success then
+               Multi_Module_Symbolic_Traceback
+                 (Traceback,
+                  Module,
+                  Suppress_Hex,
+                  Res);
+               Close_Module (Module);
+            else
+               --  Module not found
+               Hexa_Traceback (Traceback (F .. F), Suppress_Hex, Res);
+               Multi_Module_Symbolic_Traceback
+                 (Traceback (F + 1 .. Traceback'Last),
+                  Suppress_Hex,
+                  Res);
+            end if;
+         end;
+      end if;
+   end Multi_Module_Symbolic_Traceback;
+
+   procedure Multi_Module_Symbolic_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Module       :        Module_Cache;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String)
+   is
+      Pos : Positive;
+   begin
+      --  Will symbolize the first address...
+
+      Pos := Traceback'First + 1;
+
+      --  ... and all addresses in the same module
+
+      Same_Module :
+      loop
+         exit Same_Module when Pos > Traceback'Last;
+
+         --  Get address to check for corresponding module name
+
+         exit Same_Module when not Is_Inside (Module.C, Traceback (Pos));
+
+         Pos := Pos + 1;
+      end loop Same_Module;
+
+      Module_Symbolic_Traceback
+        (Traceback (Traceback'First .. Pos - 1),
+         Module,
+         Suppress_Hex,
+         Res);
+      Multi_Module_Symbolic_Traceback
+        (Traceback (Pos .. Traceback'Last),
+         Suppress_Hex,
+         Res);
+   end Multi_Module_Symbolic_Traceback;
+
+   --------------------
+   -- Hexa_Traceback --
+   --------------------
+
+   procedure Hexa_Traceback
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String)
+   is
+      use System.Traceback_Entries;
+   begin
+      if Suppress_Hex then
+         Append (Res, "...");
+         Append (Res, ASCII.LF);
+      else
+         for J in Traceback'Range loop
+            Append_Address (Res, PC_For (Traceback (J)));
+            Append (Res, ASCII.LF);
+         end loop;
+      end if;
+   end Hexa_Traceback;
+
+   --------------------------------
+   -- Symbolic_Traceback_No_Lock --
+   --------------------------------
+
+   procedure Symbolic_Traceback_No_Lock
+     (Traceback    :        Tracebacks_Array;
+      Suppress_Hex :        Boolean;
+      Res          : in out Bounded_String)
+   is
+   begin
+      if Symbolic.Module_Name.Is_Supported then
+         Multi_Module_Symbolic_Traceback (Traceback, Suppress_Hex, Res);
+      else
+         if Exec_Module_State = Failed then
+            Append (Res, "Call stack traceback locations:" & ASCII.LF);
+            Hexa_Traceback (Traceback, Suppress_Hex, Res);
+         else
+            Module_Symbolic_Traceback
+              (Traceback,
+               Exec_Module,
+               Suppress_Hex,
+               Res);
+         end if;
+      end if;
+   end Symbolic_Traceback_No_Lock;
+
+   ------------------------
+   -- Symbolic_Traceback --
+   ------------------------
+
+   function Symbolic_Traceback
+     (Traceback    : Tracebacks_Array;
+      Suppress_Hex : Boolean) return String
+   is
+      Res : Bounded_String (Max_Length => Max_String_Length);
+   begin
+      System.Soft_Links.Lock_Task.all;
+      Init_Exec_Module;
+      Symbolic_Traceback_No_Lock (Traceback, Suppress_Hex, Res);
+      System.Soft_Links.Unlock_Task.all;
+
+      return To_String (Res);
+
+   exception
+      when others =>
+         System.Soft_Links.Unlock_Task.all;
+         raise;
+   end Symbolic_Traceback;
+
+   function Symbolic_Traceback
+     (Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
+   begin
+      return Symbolic_Traceback (Traceback, Suppress_Hex => False);
+   end Symbolic_Traceback;
+
+   function Symbolic_Traceback_No_Hex
+     (Traceback : System.Traceback_Entries.Tracebacks_Array) return String is
+   begin
+      return Symbolic_Traceback (Traceback, Suppress_Hex => True);
+   end Symbolic_Traceback_No_Hex;
+
+   function Symbolic_Traceback
+     (E            : Ada.Exceptions.Exception_Occurrence;
+      Suppress_Hex : Boolean) return String
+   is
+   begin
+      return Symbolic_Traceback
+          (Ada.Exceptions.Traceback.Tracebacks (E),
+           Suppress_Hex);
+   end Symbolic_Traceback;
+
+   function Symbolic_Traceback
+     (E : Ada.Exceptions.Exception_Occurrence) return String
+   is
+   begin
+      return Symbolic_Traceback (E, Suppress_Hex => False);
+   end Symbolic_Traceback;
+
+   function Symbolic_Traceback_No_Hex
+     (E : Ada.Exceptions.Exception_Occurrence) return String is
+   begin
+      return Symbolic_Traceback (E, Suppress_Hex => True);
+   end Symbolic_Traceback_No_Hex;
+
+   Exception_Tracebacks_Symbolic : Integer;
+   pragma Import
+     (C,
+      Exception_Tracebacks_Symbolic,
+      "__gl_exception_tracebacks_symbolic");
+   --  Boolean indicating whether symbolic tracebacks should be generated.
+
+   use Standard_Library;
+begin
+   --  If this version of this package is available, and the binder switch -Es
+   --  was given, then we want to use this as the decorator by default, and we
+   --  want to turn on tracing for Unhandled_Raise_In_Main. Note that the user
+   --  cannot have already set Exception_Trace, because the runtime library is
+   --  elaborated before user-defined code.
+
+   if Exception_Tracebacks_Symbolic /= 0 then
+      Exception_Traces.Set_Trace_Decorator (Symbolic_Traceback'Access);
+      pragma Assert (Exception_Trace = RM_Convention);
+      Exception_Trace := Unhandled_Raise_In_Main;
+   end if;
+end System.Traceback.Symbolic;
diff --git a/gcc/ada/s-tsmona-linux.adb b/gcc/ada/s-tsmona-linux.adb
new file mode 100644
index 0000000..8c1f8b4
--- /dev/null
+++ b/gcc/ada/s-tsmona-linux.adb
@@ -0,0 +1,190 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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
+
+   use System;
+
+   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;
diff --git a/gcc/ada/s-tsmona-mingw.adb b/gcc/ada/s-tsmona-mingw.adb
new file mode 100644
index 0000000..46c35cd
--- /dev/null
+++ b/gcc/ada/s-tsmona-mingw.adb
@@ -0,0 +1,93 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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 Windows specific version of this package
+
+with System.Win32; use System.Win32;
+
+separate (System.Traceback.Symbolic)
+
+package body Module_Name is
+
+   use System;
+
+   ---------------------------------
+   -- Build_Cache_For_All_Modules --
+   ---------------------------------
+
+   procedure Build_Cache_For_All_Modules is
+   begin
+      null;
+   end Build_Cache_For_All_Modules;
+
+   ---------
+   -- Get --
+   ---------
+
+   function Get (Addr : access System.Address) return String is
+      Res     : DWORD;
+      hModule : aliased HANDLE;
+      Path    : String (1 .. 1_024);
+
+   begin
+      if GetModuleHandleEx
+           (GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
+            Addr.all,
+            hModule'Access) = Win32.TRUE
+      then
+         Res := GetModuleFileName (hModule, Path'Address, Path'Length);
+
+         if FreeLibrary (hModule) = Win32.FALSE then
+            null;
+         end if;
+
+         if Res > 0 then
+            return Path (1 .. Positive (Res));
+         end if;
+      end if;
+
+      return "";
+
+   exception
+      when others =>
+         return "";
+   end Get;
+
+   ------------------
+   -- Is_Supported --
+   ------------------
+
+   function Is_Supported return Boolean is
+   begin
+      return True;
+   end Is_Supported;
+
+end Module_Name;