[multiple changes]

2014-01-20  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb: Minor comment update.

2014-01-20  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (PERSONALITY_FUNCTION/arm): Remove unused
	variables, comment out unused code.
	* a-exexpr-gcc.adb: Move declarations to s-excmac-gcc.ads
	* s-excmac-gcc.ads: New file, extracted from a-exexpr-gcc.adb
	* s-excmac-arm.ads: New file.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Slice): Remove constant D and variables
	Drange and Index_Typ. Remove the circuitry which creates a
	range check to compare the index type of the array against the
	discrete_range.
	* sem_res.adb (Resolve_Slice): Add local variable Dexpr. Update
	the circuitry which creates a range check to handle a
	discrete_range denoted by a subtype indication.

2014-01-20  Pierre-Marie Derodat  <derodat@adacore.com>

	* sinput.adb, sinput.ads (Sloc_Range): Traverse the tree of original
	nodes to get the original sloc range.

2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Use Defining_Entity to obtain the
	entity of a [library level] package.

From-SVN: r206817

12 files changed, 525 insertions, 228 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c5c209b..760a627 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2014-01-20  Robert Dewar  <dewar@adacore.com>
+
+	* gnat1drv.adb: Minor comment update.
+
+2014-01-20  Tristan Gingold  <gingold@adacore.com>
+
+	* raise-gcc.c (PERSONALITY_FUNCTION/arm): Remove unused
+	variables, comment out unused code.
+	* a-exexpr-gcc.adb: Move declarations to s-excmac-gcc.ads
+	* s-excmac-gcc.ads: New file, extracted from a-exexpr-gcc.adb
+	* s-excmac-arm.ads: New file.
+
+2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Slice): Remove constant D and variables
+	Drange and Index_Typ. Remove the circuitry which creates a
+	range check to compare the index type of the array against the
+	discrete_range.
+	* sem_res.adb (Resolve_Slice): Add local variable Dexpr. Update
+	the circuitry which creates a range check to handle a
+	discrete_range denoted by a subtype indication.
+
+2014-01-20  Pierre-Marie Derodat  <derodat@adacore.com>
+
+	* sinput.adb, sinput.ads (Sloc_Range): Traverse the tree of original
+	nodes to get the original sloc range.
+
+2014-01-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Use Defining_Entity to obtain the
+	entity of a [library level] package.
+
 2014-01-20  Tristan Gingold  <gingold@adacore.com>
 
 	* raise-gcc.c (exception_class_eq): New function.
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index a9d9e4b..fa8e9db 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -35,107 +35,13 @@ with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
 with System.Storage_Elements;  use System.Storage_Elements;
+with System.Exceptions.Machine; use System.Exceptions.Machine;
 
 separate (Ada.Exceptions)
 package body Exception_Propagation is
 
    use Exception_Traces;
 
