2016-04-18 Ed Schonberg <schonberg@adacore.com>

	* sem_disp.adb (Check_Dispatching_Call): Major rewriting to
	handle some complex cases of tag indeterminate calls that are
	actuals in other dispatching calls that are themselves tag
	indeterminate.
	(Check_Dispatching_Context): Add parameter to support recursive
	check for an enclosing construct that may provide a tag for a
	tag-indeterminate call.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Depends_In_Decl_Part):
	Add global variables Task_Input_Seen and Task_Output_Seen.
	(Analyze_Global_Item): Detect an illegal use of the current
	instance of a single protected/task type in a global annotation.
	(Analyze_Input_Output): Inputs and output related to the current
	instance of a task unit are now tracked.
	(Check_Usage): Require
	the presence of the current instance of a task unit only when
	one input/output is available.	(Current_Task_Instance_Seen):
	New routine.
	(Is_CCT_Instance): New parameter profile. Update
	the comment on usage. The routine now properly recognizes several
	cases related to single protected/task types.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_Entity): Use New_Freeze_Node
	to create a brand new freeze node. This handles a case where an
	ignored Ghost context is freezing something which is not ignored
	Ghost and whose freeze node should not be removed from the tree.
	(New_Freeze_Node): New routine.

2016-04-18  Jerome Lambourg  <lambourg@adacore.com>

	* sigtramp.h (__gnat_set_is_vxsim) New function to
	tell sigtramp-vxworks to handle vxsim signal contexts.	*
	sigtramp-vxworks.c (__gnat_sigtramp) Take into account the
	differences in the sigcontext structure between the expected
	regular x86 or x86_64 ones and the ones received in case of
	exexution on the vxworks simulator.
	* init.c: also compute is_vxsim in case of x86_64-vx7 target. Provide
	this information to sigtramp-vxworks.c. Remove the old mechanism for
	vxsim.
	* init-vxsim.c, sigtramp-vxworks-vxsim.c: remove, now obsolete.

2016-04-18  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch3.adb (Inline_Init_Proc): New function returning
	whether the initialization procedure of a type should be
	inlined.  Return again True for controlled type themselves.
	(Build_Array_Init_Proc): Call it to set Set_Is_Inlined on Init_Proc.
	(Build_Record_Init_Proc): Likewise.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235110 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 497 insertions, 381 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1cbbd4a0ec1..c4e73d11328 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,58 @@
+2016-04-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Call): Major rewriting to
+	handle some complex cases of tag indeterminate calls that are
+	actuals in other dispatching calls that are themselves tag
+	indeterminate.
+	(Check_Dispatching_Context): Add parameter to support recursive
+	check for an enclosing construct that may provide a tag for a
+	tag-indeterminate call.
+
+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Depends_In_Decl_Part):
+	Add global variables Task_Input_Seen and Task_Output_Seen.
+	(Analyze_Global_Item): Detect an illegal use of the current
+	instance of a single protected/task type in a global annotation.
+	(Analyze_Input_Output): Inputs and output related to the current
+	instance of a task unit are now tracked.
+	(Check_Usage): Require
+	the presence of the current instance of a task unit only when
+	one input/output is available.	(Current_Task_Instance_Seen):
+	New routine.
+	(Is_CCT_Instance): New parameter profile. Update
+	the comment on usage. The routine now properly recognizes several
+	cases related to single protected/task types.
+
+2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* freeze.adb (Freeze_Entity): Use New_Freeze_Node
+	to create a brand new freeze node. This handles a case where an
+	ignored Ghost context is freezing something which is not ignored
+	Ghost and whose freeze node should not be removed from the tree.
+	(New_Freeze_Node): New routine.
+
+2016-04-18  Jerome Lambourg  <lambourg@adacore.com>
+
+	* sigtramp.h (__gnat_set_is_vxsim) New function to
+	tell sigtramp-vxworks to handle vxsim signal contexts.	*
+	sigtramp-vxworks.c (__gnat_sigtramp) Take into account the
+	differences in the sigcontext structure between the expected
+	regular x86 or x86_64 ones and the ones received in case of
+	exexution on the vxworks simulator.
+	* init.c: also compute is_vxsim in case of x86_64-vx7 target. Provide
+	this information to sigtramp-vxworks.c. Remove the old mechanism for
+	vxsim.
+	* init-vxsim.c, sigtramp-vxworks-vxsim.c: remove, now obsolete.
+
+2016-04-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_ch3.adb (Inline_Init_Proc): New function returning
+	whether the initialization procedure of a type should be
+	inlined.  Return again True for controlled type themselves.
+	(Build_Array_Init_Proc): Call it to set Set_Is_Inlined on Init_Proc.
+	(Build_Record_Init_Proc): Likewise.
+
 2016-04-18  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnatvsn.ads (Library_Version): Bump to 7.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 869220fdb59..a858f759e82 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -226,6 +226,9 @@ package body Exp_Ch3 is
    --
    --  The caller must append additional entries for discriminants if required.
 
+   function Inline_Init_Proc (Typ : Entity_Id) return Boolean;
+   --  Returns true if the initialization procedure of Typ should be inlined
+
    function In_Runtime (E : Entity_Id) return Boolean;
    --  Check if E is defined in the RTL (in a child of Ada or System). Used
    --  to avoid to bring in the overhead of _Input, _Output for tagged types.
@@ -756,14 +759,10 @@ package body Exp_Ch3 is
             Set_Debug_Info_Off (Proc_Id);
          end if;
 
-         --  Set inlined unless tasks are around, in which case we do not
-         --  want to inline, because nested stuff may cause difficulties in
-         --  inter-unit inlining, and furthermore there is in any case no
-         --  point in inlining such complex init procs.
+         --  Set Inlined on Init_Proc if it is set on the Init_Proc of the
+         --  component type itself (see also Build_Record_Init_Proc).
 
