2012-07-16 Robert Dewar <dewar@adacore.com>

	* freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting.

2012-07-16  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c: Add definitions of E2BIG and EILSEQ.

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr.adb (Propagate_Continue): New function replacing
	Raise_Current_Excep.
	(Allocate_Occurrence): New function.
	(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
	* a-exexpr-gcc.adb (GNAT_GCC_Exception): Occurrence component
	is now aliased.
	(To_GCC_Exception): Convert from Address.
	(Allocate_Occurrence): Allocate an Unwind exception occurrence.
	(Setup_Current_Excep): Fill the machine occurrence in case of
	foreign exception.
	(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
	* a-except.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
	Excep parameter.
	(Raise_Exception, Raise_Exception_Always,
	Raise_Exception_No_Defer): Adjust calls to the above procedures.
	(Raise_From_Signal_Handler, Raise_With_Location_And_Msg)
	(Rcheck_PE_Finalize_Raised_Exception): Likewise.
	* a-except-2005.adb (Set_Exception_C_Msg, Set_Exception_Msg):
	add Excep parameter.
	(Propagate_Exception): Likewise.
	(Allocate_Occurrence): New function.
	(Raise_Current_Excep): Removed.
	(Complete_Occurrence): New function to save the call chain.
	(Complete_And_Propagate_Occurrence): New procedure.
	(Create_Occurrence_From_Signal_Handler): New function to build an
	occurrence without propagating it.
	(Create_Machine_Occurrence_From_Signal_Handler): Likewise, but
	return the machine occurrence.
	(Raise_From_Signal_Handler): Use Create_Occurrence_From_Signal_Handler.
	(Raise_Exception, Raise_Exception_Always, Raise_Exception_No_Defer):
	Adjust calls to the above procedures. Allocate the occurrence at
	the beginning.
	(Raise_With_Location_And_Msg, Raise_With_Msg)
	(Rcheck_PE_Finalize_Raised_Exceptionm Reraise): Likewise.
	(Reraise_Occurrence): Use Reraise_Occurrence_Always.
	(Reraise_Occurrence_Always): Use Reraise_Occurrence_No_Defer.
	(Reraise_Occurrence_No_Defer): Preserve machine occurrence.
	(Save_Occurrence): Do not save machine occurrence.
	* a-except-2005.ads (Exception_Occurrence): Add Machine_Occurrence
	component.
	(Null_Occurrence): Consider it.
	* a-exexda.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
	Excep parameter.

2012-07-16  Tristan Gingold  <gingold@adacore.com>

	* seh_init.c (__gnat_map_SEH): New function extracted from
	__gnat_SEH_error_handler.
	* raise-gcc.c: __gnat_personality_seh0: Directly transforms
	Windows system exception into GCC one when possible, in order
	to save stack room (particularly useful when Storage_Error will
	be propagated).



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

13 files changed, 453 insertions, 258 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 18126f43e75..a0724c0d4c5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,68 @@
 2012-07-16  Robert Dewar  <dewar@adacore.com>
 
+	* freeze.adb, g-debpoo.adb, exp_ch3.adb: Minor reformatting.
+
+2012-07-16  Thomas Quinot  <quinot@adacore.com>
+
+	* s-oscons-tmplt.c: Add definitions of E2BIG and EILSEQ.
+
+2012-07-16  Tristan Gingold  <gingold@adacore.com>
+
+	* a-exexpr.adb (Propagate_Continue): New function replacing
+	Raise_Current_Excep.
+	(Allocate_Occurrence): New function.
+	(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
+	* a-exexpr-gcc.adb (GNAT_GCC_Exception): Occurrence component
+	is now aliased.
+	(To_GCC_Exception): Convert from Address.
+	(Allocate_Occurrence): Allocate an Unwind exception occurrence.
+	(Setup_Current_Excep): Fill the machine occurrence in case of
+	foreign exception.
+	(Propagate_Exception): Add Excep parameter, remove call to Call_Chain.
+	* a-except.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
+	Excep parameter.
+	(Raise_Exception, Raise_Exception_Always,
+	Raise_Exception_No_Defer): Adjust calls to the above procedures.
+	(Raise_From_Signal_Handler, Raise_With_Location_And_Msg)
+	(Rcheck_PE_Finalize_Raised_Exception): Likewise.
+	* a-except-2005.adb (Set_Exception_C_Msg, Set_Exception_Msg):
+	add Excep parameter.
+	(Propagate_Exception): Likewise.
+	(Allocate_Occurrence): New function.
+	(Raise_Current_Excep): Removed.
+	(Complete_Occurrence): New function to save the call chain.
+	(Complete_And_Propagate_Occurrence): New procedure.
+	(Create_Occurrence_From_Signal_Handler): New function to build an
+	occurrence without propagating it.
+	(Create_Machine_Occurrence_From_Signal_Handler): Likewise, but
+	return the machine occurrence.
+	(Raise_From_Signal_Handler): Use Create_Occurrence_From_Signal_Handler.
+	(Raise_Exception, Raise_Exception_Always, Raise_Exception_No_Defer):
+	Adjust calls to the above procedures. Allocate the occurrence at
+	the beginning.
+	(Raise_With_Location_And_Msg, Raise_With_Msg)
+	(Rcheck_PE_Finalize_Raised_Exceptionm Reraise): Likewise.
+	(Reraise_Occurrence): Use Reraise_Occurrence_Always.
+	(Reraise_Occurrence_Always): Use Reraise_Occurrence_No_Defer.
+	(Reraise_Occurrence_No_Defer): Preserve machine occurrence.
+	(Save_Occurrence): Do not save machine occurrence.
+	* a-except-2005.ads (Exception_Occurrence): Add Machine_Occurrence
+	component.
+	(Null_Occurrence): Consider it.
+	* a-exexda.adb (Set_Exception_C_Msg, Set_Exception_Msg): add
+	Excep parameter.
+
+2012-07-16  Tristan Gingold  <gingold@adacore.com>
+
+	* seh_init.c (__gnat_map_SEH): New function extracted from
+	__gnat_SEH_error_handler.
+	* raise-gcc.c: __gnat_personality_seh0: Directly transforms
+	Windows system exception into GCC one when possible, in order
+	to save stack room (particularly useful when Storage_Error will
+	be propagated).
+
+2012-07-16  Robert Dewar  <dewar@adacore.com>
+
 	* a-direct.adb, g-dirope.adb: Minor reformatting.
 
 2012-07-16  Tristan Gingold  <gingold@adacore.com>
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index a42c82efa09..b7dcb0adc1a 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -116,26 +116,27 @@ package body Ada.Exceptions is
       ---------------------------------
 
       procedure Set_Exception_C_Msg
-        (Id     : Exception_Id;
+        (Excep  : EOA;
+         Id     : Exception_Id;
          Msg1   : System.Address;
          Line   : Integer        := 0;
          Column : Integer        := 0;
          Msg2   : System.Address := System.Null_Address);
-      --  This routine is called to setup the exception referenced by the
-      --  Current_Excep field in the TSD to contain the indicated Id value
-      --  and message. Msg1 is a null terminated string which is generated
-      --  as the exception message. If line is non-zero, then a colon and
-      --  the decimal representation of this integer is appended to the
-      --  message. Ditto for Column. When Msg2 is non-null, a space and this
-      --  additional null terminated string is added to the message.
+      --  This routine is called to setup the exception referenced by X
+      --  to contain the indicated Id value and message. Msg1 is a null
+      --  terminated string which is generated as the exception message. If
+      --  line is non-zero, then a colon and the decimal representation of
+      --  this integer is appended to the message. Ditto for Column. When Msg2
+      --  is non-null, a space and this additional null terminated string is
+      --  added to the message.
 
       procedure Set_Exception_Msg
-        (Id      : Exception_Id;
+        (Excep   : EOA;
+         Id      : Exception_Id;
          Message : String);
-      --  This routine is called to setup the exception referenced by the
-      --  Current_Excep field in the TSD to contain the indicated Id value
-      --  and message. Message is a string which is generated as the
-      --  exception message.
+      --  This routine is called to setup the exception referenced by X
+      --  to contain the indicated Id value and message. Message is a string
+      --  which is generated as the exception message.
 
       --------------------------------------
       -- Exception information subprogram --
@@ -232,18 +233,16 @@ package body Ada.Exceptions is
 
    package Exception_Propagation is
 
-      use Exception_Traces;
-      --  Imports Notify_Unhandled_Exception and
-      --  Unhandled_Exception_Terminate
-
       ------------------------------------
       -- Exception propagation routines --
       ------------------------------------
 
-      procedure Propagate_Exception;
+      function Allocate_Occurrence return EOA;
+      --  Allocate an exception occurence (as well as the machine occurence)
+
+      procedure Propagate_Exception (Excep : EOA);
       pragma No_Return (Propagate_Exception);
-      --  This procedure propagates the exception represented by the occurrence
-      --  referenced by Current_Excep in the TSD for the current task.
+      --  This procedure propagates the exception represented by Excep
 
    end Exception_Propagation;
 
@@ -264,14 +263,30 @@ package body Ada.Exceptions is
 
    end Stream_Attributes;
 
-   procedure Raise_Current_Excep (E : Exception_Id);
-   pragma No_Return (Raise_Current_Excep);
-   pragma Export (C, Raise_Current_Excep, "__gnat_raise_nodefer_with_msg");
-   --  This is a simple wrapper to Exception_Propagation.Propagate_Exception.
-   --
-   --  This external name for Raise_Current_Excep is historical, and probably
-   --  should be changed but for now we keep it, because gdb and gigi know
-   --  about it.
+   procedure Complete_Occurrence (X : EOA);
+   --  Finish building the occurrence: save the call chain and notify the
+   --  debugger.
+
+   procedure Complete_And_Propagate_Occurrence (X : EOA);
+   pragma No_Return (Complete_And_Propagate_Occurrence);
+   --  This is a simple wrapper to Complete_Occurrence and
+   --  Exception_Propagation.Propagate_Exception.
+
+   function Create_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address)
+     return EOA;
+   --  Create and build an exception occurrence using exception id E and
+   --  nul-terminated message M.
+
+   function Create_Machine_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address)
+     return System.Address;
+   pragma Export (C, Create_Machine_Occurrence_From_Signal_Handler,
+                  "__gnat_create_machine_occurrence_from_signal_handler");
+   --  Create and build an exception occurrence using exception id E and
+   --  nul-terminated message M. Return the machine occurrence.
 
    procedure Raise_Exception_No_Defer
       (E : Exception_Id; Message : String := "");
@@ -372,7 +387,7 @@ package body Ada.Exceptions is
    --                        |  |  |                  |
    --                        |  |  |             Set_E_C_Msg(i)
    --                        |  |  |
-   --                   Raise_Current_Excep
+   --            Complete_And_Propagate_Occurrence
 
    procedure Reraise;
    pragma No_Return (Reraise);
@@ -887,14 +902,47 @@ package body Ada.Exceptions is
    end Raise_Constraint_Error_Msg;
 
    -------------------------
-   -- Raise_Current_Excep --
+   -- Complete_Occurrence --
    -------------------------
 
-   procedure Raise_Current_Excep (E : Exception_Id) is
+   procedure Complete_Occurrence (X : EOA) is
+   begin
+      --  Compute the backtrace for this occurrence if the corresponding
+      --  binder option has been set. Call_Chain takes care of the reraise
+      --  case.
+
+      --  ??? Using Call_Chain here means we are going to walk up the stack
+      --  once only for backtracing purposes before doing it again for the
+      --  propagation per se.
+
+      --  The first inspection is much lighter, though, as it only requires
+      --  partial unwinding of each frame. Additionally, although we could use
+      --  the personality routine to record the addresses while propagating,
+      --  this method has two drawbacks:
+
+      --  1) the trace is incomplete if the exception is handled since we
+      --  don't walk past the frame with the handler,
+
+      --    and
+
+      --  2) we would miss the frames for which our personality routine is not
+      --  called, e.g. if C or C++ calls are on the way.
+
+      Call_Chain (X);
+
+      --  Notify the debugger
+      Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (X.Id));
+   end Complete_Occurrence;
+
+   ---------------------------------------
+   -- Complete_And_Propagate_Occurrence --
+   ---------------------------------------
+
+   procedure Complete_And_Propagate_Occurrence (X : EOA) is
    begin