-   ------------------------------------------------
-   -- Entities to interface with the GCC runtime --
-   ------------------------------------------------
-
-   --  These come from "C++ ABI for Itanium: Exception handling", which is the
-   --  reference for GCC.
-
-   --  Return codes from GCC runtime functions used to propagate an exception
-
-   type Unwind_Reason_Code is
-     (URC_NO_REASON,
-      URC_FOREIGN_EXCEPTION_CAUGHT,
-      URC_PHASE2_ERROR,
-      URC_PHASE1_ERROR,
-      URC_NORMAL_STOP,
-      URC_END_OF_STACK,
-      URC_HANDLER_FOUND,
-      URC_INSTALL_CONTEXT,
-      URC_CONTINUE_UNWIND);
-
-   pragma Unreferenced
-     (URC_NO_REASON,
-      URC_FOREIGN_EXCEPTION_CAUGHT,
-      URC_PHASE2_ERROR,
-      URC_PHASE1_ERROR,
-      URC_NORMAL_STOP,
-      URC_END_OF_STACK,
-      URC_HANDLER_FOUND,
-      URC_INSTALL_CONTEXT,
-      URC_CONTINUE_UNWIND);
-
-   pragma Convention (C, Unwind_Reason_Code);
-
-   --  Phase identifiers
-
-   type Unwind_Action is new Integer;
-   pragma Convention (C, Unwind_Action);
-
-   UA_SEARCH_PHASE  : constant Unwind_Action := 1;
-   UA_CLEANUP_PHASE : constant Unwind_Action := 2;
-   UA_HANDLER_FRAME : constant Unwind_Action := 4;
-   UA_FORCE_UNWIND  : constant Unwind_Action := 8;
-   UA_END_OF_STACK  : constant Unwind_Action := 16;  --  GCC extension
-
-   pragma Unreferenced
-     (UA_SEARCH_PHASE,
-      UA_CLEANUP_PHASE,
-      UA_HANDLER_FRAME,
-      UA_FORCE_UNWIND,
-      UA_END_OF_STACK);
-
-   --  Mandatory common header for any exception object handled by the
-   --  GCC unwinding runtime.
-
-   type Exception_Class is mod 2 ** 64;
-
-   GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
-   --  "GNU-Ada\0"
-
-   type Unwind_Word is mod 2 ** System.Word_Size;
-   for Unwind_Word'Size use System.Word_Size;
-   --  Map the corresponding C type used in Unwind_Exception below
-
-   type Unwind_Exception is record
-      Class    : Exception_Class;
-      Cleanup  : System.Address;
-      Private1 : Unwind_Word;
-      Private2 : Unwind_Word;
-
-      --  Usual exception structure has only two private fields, but the SEH
-      --  one has six. To avoid making this file more complex, we use six
-      --  fields on all platforms, wasting a few bytes on some.
-
-      Private3 : Unwind_Word;
-      Private4 : Unwind_Word;
-      Private5 : Unwind_Word;
-      Private6 : Unwind_Word;
-   end record;
-   pragma Convention (C, Unwind_Exception);
-   --  Map the GCC struct used for exception handling
-
-   for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
-   --  The C++ ABI mandates the common exception header to be at least
-   --  doubleword aligned, and the libGCC implementation actually makes it
-   --  maximally aligned (see unwind.h). See additional comments on the
-   --  alignment below.
-
-   type GCC_Exception_Access is access all Unwind_Exception;
-   --  Pointer to a GCC exception. Do not use convention C as on VMS this
-   --  would imply the use of 32-bits pointers.
-
-   procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access);
-   pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
-   --  Procedure to free any GCC exception
-
    Foreign_Exception : aliased System.Standard_Library.Exception_Data;
    pragma Import (Ada, Foreign_Exception,
                   "system__exceptions__foreign_exception");
@@ -145,44 +51,6 @@ package body Exception_Propagation is
    -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
    --------------------------------------------------------------
 
-   --  A GNAT exception object to be dealt with by the personality routine
-   --  called by the GCC unwinding runtime.
-
-   type GNAT_GCC_Exception is record
-      Header : Unwind_Exception;
-      --  ABI Exception header first
-
-      Occurrence : aliased Exception_Occurrence;
-      --  The Ada occurrence
-   end record;
-
-   pragma Convention (C, GNAT_GCC_Exception);
-
-   --  There is a subtle issue with the common header alignment, since the C
-   --  version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
-   --  Standard'Maximum_Alignment, and those two values don't quite represent
-   --  the same concepts and so may be decoupled someday. One typical reason
-   --  is that BIGGEST_ALIGNMENT may be larger than what the underlying system
-   --  allocator guarantees, and there are extra costs involved in allocating
-   --  objects aligned to such factors.
-
-   --  To deal with the potential alignment differences between the C and Ada
-   --  representations, the Ada part of the whole structure is only accessed
-   --  by the personality routine through the accessors declared below.  Ada
-   --  specific fields are thus always accessed through consistent layout, and
-   --  we expect the actual alignment to always be large enough to avoid traps
-   --  from the C accesses to the common header. Besides, accessors alleviate
-   --  the need for a C struct whole counterpart, both painful and error-prone
-   --  to maintain anyway.
-
-   type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
-
-   function To_GCC_Exception is new
-     Unchecked_Conversion (System.Address, GCC_Exception_Access);
-
-   function To_GNAT_GCC_Exception is new
-     Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
-
    procedure GNAT_GCC_Exception_Cleanup
      (Reason : Unwind_Reason_Code;
       Excep  : not null GNAT_GCC_Exception_Access);
@@ -317,12 +185,8 @@ package body Exception_Propagation is
       Res : GNAT_GCC_Exception_Access;
 
    begin
-      Res :=
-        new GNAT_GCC_Exception'
-        (Header     => (Class   => GNAT_Exception_Class,
-                        Cleanup => GNAT_GCC_Exception_Cleanup'Address,
-                        others  => 0),
-         Occurrence => (others => <>));
+      Res := New_Occurrence;
+      Res.Header.Cleanup := GNAT_GCC_Exception_Cleanup'Address;
       Res.Occurrence.Machine_Occurrence := Res.all'Address;
 
       return Res.Occurrence'Access;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c8cded1..f474060 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -9411,11 +9411,8 @@ package body Exp_Ch4 is
 
       --  Local variables
 