-         if not Has_Task (Proc_Id) then
-            Set_Is_Inlined (Proc_Id);
-         end if;
+         Set_Is_Inlined (Proc_Id, Inline_Init_Proc (Comp_Type));
 
          --  Associate Init_Proc with type, and determine if the procedure
          --  is null (happens because of the Initialize_Scalars pragma case,
@@ -3592,21 +3591,8 @@ package body Exp_Ch3 is
          Build_Offset_To_Top_Functions;
          Build_CPP_Init_Procedure;
          Build_Init_Procedure;
-         Set_Is_Public (Proc_Id, Is_Public (Rec_Ent));
-
-         --  The initialization of protected records is not worth inlining.
-         --  In addition, when compiled for another unit for inlining purposes,
-         --  it may make reference to entities that have not been elaborated
-         --  yet. Similar considerations apply to task types and types that
-         --  need finalization.
-
-         if not Is_Concurrent_Type (Rec_Type)
-           and then not Has_Task (Rec_Type)
-           and then not Needs_Finalization (Rec_Type)
-         then
-            Set_Is_Inlined  (Proc_Id);
-         end if;
 
+         Set_Is_Public      (Proc_Id, Is_Public (Rec_Ent));
          Set_Is_Internal    (Proc_Id);
          Set_Has_Completion (Proc_Id);
 
@@ -3614,6 +3600,8 @@ package body Exp_Ch3 is
             Set_Debug_Info_Off (Proc_Id);
          end if;
 
+         Set_Is_Inlined (Proc_Id, Inline_Init_Proc (Rec_Type));
+
          --  Do not build an aggregate if Modify_Tree_For_C, this isn't
          --  needed and may generate early references to non frozen types
          --  since we expand aggregate much more systematically.
@@ -8230,6 +8218,34 @@ package body Exp_Ch3 is
       end if;
    end Has_New_Non_Standard_Rep;
 
+   ----------------------
+   -- Inline_Init_Proc --
+   ----------------------
+
+   function Inline_Init_Proc (Typ : Entity_Id) return Boolean is
+   begin
+      --  The initialization proc of protected records is not worth inlining.
+      --  In addition, when compiled for another unit for inlining purposes,
+      --  it may make reference to entities that have not been elaborated yet.
+      --  The initialization proc of records that need finalization contains
+      --  a nested clean-up procedure that makes it impractical to inline as
+      --  well, except for simple controlled types themselves. And similar
+      --  considerations apply to task types.
+
+      if Is_Concurrent_Type (Typ) then
+         return False;
+
+      elsif Needs_Finalization (Typ) and then not Is_Controlled (Typ) then
+         return False;
+
+      elsif Has_Task (Typ) then
+         return False;
+
+      else
+         return True;
+      end if;
+   end Inline_Init_Proc;
+
    ----------------
    -- In_Runtime --
    ----------------
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 93fd53cc377..736535eafaf 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1997,6 +1997,9 @@ package body Freeze is
       --  call, but rather must go in the package holding the function, so that
       --  the backend can process it in the proper context.
 
+      function New_Freeze_Node return Node_Id;
+      --  Create a new freeze node for entity E
+
       procedure Wrap_Imported_Subprogram (E : Entity_Id);
       --  If E is an entity for an imported subprogram with pre/post-conditions
       --  then this procedure will create a wrapper to ensure that proper run-
@@ -4589,6 +4592,39 @@ package body Freeze is
          Append_List (Result, Decls);
       end Late_Freeze_Subprogram;
 
+      ---------------------
+      -- New_Freeze_Node --
+      ---------------------
+
+      function New_Freeze_Node return Node_Id is
+         Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
+         Result          : Node_Id;
+
+      begin
+         --  Handle the case where an ignored Ghost subprogram freezes the type
+         --  of one of its formals. The type can either be non-Ghost or checked
+         --  Ghost. Since the freeze node for the type is generated in the
+         --  context of the subprogram, the node will be incorrectly flagged as
+         --  ignored Ghost and erroneously removed from the tree.
+
+         --    type Typ is ...;
+         --    procedure Ignored_Ghost_Proc (Formal : Typ) with Ghost;
+
+         --  Reset the Ghost mode to "none". This preserves the freeze node.
+
+         if Ghost_Mode = Ignore
+           and then not Is_Ignored_Ghost_Entity (E)
+           and then not Is_Ignored_Ghost_Node (E)
+         then
+            Ghost_Mode := None;
+         end if;
+
+         Result := New_Node (N_Freeze_Entity, Loc);
+
+         Ghost_Mode := Save_Ghost_Mode;
+         return Result;
+      end New_Freeze_Node;
+
       ------------------------------
       -- Wrap_Imported_Subprogram --
       ------------------------------
@@ -6281,7 +6317,7 @@ package body Freeze is
             Set_Sloc (F_Node, Loc);
 
          else
-            F_Node := New_Node (N_Freeze_Entity, Loc);
+            F_Node := New_Freeze_Node;
             Set_Freeze_Node (E, F_Node);
             Set_Access_Types_To_Process (F_Node, No_Elist);
             Set_TSS_Elist (F_Node, No_Elist);
@@ -6299,9 +6335,7 @@ package body Freeze is
          --  subtypes can only be elaborated after the type itself, and they
          --  need an itype reference.
 
-         if Ekind (E) = E_Record_Type
-           and then Has_Discriminants (E)
-         then
+         if Ekind (E) = E_Record_Type and then Has_Discriminants (E) then
             declare
                Comp : Entity_Id;
                IR   : Node_Id;
diff --git a/gcc/ada/init-vxsim.c b/gcc/ada/init-vxsim.c
deleted file mode 100644
index 9466dbc7915..00000000000
--- a/gcc/ada/init-vxsim.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/****************************************************************************
- *                                                                          *
- *                         GNAT COMPILER COMPONENTS                         *
- *                                                                          *
- *                           I N I T - V X S I M                            *
- *                                                                          *
- *                          C Implementation File                           *
- *                                                                          *
- *          Copyright (C) 1992-2015, 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 file is an addition to init.c that must be compiled with the CPU
-   specified for running under vxsim for x86-vxworks6, as the signal context
-   structure is different for vxsim vs. real hardware.  */
-
-#undef CPU
-#define CPU __VXSIM_CPU__
-
-#include "vxWorks.h"
-#include "tconfig.h"
-
-#include <signal.h>
-#include <taskLib.h>
-
-#ifndef __RTP__
-#include <intLib.h>
-#include <iv.h>
-#endif
-
-extern void
-__gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
-		   void *sc ATTRIBUTE_UNUSED);
-
-/* Process the vxsim signal context.  */
-void
-__gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc)
-{
-  #include "sigtramp.h"
-
-  __gnat_sigtramp_vxsim (sig, (void *)si, (void *)sc,
-		   (__sigtramphandler_t *)&__gnat_map_signal);
-}
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index ae9b58e0fb8..43ea1e78dad 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1705,10 +1705,12 @@ __gnat_install_handler (void)
 
 #include <signal.h>
 #include <taskLib.h>