-      Debug_Raise_Exception (E => SSL.Exception_Data_Ptr (E));
-      Exception_Propagation.Propagate_Exception;
-   end Raise_Current_Excep;
+      Complete_Occurrence (X);
+      Exception_Propagation.Propagate_Exception (X);
+   end Complete_And_Propagate_Occurrence;
 
    ---------------------
    -- Raise_Exception --
@@ -905,6 +953,7 @@ package body Ada.Exceptions is
       Message : String := "")
    is
       EF : Exception_Id := E;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
 
    begin
       --  Raise CE if E = Null_ID (AI-446)
@@ -915,13 +964,14 @@ package body Ada.Exceptions is
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (EF, Message);
+      Exception_Data.Set_Exception_Msg (X, EF, Message);
 
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
 
-      Raise_Current_Excep (EF);
+      Complete_Occurrence (X);
+      Exception_Propagation.Propagate_Exception (X);
    end Raise_Exception;
 
    ----------------------------
@@ -932,12 +982,13 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
    begin
-      Exception_Data.Set_Exception_Msg (E, Message);
+      Exception_Data.Set_Exception_Msg (X, E, Message);
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
-      Raise_Current_Excep (E);
+      Complete_And_Propagate_Occurrence (X);
    end Raise_Exception_Always;
 
    ------------------------------