-      D         : constant Node_Id := Discrete_Range (N);
-      Pref      : constant Node_Id := Prefix (N);
-      Pref_Typ  : Entity_Id        := Etype (Pref);
-      Drange    : Node_Id;
-      Index_Typ : Entity_Id;
+      Pref     : constant Node_Id := Prefix (N);
+      Pref_Typ : Entity_Id        := Etype (Pref);
 
    --  Start of processing for Expand_N_Slice
 
@@ -9441,41 +9438,6 @@ package body Exp_Ch4 is
          Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
       end if;
 
-      --  Find the range of the discrete_range. For ranges that do not appear
-      --  in the slice itself, we make a shallow copy and inherit the source
-      --  location and the parent field from the discrete_range. This ensures
-      --  that the range check is inserted relative to the slice and that the
-      --  runtime exception poins to the proper construct.
-
-      if Nkind (D) = N_Range then
-         Drange := D;
-
-      elsif Nkind_In (D, N_Expanded_Name, N_Identifier) then
-         Drange := New_Copy (Scalar_Range (Entity (D)));
-         Set_Etype  (Drange, Entity (D));
-         Set_Parent (Drange, Parent (D));
-         Set_Sloc   (Drange, Sloc   (D));
-
-      else pragma Assert (Nkind (D) = N_Subtype_Indication);
-         Drange := New_Copy (Range_Expression (Constraint (D)));
-         Set_Etype  (Drange, Etype  (D));
-         Set_Parent (Drange, Parent (D));
-         Set_Sloc   (Drange, Sloc   (D));
-      end if;
-
-      --  Find the type of the array index
-
-      if Ekind (Pref_Typ) = E_String_Literal_Subtype then
-         Index_Typ := Etype (String_Literal_Low_Bound (Pref_Typ));
-      else
-         Index_Typ := Etype (First_Index (Pref_Typ));
-      end if;
-
-      --  Add a runtime check to test the compatibility between the array range
-      --  and the discrete_range.
-
-      Apply_Range_Check (Drange, Index_Typ);
-
       --  The remaining case to be handled is packed slices. We can leave
       --  packed slices as they are in the following situations:
 
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 02f6cb2..9e808b5 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -637,10 +637,15 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(target_cpu) $(target_vendor)
   s-vxwext.adb<s-vxwext-noints.adb \
   s-vxwext.ads<s-vxwext-vthreads.ads \
   s-vxwork.ads<s-vxwork-ppc.ads \
-  system.ads<system-vxworks-ppc-vthread.ads \
   $(ATOMICS_TARGET_PAIRS) \
   $(ATOMICS_BUILTINS_TARGET_PAIRS)
 
+  ifeq ($(strip $(filter-out e500%, $(arch))),)
+    LIBGNAT_TARGET_PAIRS += system.ads<system-vxworks-e500-vthread.ads
+  else
+    LIBGNAT_TARGET_PAIRS += system.ads<system-vxworks-ppc-vthread.ads
+  endif
+
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
   indepsw.adb<indepsw-gnu.adb