-#if defined (__i386__) && !defined (VTHREADS)
+#if (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
 #include <sysLib.h>
 #endif
 
+#include "sigtramp.h"
+
 #ifndef __RTP__
 #include <intLib.h>
 #include <iv.h>
@@ -1814,7 +1816,9 @@ __gnat_clear_exception_count (void)
 /* Handle different SIGnal to exception mappings in different VxWorks
    versions.  */
 void
-__gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *sc)
+__gnat_map_signal (int sig,
+                   siginfo_t *si ATTRIBUTE_UNUSED,
+                   void *sc ATTRIBUTE_UNUSED)
 {
   struct Exception_Data *exception;
   const char *msg;
@@ -1924,14 +1928,6 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED, void *sc)
   Raise_From_Signal_Handler (exception, msg);
 }
 
-#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR < 7
-
-extern void
-__gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
-
-static int is_vxsim = 0;
-#endif
-
 #if defined (ARMEL) && (_WRS_VXWORKS_MAJOR >= 7)
 
 /* ARM-vx7 case with arm unwinding exceptions */
@@ -2015,19 +2011,8 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
   __gnat_adjust_context_for_raise (sig, sc);
 #endif
 
-#if defined (__i386__) && !defined (VTHREADS) && (__WRS_VXWORKS_MAJOR < 7)
-   /* On x86, the vxsim signal context is subtly different and is processeed
-      by a handler compiled especially for vxsim.
-      Vxsim is not supported anymore on our vxworks-7 port.  */
-
-  if (is_vxsim)
-    __gnat_vxsim_error_handler (sig, si, sc);
-#endif
-
-# include "sigtramp.h"
-
   __gnat_sigtramp (sig, (void *)si, (void *)sc,
-		   (__sigtramphandler_t *)&__gnat_map_signal);
+                   (__sigtramphandler_t *)&__gnat_map_signal);
 
 #else
   __gnat_map_signal (sig, si, sc);