@@ -948,12 +999,13 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
    begin
-      Exception_Data.Set_Exception_Msg (E, Message);
+      Exception_Data.Set_Exception_Msg (X, E, Message);
 
       --  Do not call Abort_Defer.all, as specified by the spec
 
-      Raise_Current_Excep (E);
+      Complete_And_Propagate_Occurrence (X);
    end Raise_Exception_No_Defer;
 
    -------------------------------------
@@ -1001,22 +1053,51 @@ package body Ada.Exceptions is
       end if;
    end Raise_From_Controlled_Operation;
 
-   -------------------------------
-   -- Raise_From_Signal_Handler --
-   -------------------------------
+   -------------------------------------------
+   -- Create_Occurrence_From_Signal_Handler --
+   -------------------------------------------
 
-   procedure Raise_From_Signal_Handler
+   function Create_Occurrence_From_Signal_Handler
      (E : Exception_Id;
       M : System.Address)
+     return EOA
    is
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
    begin
-      Exception_Data.Set_Exception_C_Msg (E, M);
+      Exception_Data.Set_Exception_C_Msg (X, E, M);
 
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
 
-      Raise_Current_Excep (E);
+      Complete_Occurrence (X);
+      return X;
+   end Create_Occurrence_From_Signal_Handler;
+
+   ---------------------------------------------------
+   -- Create_Machine_Occurrence_From_Signal_Handler --
+   ---------------------------------------------------
+
+   function Create_Machine_Occurrence_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address)
+     return System.Address
+   is
+   begin
+      return Create_Occurrence_From_Signal_Handler (E, M).Machine_Occurrence;
+   end Create_Machine_Occurrence_From_Signal_Handler;
+
+   -------------------------------
+   -- Raise_From_Signal_Handler --
+   -------------------------------
+
+   procedure Raise_From_Signal_Handler
+     (E : Exception_Id;
+      M : System.Address)
+   is
+   begin
+      Exception_Propagation.Propagate_Exception
+        (Create_Occurrence_From_Signal_Handler (E, M));
    end Raise_From_Signal_Handler;
 
    -------------------------
@@ -1082,14 +1163,15 @@ package body Ada.Exceptions is
       C : Integer := 0;
       M : System.Address := System.Null_Address)
    is
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
    begin
-      Exception_Data.Set_Exception_C_Msg (E, F, L, C, M);
+      Exception_Data.Set_Exception_C_Msg (X, E, F, L, C, M);
 
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
 
-      Raise_Current_Excep (E);
+      Complete_And_Propagate_Occurrence (X);
    end Raise_With_Location_And_Msg;
 
    --------------------
@@ -1097,14 +1179,20 @@ package body Ada.Exceptions is
    --------------------
 
    procedure Raise_With_Msg (E : Exception_Id) is
-      Excep : constant EOA := Get_Current_Excep.all;
-
+      Excep : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Ex    : constant Exception_Occurrence_Access := Get_Current_Excep.all;
    begin
       Excep.Exception_Raised := False;
       Excep.Id               := E;
       Excep.Num_Tracebacks   := 0;
       Excep.Pid              := Local_Partition_ID;
 
+      --  Copy the message from the current exception
+      --  Change the interface to be called with an occurrence ???
+
+      Excep.Msg_Length                  := Ex.Msg_Length;
+      Excep.Msg (1 .. Excep.Msg_Length) := Ex.Msg (1 .. Ex.Msg_Length);
+
       --  The following is a common pattern, should be abstracted
       --  into a procedure call ???
 
@@ -1112,7 +1200,7 @@ package body Ada.Exceptions is
          Abort_Defer.all;
       end if;
 
-      Raise_Current_Excep (E);
+      Complete_And_Propagate_Occurrence (Excep);
    end Raise_With_Msg;
 
    --------------------------------------
@@ -1400,7 +1488,7 @@ package body Ada.Exceptions is
    procedure Rcheck_PE_Finalize_Raised_Exception
      (File : System.Address; Line : Integer)
    is
-      E : constant Exception_Id := Program_Error_Def'Access;
+      X : constant EOA := Exception_Propagation.Allocate_Occurrence;
 
    begin
       --  This is "finalize/adjust raised exception". This subprogram is always
@@ -1409,8 +1497,9 @@ package body Ada.Exceptions is
 
       --  This is consistent with Raise_From_Controlled_Operation
 
-      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
-      Raise_Current_Excep (E);
+      Exception_Data.Set_Exception_C_Msg
+        (X, Program_Error_Def'Access, File, Line, 0, Rmsg_22'Address);
+      Complete_And_Propagate_Occurrence (X);
    end Rcheck_PE_Finalize_Raised_Exception;
 
    -------------
@@ -1418,12 +1507,15 @@ package body Ada.Exceptions is
    -------------
 
    procedure Reraise is
-      Excep : constant EOA := Get_Current_Excep.all;
+      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
    begin
       if not ZCX_By_Default then
          Abort_Defer.all;
       end if;