@@ -947,17 +952,47 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(target_cpu) $(target_vendor) $(ta
   s-taprop.adb<s-taprop-vxworks.adb \
   s-tasinf.ads<s-tasinf-vxworks.ads \
   s-taspri.ads<s-taspri-vxworks.ads \
-  s-tpopsp.adb<s-tpopsp-vxworks.adb \
   s-vxwork.ads<s-vxwork-arm.ads \
   g-socthi.ads<g-socthi-vxworks.ads \
   g-socthi.adb<g-socthi-vxworks.adb \
-  g-stsifd.adb<g-stsifd-sockets.adb \
-  system.ads<system-vxworks-arm.ads
+  g-stsifd.adb<g-stsifd-sockets.adb
 
   TOOLS_TARGET_PAIRS=\
   mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
   indepsw.adb<indepsw-gnu.adb
 
+  ifeq ($(strip $(filter-out rtp-smp,$(THREAD_KIND))),)
+    LIBGNAT_TARGET_PAIRS += \
+    s-mudido.adb<s-mudido-affinity.adb \
+    s-vxwext.ads<s-vxwext-rtp.ads \
+    s-vxwext.adb<s-vxwext-rtp-smp.adb \
+    s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
+    system.ads<system-vxworks-arm-rtp.ads
+
+    EXTRA_LIBGNAT_OBJS+=affinity.o
+  else
+    ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
+      LIBGNAT_TARGET_PAIRS += \
+      s-mudido.adb<s-mudido-affinity.adb \
+      s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
+      s-vxwext.ads<s-vxwext-kernel.ads \
+      s-vxwext.adb<s-vxwext-kernel-smp.adb \
+      system.ads<system-vxworks-arm.ads
+
+      EXTRA_LIBGNAT_OBJS+=affinity.o
+    else
+      LIBGNAT_TARGET_PAIRS += \
+      s-tpopsp.adb<s-tpopsp-vxworks.adb \
+      system.ads<system-vxworks-arm.ads
+
+      ifeq ($(strip $(filter-out kernel,$(THREAD_KIND))),)
+        LIBGNAT_TARGET_PAIRS += \
+        s-vxwext.ads<s-vxwext-kernel.ads \
+        s-vxwext.adb<s-vxwext-kernel.adb
+      endif
+    endif
+  endif
+
   EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
   EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
 
@@ -2317,9 +2352,11 @@ ifeq ($(strip $(filter-out arm nucleus%,$(target_cpu) $(target_os))),)
 endif
 
 ifeq ($(EH_MECHANISM),-gcc)
-  LIBGNAT_TARGET_PAIRS += a-exexpr.adb<a-exexpr-gcc.adb
+  LIBGNAT_TARGET_PAIRS += \
+    a-exexpr.adb<a-exexpr-gcc.adb \
+    s-excmac.ads<s-excmac-gcc.ads
   EXTRA_LIBGNAT_OBJS+=raise-gcc.o
-  EXTRA_GNATRTL_NONTASKING_OBJS+=g-cppexc.o
+  EXTRA_GNATRTL_NONTASKING_OBJS+=g-cppexc.o s-excmac.o
 endif
 
 # Use the Ada 2005 version of Ada.Exceptions by default, unless specified
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 8eb9173..19df9fd 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -289,6 +289,9 @@ procedure Gnat1drv is
          Relaxed_RM_Semantics := True;
       end if;
 
+      --  Enable some individual switches that are implied by relaxed RM
+      --  semantics mode.
+
       if Relaxed_RM_Semantics then
          Overriding_Renamings := True;
          Treat_Categorization_Errors_As_Warnings := True;
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 53fc070..fda51cc 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -878,6 +878,8 @@ exception_class_eq (const _GNAT_Exception *except, unsigned long long ec)
 #endif
 }
 
+/* Return how CHOICE matches PROPAGATED_EXCEPTION.  */
+
 static enum action_kind
 is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception)
 {
@@ -937,7 +939,8 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception)
       void *choice_typeinfo = Foreign_Data_For (choice);
       void *except_typeinfo =
 	(((struct __cxa_exception *)
-	  ((_Unwind_Exception *)propagated_exception + 1)) - 1)->exceptionType;
+	  ((_Unwind_Exception *)propagated_exception + 1)) - 1)
+	->exceptionType;
 
       /* Typeinfo are directly compared, which might not be correct if they
 	 aren't merged.  ??? We should call the == operator if this module is
@@ -995,7 +998,6 @@ get_action_description_for (_Unwind_Ptr ip,
   else
     {
       const unsigned char * p = action->table_entry;
-
       _sleb128_t ar_filter, ar_disp;
 
       action->kind = nothing;
@@ -1028,7 +1030,8 @@ get_action_description_for (_Unwind_Ptr ip,
 
                   /* See if the filter we have is for an exception which
                      matches the one we are propagating.  */
-                  _Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
+                  _Unwind_Ptr choice =
+		    get_ttype_entry_for (region, ar_filter);
 
 		  act = is_handled_by (choice, gnat_exception);
                   if (act != nothing)