@@ -2057,7 +2042,6 @@ void
 __gnat_install_handler (void)
 {
   struct sigaction act;
-  char *model ATTRIBUTE_UNUSED;
 
   /* Setup signal handler to map synchronous signals to appropriate
      exceptions.  Make sure that the handler isn't interrupted by another
@@ -2108,13 +2092,17 @@ __gnat_install_handler (void)
   trap_0_entry->inst_fourth = 0xa1480000;
 #endif
 
-#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR != 7
+#ifdef __HANDLE_VXSIM_SC
   /*  By experiment, found that sysModel () returns the following string
       prefix for vxsim when running on Linux and Windows.  */
-  model = sysModel ();
-  if ((strncmp (model, "Linux", 5) == 0)
-      || (strncmp (model, "Windows", 7) == 0))
-    is_vxsim = 1;
+  {
+    char *model = sysModel ();
+    if ((strncmp (model, "Linux", 5) == 0)
+        || (strncmp (model, "Windows", 7) == 0)
+        || (strncmp (model, "SIMLINUX", 8) == 0) /* vx7 */
+        || (strncmp (model, "SIMWINDOWS", 10) == 0)) /* ditto */
+      __gnat_set_is_vxsim (TRUE);
+  }
 #endif
 
   __gnat_handler_installed = 1;
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index d2396a37465..2d9a7461102 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -409,7 +409,7 @@ package body Sem_Disp is
       --  fact direct. This routine detects the above case and modifies the
       --  call accordingly.
 
-      procedure Check_Dispatching_Context;
+      procedure Check_Dispatching_Context (Call : Node_Id);
       --  If the call is tag-indeterminate and the entity being called is
       --  abstract, verify that the context is a call that will eventually
       --  provide a tag for dispatching, or has provided one already.
@@ -508,10 +508,9 @@ package body Sem_Disp is
       -- Check_Dispatching_Context --
       -------------------------------
 
-      procedure Check_Dispatching_Context is
-         Subp : constant Entity_Id := Entity (Name (N));
+      procedure Check_Dispatching_Context (Call : Node_Id) is
+         Subp : constant Entity_Id := Entity (Name (Call));
          Typ  : constant Entity_Id := Etype (Subp);
-         Par  : Node_Id;
 
          procedure Abstract_Context_Error;
          --  Error for abstract call dispatching on result is not dispatching
@@ -536,11 +535,15 @@ package body Sem_Disp is
             end if;
          end Abstract_Context_Error;
 
+         --  Local variables
+
+         Par : Node_Id;
+
       --  Start of processing for Check_Dispatching_Context
 
       begin
          if Is_Abstract_Subprogram (Subp)
-           and then No (Controlling_Argument (N))
+           and then No (Controlling_Argument (Call))
          then
             if Present (Alias (Subp))
               and then not Is_Abstract_Subprogram (Alias (Subp))
@@ -565,7 +568,8 @@ package body Sem_Disp is
             --  but will be legal in overridings of the operation.
 
             elsif In_Spec_Expression
-              and then Is_Subprogram (Current_Scope)
+              and then (Is_Subprogram (Current_Scope)
+                 or else Chars (Current_Scope) = Name_Postcondition)
               and then
                 ((Nkind (Parent (Current_Scope)) = N_Procedure_Specification
                    and then Null_Present (Parent (Current_Scope)))
@@ -588,82 +592,110 @@ package body Sem_Disp is
 
                if not Is_Tagged_Type (Typ)
                  and then not
-                    (Ekind (Typ) = E_Anonymous_Access_Type
-                      and then Is_Tagged_Type (Designated_Type (Typ)))
+                   (Ekind (Typ) = E_Anonymous_Access_Type
+                     and then Is_Tagged_Type (Designated_Type (Typ)))
                then
                   Abstract_Context_Error;
                   return;
                end if;
 
-               Par := Parent (N);
+               Par := Parent (Call);
 
                if Nkind (Par) = N_Parameter_Association then
                   Par := Parent (Par);
                end if;
 
-               while Present (Par) loop
-                  if Nkind_In (Par, N_Function_Call,
-                                    N_Procedure_Call_Statement)
-                    and then Is_Entity_Name (Name (Par))
-                  then
-                     declare
-                        Enc_Subp : constant Entity_Id := Entity (Name (Par));
-                        A : Node_Id;
-                        F : Entity_Id;
-
-                     begin
-                        --  Find formal for which call is the actual, and is
-                        --  a controlling argument.
-
-                        F := First_Formal (Enc_Subp);
-                        A := First_Actual (Par);
-
-                        while Present (F) loop
-                           if Is_Controlling_Formal (F)
-                             and then (N = A or else Parent (N) = A)
-                           then
-                              return;
-                           end if;
+               if Nkind (Par) = N_Qualified_Expression
+                 or else Nkind (Par) = N_Unchecked_Type_Conversion
+               then
+                  Par := Parent (Par);
+               end if;
 
-                           Next_Formal (F);
-                           Next_Actual (A);
-                        end loop;
+               if Nkind_In (Par, N_Function_Call, N_Procedure_Call_Statement)
+                 and then Is_Entity_Name (Name (Par))
+               then
+                  declare
+                     Enc_Subp : constant Entity_Id := Entity (Name (Par));
+                     A        : Node_Id;
+                     F        : Entity_Id;
+                     Control  : Entity_Id;
+                     Ret_Type : Entity_Id;
 
-                        Error_Msg_N
-                          ("call to abstract function must be dispatching", N);
-                        return;
-                     end;
+                  begin
+                     --  Find controlling formal that can provide tag for the
+                     --  tag-indeterminate actual. The corresponding actual
+                     --  must be the corresponding class-wide type.
 
-                  --  For equalitiy operators, one of the operands must be
-                  --  statically or dynamically tagged.
+                     F := First_Formal (Enc_Subp);
+                     A := First_Actual (Par);
 
-                  elsif Nkind_In (Par, N_Op_Eq, N_Op_Ne) then
-                     if N = Right_Opnd (Par)
-                       and then Is_Tag_Indeterminate (Left_Opnd (Par))
-                     then
-                        Abstract_Context_Error;
+                     --  Find controlling type of call. Dereference if function
+                     --  returns an access type.
 
-                     elsif N = Left_Opnd (Par)
-                       and then Is_Tag_Indeterminate (Right_Opnd (Par))
-                     then
-                        Abstract_Context_Error;
+                     Ret_Type := Etype (Call);
+                     if Is_Access_Type (Etype (Call)) then
+                        Ret_Type := Designated_Type (Ret_Type);
                      end if;
 
-                     return;
+                     while Present (F) loop
+                        Control := Etype (A);
 
-                  elsif Nkind (Par) = N_Assignment_Statement then
-                     return;
+                        if Is_Access_Type (Control) then
+                           Control := Designated_Type (Control);
+                        end if;
+
+                        if Is_Controlling_Formal (F)
+                          and then not (Call = A or else Parent (Call) = A)
+                          and then Control = Class_Wide_Type (Ret_Type)
+                        then
+                           return;
+                        end if;
+
+                        Next_Formal (F);
+                        Next_Actual (A);
+                     end loop;
 
-                  elsif Nkind (Par) = N_Qualified_Expression
-                    or else Nkind (Par) = N_Unchecked_Type_Conversion
+                     if Nkind (Par) = N_Function_Call
+                       and then Is_Tag_Indeterminate (Par)
+                     then
+                        --  The parent may be an actual of an enclosing call
+
+                        Check_Dispatching_Context (Par);
+                        return;
+
+                     else
+                        Error_Msg_N
+                          ("call to abstract function must be dispatching",
+                           Call);
+                        return;
+                     end if;
+                  end;
+
+               --  For equality operators, one of the operands must be
+               --  statically or dynamically tagged.
+
+               elsif Nkind_In (Par, N_Op_Eq, N_Op_Ne) then
+                  if N = Right_Opnd (Par)
+                    and then Is_Tag_Indeterminate (Left_Opnd (Par))
                   then
-                     Par := Parent (Par);
+                     Abstract_Context_Error;
 
-                  else
+                  elsif N = Left_Opnd (Par)
+                    and then Is_Tag_Indeterminate (Right_Opnd (Par))
+                  then
                      Abstract_Context_Error;
-                     return;
                   end if;
-               end loop;
+
+                  return;
+
+               --  The left-hand side of an assignment provides the tag
+
+               elsif Nkind (Par) = N_Assignment_Statement then
+                  return;
+
+               else
+                  Abstract_Context_Error;
+               end if;
             end if;
          end if;
       end Check_Dispatching_Context;
@@ -813,11 +845,12 @@ package body Sem_Disp is
                Next_Formal (Formal);
             end loop;
 
-            Check_Dispatching_Context;
+            Check_Dispatching_Context (N);
+
+         elsif Nkind (N) /= N_Function_Call then
 
-         else
             --  The call is not dispatching, so check that there aren't any
-            --  tag-indeterminate abstract calls left.
+            --  tag-indeterminate abstract calls left among its actuals.
 
             Actual := First_Actual (N);
             while Present (Actual) loop
@@ -836,7 +869,7 @@ package body Sem_Disp is
                   then
                      Func := Empty;
 
-                  --  Ditto if it is an explicit dereference.
+                  --  Ditto if it is an explicit dereference
 
                   elsif Nkind (Original_Node (Actual)) = N_Explicit_Dereference
                   then
@@ -848,28 +881,41 @@ package body Sem_Disp is
                   else
                      Func :=
                        Entity (Name (Original_Node
-                                       (Expression (Original_Node (Actual)))));
+                         (Expression (Original_Node (Actual)))));
                   end if;
 
                   if Present (Func) and then Is_Abstract_Subprogram (Func) then
                      Error_Msg_N