-      Raise_Current_Excep (Excep.Id);
+      Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
+      Excep.Machine_Occurrence := Saved_MO;
+      Complete_And_Propagate_Occurrence (Excep);
    end Reraise;
 
    --------------------------------------
@@ -1451,14 +1543,11 @@ package body Ada.Exceptions is
 
    procedure Reraise_Occurrence (X : Exception_Occurrence) is
    begin
-      if X.Id /= null then
-         if not ZCX_By_Default then
-            Abort_Defer.all;
-         end if;
-
-         Save_Occurrence (Get_Current_Excep.all.all, X);
-         Raise_Current_Excep (X.Id);
+      if X.Id = null then
+         return;
       end if;
+
+      Reraise_Occurrence_Always (X);
    end Reraise_Occurrence;
 
    -------------------------------
@@ -1471,8 +1560,7 @@ package body Ada.Exceptions is
          Abort_Defer.all;
       end if;
 
-      Save_Occurrence (Get_Current_Excep.all.all, X);
-      Raise_Current_Excep (X.Id);
+      Reraise_Occurrence_No_Defer (X);
    end Reraise_Occurrence_Always;
 
    ---------------------------------
@@ -1480,9 +1568,12 @@ package body Ada.Exceptions is
    ---------------------------------
 
    procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence) is
+      Excep    : constant EOA := Exception_Propagation.Allocate_Occurrence;
+      Saved_MO : constant System.Address := Excep.Machine_Occurrence;
    begin
-      Save_Occurrence (Get_Current_Excep.all.all, X);
-      Raise_Current_Excep (X.Id);
+      Save_Occurrence (Excep.all, X);
+      Excep.Machine_Occurrence := Saved_MO;
+      Complete_And_Propagate_Occurrence (Excep);
    end Reraise_Occurrence_No_Defer;
 
    ---------------------
@@ -1494,10 +1585,14 @@ package body Ada.Exceptions is
       Source : Exception_Occurrence)
    is
    begin
-      Target.Id             := Source.Id;
-      Target.Msg_Length     := Source.Msg_Length;
-      Target.Num_Tracebacks := Source.Num_Tracebacks;
-      Target.Pid            := Source.Pid;
+      --  As the machine occurrence might be a data that must be finalized
+      --  (outside any Ada mechanism), do not copy it
+
+      Target.Id                 := Source.Id;
+      Target.Machine_Occurrence := System.Null_Address;
+      Target.Msg_Length         := Source.Msg_Length;
+      Target.Num_Tracebacks     := Source.Num_Tracebacks;
+      Target.Pid                := Source.Pid;
 
       Target.Msg (1 .. Target.Msg_Length) :=
         Source.Msg (1 .. Target.Msg_Length);
diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads
index e346a2715f5..bb597ed0982 100644
--- a/gcc/ada/a-except-2005.ads
+++ b/gcc/ada/a-except-2005.ads
@@ -302,6 +302,10 @@ private
       Id : Exception_Id;
       --  Exception_Identity for this exception occurrence
 
+      Machine_Occurrence : System.Address;
+      --  The underlying machine occurrence. For GCC, this corresponds to the
+      --  _Unwind_Exception structure address.
+
       Msg_Length : Natural := 0;
       --  Length of message (zero = no message)
 
@@ -339,12 +343,13 @@ private
    --  Functions for implementing Exception_Occurrence stream attributes
 
    Null_Occurrence : constant Exception_Occurrence := (
-     Id               => null,
-     Msg_Length       => 0,
-     Msg              => (others => ' '),
-     Exception_Raised => False,
-     Pid              => 0,
-     Num_Tracebacks   => 0,
-     Tracebacks       => (others => TBE.Null_TB_Entry));
+     Id                 => null,
+     Machine_Occurrence => System.Null_Address,
+     Msg_Length         => 0,
+     Msg                => (others => ' '),
+     Exception_Raised   => False,
+     Pid                => 0,
+     Num_Tracebacks     => 0,
+     Tracebacks         => (others => TBE.Null_TB_Entry));
 
 end Ada.Exceptions;
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 6c05b6e6482..1201ab0a443 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -93,7 +93,8 @@ package body Ada.Exceptions is
       ---------------------------------
 
       procedure Set_Exception_C_Msg