@@ -1105,7 +1108,7 @@ extern void __gnat_notify_unhandled_exception (struct Exception_Occurrence *);
 #endif
 
 /* Code executed to continue unwinding.  With the ARM unwinder, the
-   personality routine must unwind one frame.  */
+   personality routine must unwind one frame (per EHABI 7.3 4.).  */
 
 static _Unwind_Reason_Code
 continue_unwind (struct _Unwind_Exception* ue_header,
@@ -1294,9 +1297,6 @@ PERSONALITY_FUNCTION (_Unwind_State state,
 		      struct _Unwind_Context* uw_context)
 {
   _Unwind_Action uw_phases;
-  region_descriptor region;
-  action_descriptor action;
-  _Unwind_Ptr ip;
 
   switch (state & _US_ACTION_MASK)
     {
@@ -1306,14 +1306,21 @@ PERSONALITY_FUNCTION (_Unwind_State state,
       break;
 
     case _US_UNWIND_FRAME_STARTING:
+      /* Phase 2, to call a cleanup.  */
       uw_phases = _UA_CLEANUP_PHASE;
+#if 0
+      /* ??? We don't use UA_HANDLER_FRAME (except to debug).  Futhermore,
+	 barrier_cache.sp isn't yet set.  */
       if (!(state & _US_FORCE_UNWIND)
 	  && (uw_exception->barrier_cache.sp
 	      == _Unwind_GetGR (uw_context, UNWIND_STACK_REG)))
 	uw_phases |= _UA_HANDLER_FRAME;
+#endif
       break;
 
     case _US_UNWIND_FRAME_RESUME:
+      /* Phase 2, called at the return of a cleanup.  In the GNU
+	 implementation, there is nothing left to do, so we simply go on.  */
       return continue_unwind (uw_exception, uw_context);
 
     default:
diff --git a/gcc/ada/s-excmac-arm.ads b/gcc/ada/s-excmac-arm.ads
new file mode 100644
index 0000000..44997e4
--- /dev/null
+++ b/gcc/ada/s-excmac-arm.ads
@@ -0,0 +1,181 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--              S Y S T E M . E X C E P T I O N S . M A C H I N E           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2013, 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 is the version using the ARM EHABI mechanism
+
+with Ada.Unchecked_Conversion;
+with Ada.Exceptions;
+
+package System.Exceptions.Machine is
+   pragma Preelaborate;
+
+   ------------------------------------------------
+   -- Entities to interface with the GCC runtime --
+   ------------------------------------------------
+
+   --  Return codes from GCC runtime functions used to propagate an exception
+
+   type Unwind_Reason_Code is
+     (URC_OK,
+      URC_FOREIGN_EXCEPTION_CAUGHT,
+      URC_Unused2,
+      URC_Unused3,
+      URC_Unused4,
+      URC_Unused5,
+      URC_HANDLER_FOUND,
+      URC_INSTALL_CONTEXT,
+      URC_CONTINUE_UNWIND,
+      URC_FAILURE);
+
+   pragma Unreferenced
+     (URC_OK,
+      URC_FOREIGN_EXCEPTION_CAUGHT,
+      URC_Unused2,
+      URC_Unused3,
+      URC_Unused4,
+      URC_Unused5,
+      URC_HANDLER_FOUND,
+      URC_INSTALL_CONTEXT,
+      URC_CONTINUE_UNWIND,
+      URC_FAILURE);
+
+   pragma Convention (C, Unwind_Reason_Code);
+   subtype Unwind_Action is Unwind_Reason_Code;
+   --  Phase identifiers
+
+   type uint32_t is mod 2**32;
+   pragma Convention (C, uint32_t);
+
+   type uint32_t_array is array (Natural range <>) of uint32_t;
+   pragma Convention (C, uint32_t_array);
+
+   type Unwind_State is new uint32_t;
+   pragma Convention (C, Unwind_State);
+
+   US_VIRTUAL_UNWIND_FRAME  : constant Unwind_State := 0;
+   US_UNWIND_FRAME_STARTING : constant Unwind_State := 1;
+   US_UNWIND_FRAME_RESUME   : constant Unwind_State := 2;
+
+   pragma Unreferenced
+     (US_VIRTUAL_UNWIND_FRAME,
+      US_UNWIND_FRAME_STARTING,
+      US_UNWIND_FRAME_RESUME);
+
+   --  Mandatory common header for any exception object handled by the
+   --  GCC unwinding runtime.
+
+   type Exception_Class is array (0 .. 7) of Character;
+
+   GNAT_Exception_Class : constant Exception_Class := "GNU-Ada" & ASCII.NUL;
+   --  "GNU-Ada\0"
+
+   type Unwinder_Cache_Type is record
+      Reserved1 : uint32_t;
+      Reserved2 : uint32_t;
+      Reserved3 : uint32_t;
+      Reserved4 : uint32_t;
+      Reserved5 : uint32_t;
+   end record;
+
+   type Barrier_Cache_Type is record
+      Sp          : uint32_t;
+      Bitpattern  : uint32_t_array (0 .. 4);
+   end record;
+
+   type Cleanup_Cache_Type is record
+     Bitpattern : uint32_t_array (0 .. 3);
+   end record;
+
+   type Pr_Cache_Type is record
+      Fnstart    : uint32_t;
+      Ehtp       : System.Address;
+      Additional : uint32_t;
+      Reserved1  : uint32_t;
+   end record;
+
+   type Unwind_Control_Block is record
+      Class    : Exception_Class;
+      Cleanup  : System.Address;
+
+      --  Caches
+      Unwinder_Cache : Unwinder_Cache_Type;
+      Barrier_Cache  : Barrier_Cache_Type;
+      Cleanup_Cache  : Cleanup_Cache_Type;
+      Pr_Cache       : Pr_Cache_Type;
+   end record;
+   pragma Convention (C, Unwind_Control_Block);
+   for Unwind_Control_Block'Alignment use 8;
+   --  Map the GCC struct used for exception handling
+
+   type Unwind_Control_Block_Access is access all Unwind_Control_Block;
+   subtype GCC_Exception_Access is Unwind_Control_Block_Access;
+   --  Pointer to a UCB
+
+   procedure Unwind_DeleteException
+     (Ucbp : not null Unwind_Control_Block_Access);
+   pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
+   --  Procedure to free any GCC exception
+
+   --------------------------------------------------------------
+   -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
+   --------------------------------------------------------------
+
+   --  A GNAT exception object to be dealt with by the personality routine
+   --  called by the GCC unwinding runtime.
+
+   type GNAT_GCC_Exception is record
+      Header : Unwind_Control_Block;
+      --  ABI Exception header first
+
+      Occurrence : aliased Ada.Exceptions.Exception_Occurrence;
+      --  The Ada occurrence
+   end record;
+
+   pragma Convention (C, GNAT_GCC_Exception);
+
+   type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
+
+   function To_GCC_Exception is new
+     Ada.Unchecked_Conversion (System.Address, GCC_Exception_Access);
+
+   function To_GNAT_GCC_Exception is new
+     Ada.Unchecked_Conversion
+     (GCC_Exception_Access, GNAT_GCC_Exception_Access);
+
+   function New_Occurrence return GNAT_GCC_Exception_Access is
+      (new GNAT_GCC_Exception'
+         (Header     => (Class   => GNAT_Exception_Class,
+                         Unwinder_Cache => (Reserved1 => 0,
+                                            others => <>),
+                         others => <>),
+          Occurrence => <>));
+   --  Allocate and initialize a machine occurrence
+end System.Exceptions.Machine;
diff --git a/gcc/ada/s-excmac-gcc.ads b/gcc/ada/s-excmac-gcc.ads
new file mode 100644
index 0000000..80e4cef
--- /dev/null
+++ b/gcc/ada/s-excmac-gcc.ads
@@ -0,0 +1,186 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--              S Y S T E M . E X C E P T I O N S . M A C H I N E           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--            Copyright (C) 2013, 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 is the version using the GCC EH mechanism
+
+with Ada.Unchecked_Conversion;
+with Ada.Exceptions;
+
+package System.Exceptions.Machine is
+   pragma Preelaborate;
+
+   ------------------------------------------------
+   -- Entities to interface with the GCC runtime --
+   ------------------------------------------------
+
+   --  These come from "C++ ABI for Itanium: Exception handling", which is
+   --  the reference for GCC.
+
+   --  Return codes from the GCC runtime functions used to propagate
+   --  an exception.
+
+   type Unwind_Reason_Code is
+     (URC_NO_REASON,
+      URC_FOREIGN_EXCEPTION_CAUGHT,
+      URC_PHASE2_ERROR,
+      URC_PHASE1_ERROR,
+      URC_NORMAL_STOP,
+      URC_END_OF_STACK,
+      URC_HANDLER_FOUND,
+      URC_INSTALL_CONTEXT,
+      URC_CONTINUE_UNWIND);
+
+   pragma Unreferenced
+     (URC_NO_REASON,
+      URC_FOREIGN_EXCEPTION_CAUGHT,
+      URC_PHASE2_ERROR,
+      URC_PHASE1_ERROR,
+      URC_NORMAL_STOP,
+      URC_END_OF_STACK,
+      URC_HANDLER_FOUND,
+      URC_INSTALL_CONTEXT,
+      URC_CONTINUE_UNWIND);
+
+   pragma Convention (C, Unwind_Reason_Code);
+
+   --  Phase identifiers
+
+   type Unwind_Action is new Integer;
+   pragma Convention (C, Unwind_Action);
+
+   UA_SEARCH_PHASE  : constant Unwind_Action := 1;
+   UA_CLEANUP_PHASE : constant Unwind_Action := 2;
+   UA_HANDLER_FRAME : constant Unwind_Action := 4;
+   UA_FORCE_UNWIND  : constant Unwind_Action := 8;
+   UA_END_OF_STACK  : constant Unwind_Action := 16;  --  GCC extension
+
+   pragma Unreferenced
+     (UA_SEARCH_PHASE,
+      UA_CLEANUP_PHASE,
+      UA_HANDLER_FRAME,
+      UA_FORCE_UNWIND,
+      UA_END_OF_STACK);
+
+   --  Mandatory common header for any exception object handled by the
+   --  GCC unwinding runtime.
+
+   type Exception_Class is mod 2 ** 64;
+
+   GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
+   --  "GNU-Ada\0"
+
+   type Unwind_Word is mod 2 ** System.Word_Size;
+   for Unwind_Word'Size use System.Word_Size;
+   --  Map the corresponding C type used in Unwind_Exception below
+
+   type Unwind_Exception is record
+      Class    : Exception_Class;
+      Cleanup  : System.Address;
+      Private1 : Unwind_Word;
+      Private2 : Unwind_Word;
+
+      --  Usual exception structure has only two private fields, but the SEH
+      --  one has six. To avoid making this file more complex, we use six
+      --  fields on all platforms, wasting a few bytes on some.
+
+      Private3 : Unwind_Word;
+      Private4 : Unwind_Word;
+      Private5 : Unwind_Word;
+      Private6 : Unwind_Word;
+   end record;
+   pragma Convention (C, Unwind_Exception);
+   --  Map the GCC struct used for exception handling
+
+   for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
+   --  The C++ ABI mandates the common exception header to be at least
+   --  doubleword aligned, and the libGCC implementation actually makes it
+   --  maximally aligned (see unwind.h). See additional comments on the
+   --  alignment below.
+
+   --  There is a subtle issue with the common header alignment, since the C
+   --  version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
+   --  Standard'Maximum_Alignment, and those two values don't quite represent
+   --  the same concepts and so may be decoupled someday. One typical reason
+   --  is that BIGGEST_ALIGNMENT may be larger than what the underlying system
+   --  allocator guarantees, and there are extra costs involved in allocating
+   --  objects aligned to such factors.
+
+   --  To deal with the potential alignment differences between the C and Ada
+   --  representations, the Ada part of the whole structure is only accessed
+   --  by the personality routine through accessors. Ada specific fields are
+   --  thus always accessed through consistent layout, and we expect the
+   --  actual alignment to always be large enough to avoid traps from the C
+   --  accesses to the common header. Besides, accessors alleviate the need
+   --  for a C struct whole counterpart, both painful and error-prone to
+   --  maintain anyway.
+
+   type GCC_Exception_Access is access all Unwind_Exception;
+   --  Pointer to a GCC exception. Do not use convention C as on VMS this
+   --  would imply the use of 32-bits pointers.
+
+   procedure Unwind_DeleteException (Excp : not null GCC_Exception_Access);
+   pragma Import (C, Unwind_DeleteException, "_Unwind_DeleteException");
+   --  Procedure to free any GCC exception
+
+   --------------------------------------------------------------
+   -- GNAT Specific Entities To Deal With The GCC EH Circuitry --
+   --------------------------------------------------------------
+
+   --  A GNAT exception object to be dealt with by the personality routine
+   --  called by the GCC unwinding runtime.
+
+   type GNAT_GCC_Exception is record
+      Header : Unwind_Exception;
+      --  ABI Exception header first
+
+      Occurrence : aliased Ada.Exceptions.Exception_Occurrence;
+      --  The Ada occurrence
+   end record;
+
+   pragma Convention (C, GNAT_GCC_Exception);
+
+   type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
+
+   function To_GCC_Exception is new
+     Ada.Unchecked_Conversion (System.Address, GCC_Exception_Access);
+
+   function To_GNAT_GCC_Exception is new
+     Ada.Unchecked_Conversion
+       (GCC_Exception_Access, GNAT_GCC_Exception_Access);
+
+   function New_Occurrence return GNAT_GCC_Exception_Access is
+      (new GNAT_GCC_Exception'
+        (Header     => (Class   => GNAT_Exception_Class,
+                        Cleanup => Null_Address,
+                        others  => 0),
+         Occurrence => <>));
+   --  Allocate and initialize a machine occurrence
+end System.Exceptions.Machine;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 38dad25..c021143 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -18142,7 +18142,7 @@ package body Sem_Prag is
                      Context := Specification (Context);
                   end if;
 
-                  Body_Id := Defining_Unit_Name (Context);
+                  Body_Id := Defining_Entity (Context);
 
                   Chain_Pragma (Body_Id, N);
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9ebb0bc..d99d94f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9155,6 +9155,7 @@ package body Sem_Res is
       Drange     : constant Node_Id := Discrete_Range (N);
       Name       : constant Node_Id := Prefix (N);
       Array_Type : Entity_Id        := Empty;
+      Dexpr      : Node_Id          := Empty;
       Index_Type : Entity_Id;
 
    begin
@@ -9267,47 +9268,64 @@ package body Sem_Res is
          Array_Type := Etype (Name);
       end if;
 
+      --  Obtain the type of the array index
+
+      if Ekind (Array_Type) = E_String_Literal_Subtype then
+         Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+      else
+         Index_Type := Etype (First_Index (Array_Type));
+      end if;
+
       --  If name was overloaded, set slice type correctly now
 
       Set_Etype (N, Array_Type);
 
-      --  If the range is specified by a subtype mark, no resolution is
-      --  necessary. Else resolve the bounds, and apply needed checks.
+      --  Handle the generation of a range check that compares the array index
+      --  against the discrete_range. The check is not applied to internally
+      --  built nodes associated with the expansion of dispatch tables. Check
+      --  that Ada.Tags has already been loaded to avoid extra dependencies on
+      --  the unit.
+
+      if Tagged_Type_Expansion
+        and then RTU_Loaded (Ada_Tags)
+        and then Nkind (Prefix (N)) = N_Selected_Component
+        and then Present (Entity (Selector_Name (Prefix (N))))
+        and then Entity (Selector_Name (Prefix (N))) =
+                   RTE_Record_Component (RE_Prims_Ptr)
+      then
+         null;
 
-      if not Is_Entity_Name (Drange) then
-         if Ekind (Array_Type) = E_String_Literal_Subtype then
-            Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
-         else
-            Index_Type := Etype (First_Index (Array_Type));
-         end if;
+      --  The discrete_range is specified by a subtype indication. Create a
+      --  shallow copy and inherit the type, parent and source location from
+      --  the discrete_range. This ensures that the range check is inserted
+      --  relative to the slice and that the runtime exception points to the
+      --  proper construct.
 
-         Resolve (Drange, Base_Type (Index_Type));
+      elsif Is_Entity_Name (Drange) then
+         Dexpr := New_Copy (Scalar_Range (Entity (Drange)));
 
-         if Nkind (Drange) = N_Range then
+         Set_Etype  (Dexpr, Etype  (Drange));
+         Set_Parent (Dexpr, Parent (Drange));
+         Set_Sloc   (Dexpr, Sloc   (Drange));
 
-            --  Ensure that side effects in the bounds are properly handled
+      --  The discrete_range is a regular range. Resolve the bounds and remove
+      --  their side effects.
 
-            Force_Evaluation (Low_Bound (Drange));
+      else
+         Resolve (Drange, Base_Type (Index_Type));
+
+         if Nkind (Drange) = N_Range then
+            Force_Evaluation (Low_Bound  (Drange));
             Force_Evaluation (High_Bound (Drange));
 
-            --  Do not apply the range check to nodes associated with the
-            --  frontend expansion of the dispatch table. We first check
-            --  if Ada.Tags is already loaded to avoid the addition of an
-            --  undesired dependence on such run-time unit.
-
-            if not Tagged_Type_Expansion
-              or else not
-                (RTU_Loaded (Ada_Tags)
-                  and then Nkind (Prefix (N)) = N_Selected_Component
-                  and then Present (Entity (Selector_Name (Prefix (N))))
-                  and then Entity (Selector_Name (Prefix (N))) =
-                                         RTE_Record_Component (RE_Prims_Ptr))
-            then
-               Apply_Range_Check (Drange, Index_Type);
-            end if;
+            Dexpr := Drange;
          end if;
       end if;
 
+      if Present (Dexpr) then
+         Apply_Range_Check (Dexpr, Index_Type);
+      end if;
+
       Set_Slice_Subtype (N);
 
       --  Check bad use of type with predicates
diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb
index 7bd0a69..78920da 100644
--- a/gcc/ada/sinput.adb
+++ b/gcc/ada/sinput.adb
@@ -770,18 +770,20 @@ package body Sinput is
       -------------
 
       function Process (N : Node_Id) return Traverse_Result is
+         Orig : constant Node_Id := Original_Node (N);
       begin
-         if Sloc (N) < Min then
-            if Sloc (N) > No_Location then
-               Min := Sloc (N);
+         if Sloc (Orig) < Min then
+            if Sloc (Orig) > No_Location then
+               Min := Sloc (Orig);
             end if;
-         elsif Sloc (N) > Max then
-            if Sloc (N) > No_Location then
-               Max := Sloc (N);
+
+         elsif Sloc (Orig) > Max then
+            if Sloc (Orig) > No_Location then
+               Max := Sloc (Orig);
             end if;
          end if;
 
-         return OK;
+         return OK_Orig;
       end Process;
 
    --  Start of processing for Sloc_Range
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index b5b2d74..899bead 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -693,8 +693,13 @@ package Sinput is
    --  as the locations of the first and last token in the node construct
    --  because parentheses at the outer level do not have a recorded Sloc.
    --
+   --  Note: At each step of the tree traversal, we make sure to go back to
+   --  the Original_Node, since this function is concerned about original
+   --  (source) locations.
+   --
    --  Note: if the tree for the expression contains no "real" Sloc values,
-   --  i.e. values > No_Location, then both Min and Max are set to Sloc (Expr).
+   --  i.e. values > No_Location, then both Min and Max are set to
+   --  Sloc (Original_Node (N)).
 
    function Source_Offset (S : Source_Ptr) return Nat;
    --  Returns the zero-origin offset of the given source location from the