-                       ("call to abstract function must be dispatching", N);
+                       ("call to abstract function must be dispatching",
+                        Actual);
                   end if;
                end if;
 
                Next_Actual (Actual);
             end loop;
 
-            Check_Dispatching_Context;
+            Check_Dispatching_Context (N);
+            return;
+
+         elsif Nkind (Parent (N)) in N_Subexpr then
+            Check_Dispatching_Context (N);
+
+         elsif Nkind (Parent (N)) = N_Assignment_Statement
+           and then Is_Class_Wide_Type (Etype (Name (Parent (N))))
+         then
+            return;
+
+         elsif Is_Abstract_Subprogram (Subp_Entity) then
+            Check_Dispatching_Context (N);
+            return;
          end if;
 
       else
-
          --  If dispatching on result, the enclosing call, if any, will
          --  determine the controlling argument. Otherwise this is the
          --  primitive operation of the root type.
 
-         Check_Dispatching_Context;
+         Check_Dispatching_Context (N);
       end if;
    end Check_Dispatching_Call;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8cafd56df25..534681a8294 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -245,10 +245,13 @@ package body Sem_Prag is
    --  Determine whether dependency clause Clause is surrounded by extra
    --  parentheses. If this is the case, issue an error message.
 
-   function Is_CCT_Instance (Ref : Node_Id) return Boolean;
+   function Is_CCT_Instance
+     (Ref_Id     : Entity_Id;
+      Context_Id : Entity_Id) return Boolean;
    --  Subsidiary to the analysis of pragmas [Refined_]Depends and [Refined_]
-   --  Global. Determine whether reference Ref denotes the current instance of
-   --  a concurrent type.
+   --  Global. Determine whether entity Ref_Id denotes the current instance of
+   --  a concurrent type. Context_Id denotes the associated context where the
+   --  pragma appears.
 
    function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean;
    --  Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of
@@ -559,6 +562,10 @@ package body Sem_Prag is
       --  Two lists containing the full set of inputs and output of the related
       --  subprograms. Note that these lists contain both nodes and entities.
 
+      Task_Input_Seen  : Boolean := False;
+      Task_Output_Seen : Boolean := False;
+      --  Flags used to track the implicit dependence of a task unit on itself
+
       procedure Add_Item_To_Name_Buffer (Item_Id : Entity_Id);
       --  Subsidiary routine to Check_Role and Check_Usage. Add the item kind
       --  to the name buffer. The individual kinds are as follows:
@@ -590,7 +597,7 @@ package body Sem_Prag is
          Item_Id  : Entity_Id;
          Is_Input : Boolean;
          Self_Ref : Boolean);
-      --  Ensure that an item fulfils its designated input and/or output role
+      --  Ensure that an item fulfills its designated input and/or output role
       --  as specified by pragma Global (if any) or the enclosing context. If
       --  this is not the case, emit an error. Item and Item_Id denote the
       --  attributes of an item. Flag Is_Input should be set when item comes
@@ -763,10 +770,31 @@ package body Sem_Prag is
             Null_Seen     : in out Boolean;
             Non_Null_Seen : in out Boolean)
          is
+            procedure Current_Task_Instance_Seen;
+            --  Set the appropriate global flag when the current instance of a
+            --  task unit is encountered.
+
+            --------------------------------
+            -- Current_Task_Instance_Seen --
+            --------------------------------
+
+            procedure Current_Task_Instance_Seen is
+            begin
+               if Is_Input then
+                  Task_Input_Seen := True;
+               else
+                  Task_Output_Seen := True;
+               end if;
+            end Current_Task_Instance_Seen;
+
+            --  Local variables
+
             Is_Output : constant Boolean := not Is_Input;
             Grouped   : Node_Id;
             Item_Id   : Entity_Id;
 
+         --  Start of processing for Analyze_Input_Output
+
          begin
             --  Multiple input or output items appear as an aggregate
 
@@ -899,18 +927,45 @@ package body Sem_Prag is
 
                     Ekind_In (Item_Id, E_Abstract_State, E_Variable)
                   then
-                     --  The item denotes a concurrent type, but it is not the
-                     --  current instance of an enclosing concurrent type.
+                     --  The item denotes a concurrent type. Note that single
+                     --  protected/task types are not considered here because
+                     --  they behave as objects in the context of pragma
+                     --  [Refined_]Depends.
+
+                     if Ekind_In (Item_Id, E_Protected_Type, E_Task_Type) then
+
+                        --  This use is legal as long as the concurrent type is
+                        --  the current instance of an enclosing type.
+
+                        if Is_CCT_Instance (Item_Id, Spec_Id) then
 
-                     if Ekind_In (Item_Id, E_Protected_Type, E_Task_Type)
-                       and then not Is_CCT_Instance (Item)
+                           --  The dependence of a task unit on itself is
+                           --  implicit and may or may not be explicitly
+                           --  specified (SPARK RM 6.1.4).
+
+                           if Ekind (Item_Id) = E_Task_Type then
+                              Current_Task_Instance_Seen;
+                           end if;
+
+                        --  Otherwise this is not the current instance
+
+                        else
+                           SPARK_Msg_N
+                             ("invalid use of subtype mark in dependency "
+                              & "relation", Item);
+                        end if;
+
+                     --  The dependency of a task unit on itself is implicit
+                     --  and may or may not be explicitly specified
+                     --  (SPARK RM 6.1.4).
+
+                     elsif Is_Single_Task_Object (Item_Id)
+                       and then Is_CCT_Instance (Item_Id, Spec_Id)
                      then
-                        SPARK_Msg_N
-                          ("invalid use of subtype mark in dependency "
-                           & "relation", Item);
+                        Current_Task_Instance_Seen;
                      end if;
 
-                     --  Ensure that the item fulfils its role as input and/or
+                     --  Ensure that the item fulfills its role as input and/or
                      --  output as specified by pragma Global or the enclosing
                      --  context.
 
@@ -1427,14 +1482,31 @@ package body Sem_Prag is
             if Present (Item_Id)
               and then not Contains (Used_Items, Item_Id)
             then
-               --  The current instance of a concurrent type behaves as a
-               --  formal parameter (SPARK RM 6.1.4).
+               if Is_Formal (Item_Id) then
+                  Usage_Error (Item_Id);
 