-        (Id     : Exception_Id;
+        (Excep  : EOA;
+         Id     : Exception_Id;
          Msg1   : System.Address;
          Line   : Integer        := 0;
          Column : Integer        := 0;
@@ -107,7 +108,8 @@ package body Ada.Exceptions is
       --  additional null terminated string is added to the message.
 
       procedure Set_Exception_Msg
-        (Id      : Exception_Id;
+        (Excep   : EOA;
+         Id      : Exception_Id;
          Message : String);
       --  This routine is called to setup the exception referenced by the
       --  Current_Excep field in the TSD to contain the indicated Id value and
@@ -966,8 +968,8 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
-      EF : Exception_Id := E;
-
+      EF    : Exception_Id := E;
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
       --  Raise CE if E = Null_ID (AI-446)
 
@@ -977,7 +979,7 @@ package body Ada.Exceptions is
 
       --  Go ahead and raise appropriate exception
 
-      Exception_Data.Set_Exception_Msg (EF, Message);
+      Exception_Data.Set_Exception_Msg (Excep, EF, Message);
       Abort_Defer.all;
       Raise_Current_Excep (EF);
    end Raise_Exception;
@@ -990,8 +992,9 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Exception_Data.Set_Exception_Msg (E, Message);
+      Exception_Data.Set_Exception_Msg (Excep, E, Message);
       Abort_Defer.all;
       Raise_Current_Excep (E);
    end Raise_Exception_Always;
@@ -1004,8 +1007,9 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Exception_Data.Set_Exception_Msg (E, Message);
+      Exception_Data.Set_Exception_Msg (Excep, E, Message);
 
       --  Do not call Abort_Defer.all, as specified by the spec
 
@@ -1065,8 +1069,9 @@ package body Ada.Exceptions is
      (E : Exception_Id;
       M : System.Address)
    is
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Exception_Data.Set_Exception_C_Msg (E, M);
+      Exception_Data.Set_Exception_C_Msg (Excep, E, M);
       Abort_Defer.all;
       Process_Raise_Exception (E);
    end Raise_From_Signal_Handler;
@@ -1135,8 +1140,9 @@ package body Ada.Exceptions is
       L : Integer;
       M : System.Address := System.Null_Address)
    is
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
-      Exception_Data.Set_Exception_C_Msg (E, F, L, Msg2 => M);
+      Exception_Data.Set_Exception_C_Msg (Excep, E, F, L, Msg2 => M);
       Abort_Defer.all;
       Raise_Current_Excep (E);
    end Raise_With_Location_And_Msg;
@@ -1402,8 +1408,8 @@ package body Ada.Exceptions is
    procedure Rcheck_PE_Finalize_Raised_Exception
      (File : System.Address; Line : Integer)
    is
-      E : constant Exception_Id := Program_Error_Def'Access;
-
+      E     : constant Exception_Id := Program_Error_Def'Access;
+      Excep : constant EOA := Get_Current_Excep.all;
    begin
       --  This is "finalize/adjust raised exception". This subprogram is always
       --  called with abort deferred, unlike all other Rcheck_* routines, it
@@ -1411,7 +1417,8 @@ package body Ada.Exceptions is
 
       --  This is consistent with Raise_From_Controlled_Operation
 
-      Exception_Data.Set_Exception_C_Msg (E, File, Line, 0, Rmsg_22'Address);
+      Exception_Data.Set_Exception_C_Msg (Excep, E, File, Line, 0,
+                                          Rmsg_22'Address);
       Raise_Current_Excep (E);
    end Rcheck_PE_Finalize_Raised_Exception;
 
diff --git a/gcc/ada/a-exexda.adb b/gcc/ada/a-exexda.adb
index 37cb115988d..aa91cdcfe8f 100644
--- a/gcc/ada/a-exexda.adb
+++ b/gcc/ada/a-exexda.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -558,13 +558,13 @@ package body Exception_Data is
    -------------------------
 
    procedure Set_Exception_C_Msg
-     (Id     : Exception_Id;
+     (Excep  : EOA;
+      Id     : Exception_Id;
       Msg1   : System.Address;
       Line   : Integer        := 0;
       Column : Integer        := 0;
       Msg2   : System.Address := System.Null_Address)
    is
-      Excep  : constant EOA := Get_Current_Excep.all;
       Remind : Integer;
       Ptr    : Natural;
 
@@ -654,13 +654,13 @@ package body Exception_Data is
    -----------------------
 
    procedure Set_Exception_Msg
-     (Id      : Exception_Id;
+     (Excep   : EOA;
+      Id      : Exception_Id;
       Message : String)
    is
       Len   : constant Natural :=
                 Natural'Min (Message'Length, Exception_Msg_Max_Length);
       First : constant Integer := Message'First;
-      Excep : constant EOA     := Get_Current_Excep.all;
    begin
       Excep.Exception_Raised := False;
       Excep.Msg_Length       := Len;
diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb
index bf241da6127..10e91bf1e64 100644
--- a/gcc/ada/a-exexpr-gcc.adb
+++ b/gcc/ada/a-exexpr-gcc.adb
@@ -39,6 +39,8 @@ with System.Storage_Elements;  use System.Storage_Elements;
 separate (Ada.Exceptions)
 package body Exception_Propagation is
 
+   use Exception_Traces;
+
    ------------------------------------------------
    -- Entities to interface with the GCC runtime --
    ------------------------------------------------
@@ -110,7 +112,7 @@ package body Exception_Propagation is
       Private2 : Unwind_Word;
 
       --  Usual exception structure has only two private fields, but the SEH
-      --  one has six. To avoid makeing this file more complex, we use six
+      --  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;
@@ -151,7 +153,7 @@ package body Exception_Propagation is
       Header : Unwind_Exception;
       --  ABI Exception header first
 
-      Occurrence : Exception_Occurrence;
+      Occurrence : aliased Exception_Occurrence;
       --  The Ada occurrence
    end record;
 
@@ -177,7 +179,7 @@ package body Exception_Propagation is
    type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
 
    function To_GCC_Exception is new
-     Unchecked_Conversion (GNAT_GCC_Exception_Access, GCC_Exception_Access);
+     Unchecked_Conversion (System.Address, GCC_Exception_Access);
 
    function To_GNAT_GCC_Exception is new
      Unchecked_Conversion (GCC_Exception_Access, GNAT_GCC_Exception_Access);
@@ -297,6 +299,24 @@ package body Exception_Propagation is
    --  exceptions on targets which always handle exceptions (such as SEH).
    --  The handler will simply call Unhandled_Except_Handler.
 
+   -------------------------
+   -- Allocate_Occurrence --
+   -------------------------
+
+   function Allocate_Occurrence return EOA 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.Occurrence.Machine_Occurrence := Res.all'Address;
+
+      return Res.Occurrence'Access;
+   end Allocate_Occurrence;
+
    --------------------------------
    -- GNAT_GCC_Exception_Cleanup --
    --------------------------------
@@ -345,6 +365,7 @@ package body Exception_Propagation is
          --  A default one
 
          Excep.Id := Foreign_Exception'Access;
+         Excep.Machine_Occurrence := GCC_Exception.all'Address;
          Excep.Msg_Length := 0;
          Excep.Exception_Raised := True;
          Excep.Pid := Local_Partition_ID;
@@ -433,50 +454,9 @@ package body Exception_Propagation is
    -- Propagate_Exception --
    -------------------------
 
-   --  Build an object suitable for the libgcc processing and call
-   --  Unwind_RaiseException to actually do the raise, taking care of
-   --  handling the two phase scheme it implements.
-
-   procedure Propagate_Exception is
-      Excep         : constant EOA := Get_Current_Excep.all;
-      GCC_Exception : GNAT_GCC_Exception_Access;
-
+   procedure Propagate_Exception (Excep : EOA) is
    begin
-      --  Compute the backtrace for this occurrence if the corresponding
-      --  binder option has been set. Call_Chain takes care of the reraise
-      --  case.
-
-      --  ??? Using Call_Chain here means we are going to walk up the stack
-      --  once only for backtracing purposes before doing it again for the
-      --  propagation per se.
-
-      --  The first inspection is much lighter, though, as it only requires
-      --  partial unwinding of each frame. Additionally, although we could use
-      --  the personality routine to record the addresses while propagating,
-      --  this method has two drawbacks:
-
-      --  1) the trace is incomplete if the exception is handled since we
-      --  don't walk past the frame with the handler,
-
-      --    and
-
-      --  2) we would miss the frames for which our personality routine is not
-      --  called, e.g. if C or C++ calls are on the way.
-
-      Call_Chain (Excep);
-
-      --  Allocate the GCC exception
-
-      GCC_Exception :=
-        new GNAT_GCC_Exception'
-          (Header     => (Class   => GNAT_Exception_Class,
-                          Cleanup => GNAT_GCC_Exception_Cleanup'Address,
-                          others  => 0),
-           Occurrence => Excep.all);
-
-      --  Propagate it
-
-      Propagate_GCC_Exception (To_GCC_Exception (GCC_Exception));
+      Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence));
    end Propagate_Exception;
 
    ------------------------------
diff --git a/gcc/ada/a-exexpr.adb b/gcc/ada/a-exexpr.adb
index cbe8a5c1c38..ccedcb2d1ef 100644
--- a/gcc/ada/a-exexpr.adb
+++ b/gcc/ada/a-exexpr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -43,42 +43,29 @@ package body Exception_Propagation is
    pragma No_Return (builtin_longjmp);
    pragma Import (Intrinsic, builtin_longjmp, "__builtin_longjmp");
 
+   procedure Propagate_Continue (Excep : EOA);
+   pragma No_Return (Propagate_Continue);
+   pragma Export (C, Propagate_Continue, "__gnat_raise_nodefer_with_msg");
+   --  A call to this procedure is inserted automatically by GIGI, in order
+   --  to continue the propagation when the exception was not handled.
+   --  The linkage name is historical.
+
    -------------------------
-   -- Propagate_Exception --
+   -- Allocate_Occurrence --
    -------------------------
 
-   procedure Propagate_Exception
-   is
-      Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
-      Excep       : constant EOA := Get_Current_Excep.all;
+   function Allocate_Occurrence return EOA is
    begin
-      --  Compute the backtrace for this occurrence if corresponding binder
-      --  option has been set. Call_Chain takes care of the reraise case.
-
-      Call_Chain (Excep);
-
-      --  Note on above call to Call_Chain:
-
-      --  We used to only do this if From_Signal_Handler was not set,
-      --  based on the assumption that backtracing from a signal handler
-      --  would not work due to stack layout oddities. However, since
-
-      --   1. The flag is never set in tasking programs (Notify_Exception
-      --      performs regular raise statements), and
-
-      --   2. No problem has shown up in tasking programs around here so
-      --      far, this turned out to be too strong an assumption.
-
-      --  As, in addition, the test was
-
-      --   1. preventing the production of backtraces in non-tasking
-      --      programs, and
+      return Get_Current_Excep.all;
+   end Allocate_Occurrence;
 
-      --   2. introducing a behavior inconsistency between
-      --      the tasking and non-tasking cases,
-
-      --  we have simply removed it
+   -------------------------
+   -- Propagate_Exception --
+   -------------------------
 
+   procedure Propagate_Exception (Excep : EOA) is
+      Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
+   begin
       --  If the jump buffer pointer is non-null, transfer control using
       --  it. Otherwise announce an unhandled exception (note that this
       --  means that we have no finalizations to do other than at the outer
@@ -98,4 +85,13 @@ package body Exception_Propagation is
       end if;
    end Propagate_Exception;
 
+   ------------------------
+   -- Propagate_Continue --
+   ------------------------
+
+   procedure Propagate_Continue (Excep : EOA) is
+   begin
+      Propagate_Exception (Excep);
+   end Propagate_Continue;
+
 end Exception_Propagation;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f64524e1893..e39b10dbb61 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -772,18 +772,19 @@ package body Exp_Ch3 is
    --------------------------------
 
    procedure Build_Array_Invariant_Proc (A_Type : Entity_Id; Nod : Node_Id) is
-      Loc              : constant Source_Ptr := Sloc (Nod);
-      Object_Name      : constant Name_Id := New_Internal_Name ('I');
+      Loc : constant Source_Ptr := Sloc (Nod);
+
+      Object_Name : constant Name_Id := New_Internal_Name ('I');
       --  Name for argument of invariant procedure
 
       Object_Entity : constant Node_Id :=
                         Make_Defining_Identifier (Loc, Object_Name);
       --  The procedure declaration entity for the argument
 
-      Body_Stmts       : List_Id;
-      Index_List       : List_Id;
-      Proc_Id          : Entity_Id;
-      Proc_Body        : Node_Id;
+      Body_Stmts : List_Id;
+      Index_List : List_Id;
+      Proc_Id    : Entity_Id;
+      Proc_Body  : Node_Id;
 
       function Build_Component_Invariant_Call return Node_Id;
       --  Create one statement to verify invariant on one array component,
@@ -803,19 +804,17 @@ package body Exp_Ch3 is
 
       function Build_Component_Invariant_Call return Node_Id is
          Comp : Node_Id;
-
       begin
          Comp :=
            Make_Indexed_Component (Loc,
              Prefix      => New_Occurrence_Of (Object_Entity, Loc),
-                                   Expressions => Index_List);
+             Expressions => Index_List);
          return
            Make_Procedure_Call_Statement (Loc,
              Name                   =>
                New_Occurrence_Of
                  (Invariant_Procedure (Component_Type (A_Type)), Loc),
              Parameter_Associations => New_List (Comp));
-
       end Build_Component_Invariant_Call;
 
       -------------------------
@@ -826,8 +825,8 @@ package body Exp_Ch3 is
          Index : Entity_Id;
 
       begin
-         --  If all dimensions dealt with, we simply check invariant of
-         --  the component
+         --  If all dimensions dealt with, we simply check invariant of the
+         --  component.
 
          if N > Number_Dimensions (A_Type) then
             return New_List (Build_Component_Invariant_Call);
@@ -842,19 +841,20 @@ package body Exp_Ch3 is
 
             return New_List (
               Make_Implicit_Loop_Statement (Nod,
-                Identifier => Empty,
+                Identifier       => Empty,
                 Iteration_Scheme =>
                   Make_Iteration_Scheme (Loc,
                     Loop_Parameter_Specification =>
                       Make_Loop_Parameter_Specification (Loc,
-                        Defining_Identifier => Index,
+                        Defining_Identifier         => Index,
                         Discrete_Subtype_Definition =>
                           Make_Attribute_Reference (Loc,
-                            Prefix => New_Occurrence_Of (Object_Entity, Loc),
+                            Prefix          =>
+                              New_Occurrence_Of (Object_Entity, Loc),
                             Attribute_Name  => Name_Range,
                             Expressions     => New_List (
                               Make_Integer_Literal (Loc, N))))),
-                Statements =>  Check_One_Dimension (N + 1)));
+                Statements       =>  Check_One_Dimension (N + 1)));
          end if;
       end Check_One_Dimension;
 