-               if Is_Formal (Item_Id)
-                 or else Ekind_In (Item_Id, E_Protected_Type, E_Task_Type)
+               --  The current instance of a protected type behaves as a formal
+               --  parameter (SPARK RM 6.1.4).
+
+               elsif Ekind (Item_Id) = E_Protected_Type
+                 or else Is_Single_Protected_Object (Item_Id)
                then
                   Usage_Error (Item_Id);
 
+               --  The current instance of a task type behaves as a formal
+               --  parameter (SPARK RM 6.1.4).
+
+               elsif Ekind (Item_Id) = E_Task_Type
+                 or else Is_Single_Task_Object (Item_Id)
+               then
+                  --  The dependence of a task unit on itself is implicit and
+                  --  may or may not be explicitly specified (SPARK RM 6.1.4).
+                  --  Emit an error if only one input/output is present.
+
+                  if Task_Input_Seen /= Task_Output_Seen then
+                     Usage_Error (Item_Id);
+                  end if;
+
                --  States and global objects are not used properly only when
                --  the subprogram is subject to pragma Global.
 
@@ -2036,20 +2108,18 @@ package body Sem_Prag is
                   end if;
 
                --  A global item may denote a concurrent type as long as it is
-               --  the current instance of an enclosing concurrent type
+               --  the current instance of an enclosing protected or task type
                --  (SPARK RM 6.1.4).
 
                elsif Ekind_In (Item_Id, E_Protected_Type, E_Task_Type) then
-                  if Is_CCT_Instance (Item) then
+                  if Is_CCT_Instance (Item_Id, Spec_Id) then
 
                      --  Pragma [Refined_]Global associated with a protected
                      --  subprogram cannot mention the current instance of a
                      --  protected type because the instance behaves as a
                      --  formal parameter.
 
-                     if Ekind (Item_Id) = E_Protected_Type
-                       and then Scope (Spec_Id) = Item_Id
-                     then
+                     if Ekind (Item_Id) = E_Protected_Type then
                         Error_Msg_Name_1 := Chars (Item_Id);
                         SPARK_Msg_NE
                           (Fix_Msg (Spec_Id, "global item of subprogram & "
@@ -2061,9 +2131,7 @@ package body Sem_Prag is
                      --  cannot mention the current instance of a task type
                      --  because the instance behaves as a formal parameter.
 
-                     elsif Ekind (Item_Id) = E_Task_Type
-                       and then Spec_Id = Item_Id
-                     then
+                     else pragma Assert (Ekind (Item_Id) = E_Task_Type);
                         Error_Msg_Name_1 := Chars (Item_Id);
                         SPARK_Msg_NE
                           (Fix_Msg (Spec_Id, "global item of subprogram & "
@@ -2081,6 +2149,39 @@ package body Sem_Prag is
                      return;
                   end if;
 
+               --  A global item may denote the anonymous object created for a
+               --  single protected/task type as long as the current instance
+               --  is the same single type (SPARK RM 6.1.4).
+
+               elsif Is_Single_Concurrent_Object (Item_Id)
+                 and then Is_CCT_Instance (Item_Id, Spec_Id)
+               then
+                  --  Pragma [Refined_]Global associated with a protected
+                  --  subprogram cannot mention the current instance of a
+                  --  protected type because the instance behaves as a formal
+                  --  parameter.
+
+                  if Is_Single_Protected_Object (Item_Id) then
+                     Error_Msg_Name_1 := Chars (Item_Id);
+                     SPARK_Msg_NE
+                       (Fix_Msg (Spec_Id, "global item of subprogram & cannot "
+                        & "reference current instance of protected type %"),
+                        Item, Spec_Id);
+                     return;
+
+                  --  Pragma [Refined_]Global associated with a task type
+                  --  cannot mention the current instance of a task type
+                  --  because the instance behaves as a formal parameter.
+
+                  else pragma Assert (Is_Single_Task_Object (Item_Id));
+                     Error_Msg_Name_1 := Chars (Item_Id);
+                     SPARK_Msg_NE
+                       (Fix_Msg (Spec_Id, "global item of subprogram & cannot "
+                        & "reference current instance of task type %"),
+                        Item, Spec_Id);
+                     return;
+                  end if;
+
                --  A formal object may act as a global item inside a generic
 
                elsif Is_Formal_Object (Item_Id) then
@@ -27455,23 +27556,55 @@ package body Sem_Prag is
    -- Is_CCT_Instance --
    ---------------------
 
-   function Is_CCT_Instance (Ref : Node_Id) return Boolean is
-      Ref_Id : constant Entity_Id := Entity (Ref);
-      S      : Entity_Id;
+   function Is_CCT_Instance
+     (Ref_Id     : Entity_Id;
+      Context_Id : Entity_Id) return Boolean
+   is
+      S   : Entity_Id;
+      Typ : Entity_Id;
 
    begin
-      --  Climb the scope chain looking for an enclosing concurrent type that
-      --  matches the referenced entity.
+      --  When the reference denotes a single protected type, the context is
+      --  either a protected subprogram or its body.
 
-      S := Current_Scope;
-      while Present (S) and then S /= Standard_Standard loop
-         if Ekind_In (S, E_Protected_Type, E_Task_Type) and then S = Ref_Id
-         then
-            return True;
+      if Is_Single_Protected_Object (Ref_Id) then
+         Typ := Scope (Context_Id);
+
+         return
+           Ekind (Typ) = E_Protected_Type
+             and then Present (Anonymous_Object (Typ))
+             and then Anonymous_Object (Typ) = Ref_Id;
+
+      --  When the reference denotes a single task type, the context is either
+      --  the same type or if inside the body, the anonymous task type.
+
+      elsif Is_Single_Task_Object (Ref_Id) then
+         if Ekind (Context_Id) = E_Task_Type then
+            return
+              Present (Anonymous_Object (Context_Id))
+                and then Anonymous_Object (Context_Id) = Ref_Id;
+         else
+            return Ref_Id = Context_Id;
          end if;
 
-         S := Scope (S);
-      end loop;
+      --  Otherwise the reference denotes a protected or a task type. Climb the
+      --  scope chain looking for an enclosing concurrent type that matches the
+      --  referenced entity.
+
+      else
+         pragma Assert (Ekind_In (Ref_Id, E_Protected_Type, E_Task_Type));
+
+         S := Current_Scope;
+         while Present (S) and then S /= Standard_Standard loop
+            if Ekind_In (S, E_Protected_Type, E_Task_Type)
+              and then S = Ref_Id
+            then
+               return True;
+            end if;
+
+            S := Scope (S);
+         end loop;
+      end if;
 
       return False;
    end Is_CCT_Instance;
diff --git a/gcc/ada/sigtramp-vxworks-vxsim.c b/gcc/ada/sigtramp-vxworks-vxsim.c
deleted file mode 100644
index 918d9e5d4fa..00000000000
--- a/gcc/ada/sigtramp-vxworks-vxsim.c
+++ /dev/null
@@ -1,141 +0,0 @@
-/****************************************************************************
- *                                                                          *
- *                         GNAT COMPILER COMPONENTS                         *
- *                                                                          *
- *                             S I G T R A M P                              *
- *                                                                          *
- *                         Asm Implementation File                          *
- *                                                                          *
- *         Copyright (C) 2011-2015, 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.               *
- *                                                                          *
- * In particular,  you can freely  distribute your programs  built with the *
- * GNAT Pro compiler, including any required library run-time units,  using *
- * any licensing terms  of your choosing.  See the AdaCore Software License *
- * for full details.                                                        *
- *                                                                          *
- * GNAT was originally developed  by the GNAT team at  New York University. *
- * Extensive contributions were provided by Ada Core Technologies Inc.      *
- *                                                                          *
- ****************************************************************************/
-
-/********************************************************
- * VxWorks VXSIM version of the __gnat_sigtramp service *
- ********************************************************/
-
-#undef CPU
-#define CPU __VXSIM_CPU__
-
-#include "sigtramp.h"
-/* See sigtramp.h for a general explanation of functionality.  */
-
-#include <vxWorks.h>
-#include <arch/../regs.h>
-#ifndef __RTP__
-#include <sigLib.h>
-#else
-#include <signal.h>
-#include <regs.h>
-
-typedef struct mcontext
-  {
-    REG_SET     regs;
-  } mcontext_t;
-
-typedef struct ucontext
-  {
-    mcontext_t          uc_mcontext;    /* register set */
-    struct ucontext *   uc_link;        /* not used */
-    sigset_t            uc_sigmask;     /* set of signals blocked */
-    stack_t             uc_stack;       /* stack of context signaled */
-  } ucontext_t;
-#endif
-
-/* ----------------------
-   -- General comments --
-   ----------------------
-
-   Stubs are generated from toplevel asms and .cfi directives, much simpler
-   to use and check for correctness than manual encodings of CFI byte
-   sequences.  The general idea is to establish CFA as sigcontext->sc_pregs
-   (for DKM) and mcontext (for RTP) and state where to find the registers as
-   offsets from there.
-
-   As of today, we support a stub providing CFI info for common
-   registers (GPRs, LR, ...). We might need variants with support for floating
-   point or altivec registers as well at some point.
-
-   Checking which variant should apply and getting at sc_pregs / mcontext
-   is simpler to express in C (we can't use offsetof in toplevel asms and
-   hardcoding constants is not workable with the flurry of VxWorks variants),
-   so this is the choice for our toplevel interface.
-
-   Note that the registers we "restore" here are those to which we have
-   direct access through the system sigcontext structure, which includes
-   only a partial set of the non-volatiles ABI-wise.  */
-
-/* -------------------------------------------
-   -- Prototypes for our internal asm stubs --
-   -------------------------------------------
-
-   Eventhough our symbols will remain local, the prototype claims "extern"
-   and not "static" to prevent compiler complaints about a symbol used but
-   never defined.  */
-
-/* sigtramp stub providing CFI info for common registers.  */
-
-extern void __gnat_sigtramp_vxsim_common
-(int signo, void *siginfo, void *sigcontext,
- __sigtramphandler_t * handler, void * sc_pregs);
-
-
-/* -------------------------------------
-   -- Common interface implementation --
-   -------------------------------------
-
-   We enforce optimization to minimize the overhead of the extra layer.  */
-
-void __gnat_sigtramp_vxsim (int signo, void *si, void *sc,
-		      __sigtramphandler_t * handler)
-     __attribute__((optimize(2)));
-
-void __gnat_sigtramp_vxsim (int signo, void *si, void *sc,
-		      __sigtramphandler_t * handler)
-{
-#ifdef __RTP__
-  mcontext_t *mcontext = &((ucontext_t *) sc)->uc_mcontext;
-
-  /* Pass MCONTEXT in the fifth position so that the assembly code can find
-     it at the same stack location or in the same register as SC_PREGS.  */
-  __gnat_sigtramp_vxsim_common (signo, si, mcontext, handler, mcontext);
-#else
-  struct sigcontext * sctx = (struct sigcontext *) sc;
-
-  __gnat_sigtramp_vxsim_common (signo, si, sctx, handler, sctx->sc_pregs);
-#endif
-}
-
-/* Include the target specific bits.  */
-#include "sigtramp-vxworks-target.inc"
-
-/* sigtramp stub for common registers.  */
-
-#define TRAMP_COMMON __gnat_sigtramp_vxsim_common
-
-asm (SIGTRAMP_START(TRAMP_COMMON));
-asm (CFI_DEF_CFA);
-asm (CFI_COMMON_REGS);
-asm (SIGTRAMP_BODY);
-asm (SIGTRAMP_END(TRAMP_COMMON));
-
-
diff --git a/gcc/ada/sigtramp-vxworks.c b/gcc/ada/sigtramp-vxworks.c
index 360b9211453..e9dd9aa1ce8 100644
--- a/gcc/ada/sigtramp-vxworks.c
+++ b/gcc/ada/sigtramp-vxworks.c
@@ -89,12 +89,13 @@ typedef struct ucontext
    and not "static" to prevent compiler complaints about a symbol used but
    never defined.  */
 
-/* sigtramp stub providing CFI info for common registers.  */
+#define TRAMP_COMMON __gnat_sigtramp_common
 
-extern void __gnat_sigtramp_common
-(int signo, void *siginfo, void *sigcontext,
- __sigtramphandler_t * handler, void * sc_pregs);
+/* sigtramp stub providing CFI info for common registers.  */
 
+extern void
+TRAMP_COMMON (int signo, void *siginfo, void *sigcontext,
+              __sigtramphandler_t * handler, REG_SET * sc_pregs);
 
 /* -------------------------------------
    -- Common interface implementation --
@@ -102,6 +103,14 @@ extern void __gnat_sigtramp_common
 
    We enforce optimization to minimize the overhead of the extra layer.  */
 
+#if defined(__vxworks) && (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
+static int __gnat_is_vxsim = 0;
+
+void __gnat_set_is_vxsim(int val) {
+  __gnat_is_vxsim = val;
+}
+#endif
+
 void __gnat_sigtramp (int signo, void *si, void *sc,
 		      __sigtramphandler_t * handler)
      __attribute__((optimize(2)));
@@ -109,17 +118,58 @@ void __gnat_sigtramp (int signo, void *si, void *sc,
 void __gnat_sigtramp (int signo, void *si, void *sc,
 		      __sigtramphandler_t * handler)
 {
-#ifdef __RTP__
+  REG_SET *pregs;
+
+  /* VXSIM uses a different signal context structure than the regular x86
+     targets:
+     * on x86-vx6: two 32-bit values are added at the end of the REG_SET, plus
+       an explicit padding of 0xc8 characters (200 characters). The sigcontext
+       containing a complete REG_SET just before the field 'sc_pregs', this
+       adds a 208 bytes offset to get the value of 'sc_pregs'.
+     * on x86-vx7: the same offset is used on vx7: 3 32-bit values are present
+       at the enf of the reg set, but the padding is then of 0xc4 characters.
+     * on x86_64-vx7: two 64-bit values are added at the beginning of the
+       REG_SET. This adds a 16 bytes offset to get the value of 'sc_pregs',
+       and another 16 bytes offset within the pregs structure to retrieve the
+       registers list.
+  */
+
+  /* Retrieve the registers to restore : */
+#ifndef __RTP__
+#ifdef __HANDLE_VXSIM_SC
+#if defined(__i386__)
+  /* move sctx 208 bytes further, so that the vxsim's sc_pregs field coincide
+     with the expected x86 one */
+  struct sigcontext * sctx =
+    (struct sigcontext *) (sc + (__gnat_is_vxsim ? 208 : 0));
+#elif defined(__x86_64__)
+  /* move sctx 16 bytes further, so that the vxsim's sc_pregs field coincide
+     with the expected x86_64 one */
+  struct sigcontext * sctx =
+    (struct sigcontext *) (sc + (__gnat_is_vxsim ? 16 : 0));
+#endif /* __i386__ || __x86_64__ */
+#else  /* __HANDLE_VXSIM_SC__ */
+  struct sigcontext * sctx = (struct sigcontext *) sc;
+#endif
+
+  pregs = sctx->sc_pregs;
+
+#else /* !defined(__RTP__) */
+
   mcontext_t *mcontext = &((ucontext_t *) sc)->uc_mcontext;
+  /* No specific offset in this case for vxsim */
+  pregs = &(mcontext->regs);
 
-  /* Pass MCONTEXT in the fifth position so that the assembly code can find
-     it at the same stack location or in the same register as SC_PREGS.  */
-  __gnat_sigtramp_common (signo, si, mcontext, handler, mcontext);
-#else
-  struct sigcontext * sctx = (struct sigcontext *) sc;
+#endif /* !defined(__RTP__) */
 
-  __gnat_sigtramp_common (signo, si, sctx, handler, sctx->sc_pregs);
+#if defined (__HANDLE_VXSIM_SC) && defined (__x86_64__)
+  /* Ignore the first two values, that are not registers in case of
+     vxsim */
+  pregs = (REG_SET *) ((void *)pregs + (__gnat_is_vxsim ? 16 : 0));
 #endif
+
+  /* And now call the real signal trampoline with the list of registers */
+  __gnat_sigtramp_common (signo, si, sc, handler, pregs);
 }
 
 /* Include the target specific bits.  */
@@ -127,12 +177,8 @@ void __gnat_sigtramp (int signo, void *si, void *sc,
 
 /* sigtramp stub for common registers.  */
 
-#define TRAMP_COMMON __gnat_sigtramp_common
-
 asm (SIGTRAMP_START(TRAMP_COMMON));
 asm (CFI_DEF_CFA);
 asm (CFI_COMMON_REGS);
 asm (SIGTRAMP_BODY);
 asm (SIGTRAMP_END(TRAMP_COMMON));
-
-
diff --git a/gcc/ada/sigtramp.h b/gcc/ada/sigtramp.h
index 930365f8d57..7314d6f7db6 100644
--- a/gcc/ada/sigtramp.h
+++ b/gcc/ada/sigtramp.h
@@ -43,14 +43,15 @@ extern "C" {
    system headers so call it something unique.  */
 typedef void __sigtramphandler_t (int signo, void *siginfo, void *sigcontext);
 
-#if defined(__vxworks) && (CPU == SIMNT || CPU == SIMPENTIUM || CPU == SIMLINUX)
-/* Vxsim requires a specially compiled handler.  */
-extern void __gnat_sigtramp_vxsim (int signo, void *siginfo, void *sigcontext,
-				   __sigtramphandler_t * handler);
-#else
+/* The vxsim target has a different sigcontext structure than the one we're
+   compiling the run-time with. We thus need to adjust it in this case */
+#if defined(__vxworks) && (defined (__i386__) || defined (__x86_64__)) && !defined (VTHREADS)
+#define __HANDLE_VXSIM_SC
+extern void __gnat_set_is_vxsim(int val);
+#endif
+
 extern void __gnat_sigtramp (int signo, void *siginfo, void *sigcontext,
 			     __sigtramphandler_t * handler);
-#endif
 
 /* The signal trampoline is to be called from an established signal handler.
    It sets up the DWARF CFI and calls HANDLER (SIGNO, SIGINFO, SIGCONTEXT).