@@ -875,13 +875,13 @@ package body Exp_Ch3 is
         Make_Subprogram_Body (Loc,
           Specification =>
             Make_Procedure_Specification (Loc,
-              Defining_Unit_Name => Proc_Id,
+              Defining_Unit_Name       => Proc_Id,
               Parameter_Specifications => New_List (
                 Make_Parameter_Specification (Loc,
                   Defining_Identifier => Object_Entity,
                   Parameter_Type      => New_Occurrence_Of (A_Type, Loc)))),
 
-          Declarations => New_List,
+          Declarations               => Empty_List,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc,
               Statements => Body_Stmts));
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index d9bd91975fc..3a34fbe6bfd 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3898,15 +3898,13 @@ package body Freeze is
                end;
             end if;
 
-         --  For a record (sub)type, freeze all the component types (RM
-         --  13.14(15). We test for E_Record_(sub)Type here, rather than using
-         --  Is_Record_Type, because we don't want to attempt the freeze for
-         --  the case of a private type with record extension (we will do that
-         --  later when the full type is frozen).
-
-         elsif Ekind (E) = E_Record_Type
-           or else Ekind (E) = E_Record_Subtype
-         then
+         --  For a record type or record subtype, freeze all component types
+         --  (RM 13.14(15)). We test for E_Record_(sub)Type here, rather than
+         --  using Is_Record_Type, because we don't want to attempt the freeze
+         --  for the case of a private type with record extension (we will do
+         --  that later when the full type is frozen).
+
+         elsif Ekind_In (E, E_Record_Type, E_Record_Subtype) then
             Freeze_Record_Type (E);
 
          --  For a concurrent type, freeze corresponding record type. This
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index 95c391378ad..5ee63d9896f 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -692,7 +692,9 @@ package body GNAT.Debug_Pools is
       --  Use standard (i.e. through malloc) allocations. This automatically
       --  raises Storage_Error if needed. We also try once more to physically
       --  release memory, so that even marked blocks, in the advanced scanning,
-      --  are freed.
+      --  are freed. Note that we do not initialize the storage array since it
+      --  is not necessary to do so (however this will cause bogus valgrind
+      --  warnings, which should simply be ignored).
 
       begin
          P := new Local_Storage_Array;
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 2383aa86054..8aef5b09247 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -1213,9 +1213,23 @@ __gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
 #ifdef __SEH__
 
 #define STATUS_USER_DEFINED		(1U << 29)
+
+/* From unwind-seh.c.  */
+#define GCC_MAGIC			(('G' << 16) | ('C' << 8) | 'C')
+#define GCC_EXCEPTION(TYPE)		\
+       (STATUS_USER_DEFINED | ((TYPE) << 24) | GCC_MAGIC)
+#define STATUS_GCC_THROW		GCC_EXCEPTION (0)
+
 EXCEPTION_DISPOSITION __gnat_SEH_error_handler
  (struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
 
+struct Exception_Data *
+__gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg);
+
+struct _Unwind_Exception *
+__gnat_create_machine_occurrence_from_signal_handler (Exception_Id,
+						      const char *);
+
 /* Unwind opcodes.  */
 #define UWOP_PUSH_NONVOL 0
 #define UWOP_ALLOC_LARGE 1
@@ -1295,7 +1309,10 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
      exceptions.  */
   if (!(ms_exc->ExceptionCode & STATUS_USER_DEFINED))
     {
+      struct Exception_Data *exception;
+      const char *msg;
       ULONG64 excpip = (ULONG64) ms_exc->ExceptionAddress;
+
       if (excpip != 0
 	  && excpip >= (ms_disp->ImageBase
 			+ ms_disp->FunctionEntry->BeginAddress)
@@ -1353,7 +1370,26 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame,
 	    __gnat_adjust_context
 	      ((unsigned char *)(mf_imagebase + mf_func->UnwindData), mf_rsp);
 	}
-      __gnat_SEH_error_handler (ms_exc, this_frame, ms_orig_context, ms_disp);
+
+      exception = __gnat_map_SEH (ms_exc, &msg);
+      if (exception != NULL)
+	{
+	  struct _Unwind_Exception *exc;
+
+	  /* Directly convert the system exception to a GCC one.
+	     This is really breaking the API, but is necessary for stack size
+	     reasons: the normal way is to call Raise_From_Signal_Handler,
+	     which build the exception and calls _Unwind_RaiseException, which
+	     unwinds the stack and will call this personality routine. But
+	     the Windows unwinder needs about 2KB of stack.  */
+	  exc = __gnat_create_machine_occurrence_from_signal_handler
+	    (exception, msg);
+	  memset (exc->private_, 0, sizeof (exc->private_));
+	  ms_exc->ExceptionCode = STATUS_GCC_THROW;
+	  ms_exc->NumberParameters = 1;
+	  ms_exc->ExceptionInformation[0] = (ULONG_PTR)exc;
+	}
+
     }
 
   return _GCC_specific_handler (ms_exc, this_frame, ms_orig_context,
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 6ea57752dc4..467a1e4356e 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -589,6 +589,16 @@ CND(ETOOMANYREFS, "Too many references")
 #endif
 CND(EWOULDBLOCK, "Operation would block")
 
+#ifndef E2BIG
+# define E2BIG -1
+#endif
+CND(E2BIG, "Argument list too long")
+
+#ifndef EILSEQ
+# define EILSEQ -1
+#endif
+CND(EILSEQ, "Illegal byte sequence")
+
 /**
  **  Terminal I/O constants
  **/
diff --git a/gcc/ada/seh_init.c b/gcc/ada/seh_init.c
index 84c5d3b6480..2f7fee435cf 100644
--- a/gcc/ada/seh_init.c
+++ b/gcc/ada/seh_init.c
@@ -68,20 +68,21 @@ extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
 #include <windows.h>
 #include <excpt.h>
 
+/* Prototypes.  */
 extern void _global_unwind2 (void *);
 
 EXCEPTION_DISPOSITION __gnat_SEH_error_handler
 (struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
 
-EXCEPTION_DISPOSITION
-__gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
-			  void *EstablisherFrame,
-			  struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
-			  void *DispatcherContext ATTRIBUTE_UNUSED)
-{
-  struct Exception_Data *exception;
-  const char *msg;
+struct Exception_Data *
+__gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg);
 
+/* Convert an SEH exception to an Ada one.  Return the exception ID
+   and set MSG with the corresponding message.  */
+
+struct Exception_Data *
+__gnat_map_SEH (EXCEPTION_RECORD* ExceptionRecord, const char **msg)
+{
   switch (ExceptionRecord->ExceptionCode)
     {
     case EXCEPTION_ACCESS_VIOLATION:
@@ -92,93 +93,95 @@ __gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 	  || IsBadCodePtr
 	  ((void *)(ExceptionRecord->ExceptionInformation[1] + 4096)))
 	{
-	  exception = &program_error;
-	  msg = "EXCEPTION_ACCESS_VIOLATION";
+	  *msg = "EXCEPTION_ACCESS_VIOLATION";
+	  return &program_error;
 	}
       else
 	{
 	  /* otherwise it is a stack overflow  */
-	  exception = &storage_error;
-	  msg = "stack overflow or erroneous memory access";
+	  *msg = "stack overflow or erroneous memory access";
+	  return &storage_error;
 	}
-      break;
 
     case EXCEPTION_ARRAY_BOUNDS_EXCEEDED:
-      exception = &constraint_error;
-      msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
-      break;
+      *msg = "EXCEPTION_ARRAY_BOUNDS_EXCEEDED";
+      return &constraint_error;
 
     case EXCEPTION_DATATYPE_MISALIGNMENT:
-      exception = &constraint_error;
-      msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
-      break;
+      *msg = "EXCEPTION_DATATYPE_MISALIGNMENT";
+      return &constraint_error;
 
     case EXCEPTION_FLT_DENORMAL_OPERAND:
-      exception = &constraint_error;
-      msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
-      break;
+      *msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
+      return &constraint_error;
 
     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
-      exception = &constraint_error;
-      msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
-      break;
+      *msg = "EXCEPTION_FLT_DENORMAL_OPERAND";
+      return &constraint_error;
 
     case EXCEPTION_FLT_INVALID_OPERATION:
-      exception = &constraint_error;
-      msg = "EXCEPTION_FLT_INVALID_OPERATION";
-      break;
+      *msg = "EXCEPTION_FLT_INVALID_OPERATION";
+      return &constraint_error;
 
     case EXCEPTION_FLT_OVERFLOW:
-      exception = &constraint_error;
-      msg = "EXCEPTION_FLT_OVERFLOW";
-      break;
+      *msg = "EXCEPTION_FLT_OVERFLOW";
+      return &constraint_error;
 
     case EXCEPTION_FLT_STACK_CHECK:
-      exception = &program_error;
-      msg = "EXCEPTION_FLT_STACK_CHECK";
-      break;
+      *msg = "EXCEPTION_FLT_STACK_CHECK";
+      return &program_error;
 
     case EXCEPTION_FLT_UNDERFLOW:
-      exception = &constraint_error;
-      msg = "EXCEPTION_FLT_UNDERFLOW";
-      break;
+      *msg = "EXCEPTION_FLT_UNDERFLOW";
+      return &constraint_error;
 
     case EXCEPTION_INT_DIVIDE_BY_ZERO:
-      exception = &constraint_error;
-      msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
-      break;
+      *msg = "EXCEPTION_INT_DIVIDE_BY_ZERO";
+      return &constraint_error;
 
     case EXCEPTION_INT_OVERFLOW:
-      exception = &constraint_error;
-      msg = "EXCEPTION_INT_OVERFLOW";
-      break;
+      *msg = "EXCEPTION_INT_OVERFLOW";
+      return &constraint_error;
 
     case EXCEPTION_INVALID_DISPOSITION:
-      exception = &program_error;
-      msg = "EXCEPTION_INVALID_DISPOSITION";
-      break;
+      *msg = "EXCEPTION_INVALID_DISPOSITION";
+      return &program_error;
 
     case EXCEPTION_NONCONTINUABLE_EXCEPTION:
-      exception = &program_error;
-      msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
-      break;
+      *msg = "EXCEPTION_NONCONTINUABLE_EXCEPTION";
+      return &program_error;
 
     case EXCEPTION_PRIV_INSTRUCTION:
-      exception = &program_error;
-      msg = "EXCEPTION_PRIV_INSTRUCTION";
-      break;
+      *msg = "EXCEPTION_PRIV_INSTRUCTION";
+      return &program_error;
 
     case EXCEPTION_SINGLE_STEP:
-      exception = &program_error;
-      msg = "EXCEPTION_SINGLE_STEP";
-      break;
+      *msg = "EXCEPTION_SINGLE_STEP";
+      return &program_error;
 
     case EXCEPTION_STACK_OVERFLOW:
-      exception = &storage_error;
-      msg = "EXCEPTION_STACK_OVERFLOW";
-      break;
+      *msg = "EXCEPTION_STACK_OVERFLOW";
+      return &storage_error;
 
     default:
+      *msg = NULL;
+      return NULL;
+    }
+}
+
+EXCEPTION_DISPOSITION
+__gnat_SEH_error_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
+			  void *EstablisherFrame,
+			  struct _CONTEXT* ContextRecord ATTRIBUTE_UNUSED,
+			  void *DispatcherContext ATTRIBUTE_UNUSED)
+{
+  struct Exception_Data *exception;
+  const char *msg;
+
+  exception = __gnat_map_SEH (ExceptionRecord, &msg);
+
+  if (exception == NULL)
+    {
 #if defined (_WIN64) && defined (__SEH__)
       /* On Windows x64, do not transform other exception as they could
 	 be caught by user (when SEH is used to propagate exceptions).  */