2007-04-06 Robert Dewar <dewar@adacore.com>

	* a-except.adb, a-except.ads, a-except-2005.ads, a-except-2005.adb
	(Local_Raise): New dummy procedure called when a raise is converted
	to a local goto. Used for debugger to detect that the exception
	is raised.

	* debug.adb: Document new d.g flag (expand local raise statements to
	gotos even if pragma Restriction (No_Exception_Propagation) is not set)

	* exp_sel.adb: Use Make_Implicit_Exception_Handler

	* exp_ch11.adb (Expand_Exception_Handlers): Use new flag -gnatw.x to
	suppress warnings for unused handlers.
	(Warn_If_No_Propagation):  Use new flag -gnatw.x to suppress
	warnings for raise statements not handled locally.
	(Get_RT_Exception_Entity): New function
	(Get_Local_Call_Entity): New function
	(Find_Local_Handler): New function
	(Warn_If_No_Propagation): New procedure
	(Expand_At_End_Handler): Call Make_Implicit_Handler
	(Expand_Exception_Handlers): Major additions to deal with local handlers
	(Expand_N_Raise_Constraint_Error, Expand_N_Raise_Program_Error,
	Expand_N_Raise_Storage_Error, (Expand_N_Raise_Statement): Add handling
	for local raise

	* exp_ch11.ads (Get_RT_Exception_Entity): New function
	(Get_Local_Call_Entity): New function

	* gnatbind.adb (Restriction_List): Add No_Exception_Propagation to list
	of restrictions that the binder will never suggest adding.

	* par-ch11.adb (P_Exception_Handler): Set Local_Raise_Statements field
	to No_Elist.

	* restrict.adb (Check_Restricted_Unit): GNAT.Current_Exception may not
	be with'ed in the presence of pragma Restriction
	(No_Exception_Propagation).

	* sem.adb (Analyze): Add entries for N_Push and N_Pop nodes

	* sem_ch11.adb (Analyze_Exception_Handler): If there is a choice
	parameter, then the handler is not a suitable target for a local raise,
	and this is a violation of restriction No_Exception_Propagation.
	(Analyze_Handled_Statements): Analyze choice parameters in exception
	handlers before analyzing statement sequence (needed for proper
	detection of local raise statements).
	(Analyze_Raise_Statement): Reraise statement is a violation of the
	No_Exception_Propagation restriction.

	* s-rident.ads: Add new restriction No_Exception_Propagation

	* tbuild.ads, tbuild.adb (Make_Implicit_Exception_Handler): New
	function, like Make_Exception_Handler but sets Local_Raise_Statements
	to No_List.
	(Add_Unique_Serial_Number): Deal with case where this is called during
	processing of configuration pragmas.

From-SVN: r123541

16 files changed, 1315 insertions, 210 deletions

diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 0c9bc68..4863321 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -760,6 +760,16 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------------
+   -- Local_Raise --
+   -----------------
+
+   procedure Local_Raise (Excep : Exception_Id) is
+      pragma Warnings (Off, Excep);
+   begin
+      return;
+   end Local_Raise;
+
    -----------------------
    -- Stream Attributes --
    -----------------------
diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads
index fd42ab7..f42d094 100644
--- a/gcc/ada/a-except-2005.ads
+++ b/gcc/ada/a-except-2005.ads
@@ -139,6 +139,23 @@ package Ada.Exceptions is
      (Source : Exception_Occurrence)
       return   Exception_Occurrence_Access;
 
+   --  Ada 2005 (AI-438): The language revision introduces the
+   --  following subprograms and attribute definitions. We do not
+   --  provide them explicitly; instead, the corresponding stream
+   --  attributes are made available through a pragma Stream_Convert
+   --  in the private part of this package.
+
+   --  procedure Read_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : out Exception_Occurrence);
+
+   --  procedure Write_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : Exception_Occurrence);
+
+   --  for Exception_Occurrence'Read use Read_Exception_Occurrence;
+   --  for Exception_Occurrence'Write use Write_Exception_Occurrence;
+
 private
    package SSL renames System.Standard_Library;
    package SP renames System.Parameters;
@@ -192,6 +209,15 @@ private
    --  private barrier, so we can place this function in the private part
    --  where the compiler can find it, but the spec is unchanged.)
 
+   procedure Local_Raise (Excep : Exception_Id);
+   pragma Export (Ada, Local_Raise);
+   --  This is a dummy routine, used only by the debugger for the purpose of
+   --  logging local raise statements that were transformed into a direct goto
+   --  to the handler code. The compiler in this case generates:
+   --
+   --    Local_Raise (exception_id);
+   --    goto Handler
+
    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception_Always);
    pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 44c7640..41d7e02 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -690,6 +690,16 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------------
+   -- Local_Raise --
+   -----------------
+
+   procedure Local_Raise (Excep : Exception_Id) is
+      pragma Warnings (Off, Excep);
+   begin
+      return;
+   end Local_Raise;
+
    -----------------------
    -- Stream Attributes --
    -----------------------
diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads
index 2dae518..0c1f224 100644
--- a/gcc/ada/a-except.ads
+++ b/gcc/ada/a-except.ads
@@ -35,7 +35,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This version of Ada.Exceptions is a full Ada 95 version.
+--  This version of Ada.Exceptions is a full Ada 95 version. It omits Ada 2005
+--  features such as the additional definitions of Exception_Name returning
+--  Wide_[Wide_]String.
+
 --  It is used for building the compiler and the basic tools, since these
 --  builds may be done with bootstrap compilers that cannot handle these
 --  additions. The full version of Ada.Exceptions can be found in the files
@@ -172,6 +175,15 @@ private
    --  private barrier, so we can place this function in the private part
    --  where the compiler can find it, but the spec is unchanged.)
 
+   procedure Local_Raise (Excep : Exception_Id);
+   pragma Export (Ada, Local_Raise);
+   --  This is a dummy routine, used only by the debugger for the purpose of
+   --  logging local raise statements that were transformed into a direct goto
+   --  to the handler code. The compiler in this case generates:
+   --
+   --    Local_Raise (exception_id);
+   --    goto Handler
+
    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception_Always);
    pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index d7dd11e..e0823fa 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -99,7 +99,7 @@ package body Debug is
    --  d.d
    --  d.e
    --  d.f  Inhibit folding of static expressions
-   --  d.g
+   --  d.g  Enable conversion of raise into goto
    --  d.h
    --  d.i
    --  d.j
@@ -474,6 +474,11 @@ package body Debug is
    --       in seriously non-conforming behavior, but is useful sometimes
    --       when tracking down handling of complex expressions.
 
+   --  d.g  Enables conversion of a raise statement into a goto when the
+   --       relevant handler is statically determinable. For now we only try
+   --       this if this debug flag is set. Later we will enable this more
+   --       generally by default.
+
    --  d.l  Use Ada 95 semantics for limited function returns. This may be
    --       used to work around the incompatibility introduced by AI-318-2.
    --       It is useful only in -gnat05 mode.
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 2312f50..61013c2 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -28,6 +28,7 @@ with Atree;    use Atree;
 with Casing;   use Casing;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
+with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
 with Exp_Util; use Exp_Util;
@@ -54,6 +55,26 @@ with Uintp;    use Uintp;
 
 package body Exp_Ch11 is
 
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function Find_Local_Handler
+     (Ename : Entity_Id;
+      Nod   : Node_Id) return Node_Id;
+   pragma Warnings (Off, Find_Local_Handler);
+   --  This function searches for a local exception handler that will handle
+   --  the exception named by Ename. If such a local hander exists, then the
+   --  corresponding N_Exception_Handler is returned. If no such handler is
+   --  found then Empty is returned. In order to match and return True, the
+   --  handler may not have a choice parameter specification. N is the raise
+   --  node that references the handler.
+
+   procedure Warn_If_No_Propagation (N : Node_Id);
+   --  Called for an exception raise that is not a local raise (and thus can
+   --  not be optimized to a goto. Issues warning if No_Exception_Propagation
+   --  restriction is set. N is the node for the raise or equivalent call.
+
    ---------------------------
    -- Expand_At_End_Handler --
    ---------------------------
@@ -128,7 +149,7 @@ package body Exp_Ch11 is
         Make_Raise_Statement (Loc));
 
       Set_Exception_Handlers (HSS, New_List (
-        Make_Exception_Handler (Loc,
+        Make_Implicit_Exception_Handler (Loc,
           Exception_Choices => New_List (Ohandle),
           Statements        => Stmnts)));
 
@@ -145,11 +166,16 @@ package body Exp_Ch11 is
    -------------------------------
 
    procedure Expand_Exception_Handlers (HSS : Node_Id) is
-      Handlrs       : constant List_Id := Exception_Handlers (HSS);
-      Loc           : Source_Ptr;
+      Handlrs       : constant List_Id    := Exception_Handlers (HSS);
+      Loc           : constant Source_Ptr := Sloc (HSS);
       Handler       : Node_Id;
       Others_Choice : Boolean;
       Obj_Decl      : Node_Id;
+      Next_Handler  : Node_Id;
+
+      procedure Expand_Local_Exception_Handlers;
+      --  This procedure handles the expansion of exception handlers for the
+      --  optimization of local raise statements into goto statements.
 
       procedure Prepend_Call_To_Handler
         (Proc : RE_Id;
@@ -157,6 +183,573 @@ package body Exp_Ch11 is
       --  Routine to prepend a call to the procedure referenced by Proc at
       --  the start of the handler code for the current Handler.
 
+      procedure Replace_Raise_By_Goto (Raise_S : Node_Id; Goto_L1 : Node_Id);
+      --  Raise_S is a raise statement (possibly expanded, and possibly of the
+      --  form of a Raise_xxx_Error node with a condition. This procedure is
+      --  called to replace the raise action with the (already analyzed) goto
+      --  statement passed as Goto_L1. This procedure also takes care of the
+      --  requirement of inserting a Local_Raise call where possible.
+
+      -------------------------------------
+      -- Expand_Local_Exception_Handlers --
+      -------------------------------------
+
+      --  There are two cases for this transformation. First the case of
+      --  explicit raise statements. For this case, the transformation we do
+      --  looks like this. Right now we have for example (where L1,L2 are
+      --  exception labels)
+
+      --  begin
+      --     ...
+      --     raise_exception (excep1'identity);  -- was raise excep1
+      --     ...
+      --     raise_exception (excep2'identity);  -- was raise excep2
+      --     ...
+      --  exception
+      --     when excep1 =>
+      --        estmts1
+      --     when excep2 =>
+      --        estmts2
+      --  end;
+
+      --  This gets transformed into:
+
+      --  begin
+      --     L1 : label;
+      --     L2 : label;
+      --     L3 : label;
+
+      --     begin
+      --        ...
+      --        local_raise (excep1'Identity);   -- was raise excep1
+      --        goto L1;
+      --        ...
+      --        local_raise (excep2'Identity);   -- was raise excep2
+      --        goto L2;
+      --        ...
+      --     exception
+      --        when excep1 =>
+      --           goto L1;
+      --        when excep2 =>
+      --           goto L2;
+      --     end;
+
+      --     goto L3;   -- skip handler when exception not raised
+
+      --     <<L1>>     -- target label for local exception
+      --        estmts1
+      --        goto L3;
+
+      --     <<L2>>
+      --        estmts2
+      --        goto L3;
+      --     <<L3>>
+      --  end;
+
+      --  Note: the reason we wrap the original statement sequence in an
+      --  inner block is that there may be raise statements within the
+      --  sequence of statements in the handlers, and we must ensure that
+      --  these are properly handled, and in particular, such raise statements
+      --  must not reenter the same exception handlers.
+
+      --  If the restriction No_Exception_Propagation is in effect, then we
+      --  can omit the exception handlers, and we do not need the inner block.
+
+      --  begin
+      --     L1 : label;
+      --     L2 : label;
+      --     L3 : label;
+
+      --     ...
+      --     local_raise (excep1'Identity);   -- was raise excep1
+      --     goto L1;
+      --     ...
+      --     local_raise (excep2'Identity);   -- was raise excep2
+      --     goto L2;
+      --     ...
+
+      --     goto L3;   -- skip handler when exception not raised
+
+      --     <<L1>>     -- target label for local exception
+      --        estmts1
+      --        goto L3;
+
+      --     <<L2>>
+      --        estmts2
+      --        goto L3;
+      --     <<L3>>
+      --  end;
+
+      --  The second case is for exceptions generated by the back end in one
+      --  of three situations:
+
+      --    1. Front end generates N_Raise_xxx_Error node
+      --    2. Front end sets Do_xxx_Check flag in subexpression node
+      --    3. Back end detects a situation where an exception is appropriate
+
+      --  In all these cases, the current processing in gigi is to generate a
+      --  call to the appropriate Rcheck_xx routine (where xx encodes both the
+      --  exception message and the exception to be raised, Constraint_Error,
+      --  Program_Error, or Storage_Error.
+
+      --  We could handle some subcases of 1 using the same front end expansion
+      --  into gotos, but even for case 1, we can't handle all cases, since
+      --  generating gotos in the middle of expressions is not possible (it's
+      --  possible at the gigi/gcc level, but not at the level of the GNAT
+      --  tree).
+
+      --  In any case, it seems easier to have a scheme which handles all three
+      --  cases in a uniform manner. So here is how we proceed in this case.
+
+      --  This procedure detects all handlers for these three exceptions,
+      --  Constraint_Error, Program_Error and Storage_Error (including WHEN
+      --  OTHERS handlers that cover one or more of these cases).
+
+      --  If the handler meets the requirements for being the target of a local
+      --  raise, then the front end does the expansion described previously,
+      --  creating a label to be used as a goto target to raise the exception.
+      --  However, no attempt is made in the front end to convert any related
+      --  raise statements into gotos, e.g. all Raise_xxx_Error nodes are left
+      --  unchanged and passed to the back end.
+
+      --  Instead, the front end generates two nodes
+
+      --     N_Push_Constraint_Error_Label
+      --     N_Push_Program_Error_Label
+      --     N_Push_Storage_Error_Label
+
+      --       The Push node is generated at the start of the statements
+      --       covered by the handler, and has as a parameter the label to be
+      --       used as the raise target.
+
+      --     N_Pop_Constraint_Error_Label
+      --     N_Pop_Program_Error_Label
+      --     N_Pop_Storage_Error_Label
+
+      --       The Pop node is generated at the end of the covered statements
+      --       and undoes the effect of the preceding corresponding Push node.
+
+      --  In the case where the handler does NOT meet the requirements, the
+      --  front end will still generate the Push and Pop nodes, but the label
+      --  field in the Push node will be empty signifying that for this region
+      --  of code, no optimization is possible.
+
+      --  The back end must maintain three stacks, one for each exception case,
+      --  the Push node pushes an entry onto the corresponding stack, and pop
+      --  node pops off the entry. Then instead of calling Rcheck_nn, if the
+      --  corresponding top stack entry has an non-empty label, a goto is
+      --  generated instead of the call. This goto should be preceded by a
+      --  call to Local_Raise as described above.
+
+      --  An example of this transformation is as follows, given:
+
+      --  declare
+      --    A : Integer range 1 .. 10;
+      --  begin
+      --    A := B + C;
+      --  exception
+      --    when Constraint_Error =>
+      --       estmts
+      --  end;
+
+      --  gets transformed to:
+
+      --  declare
+      --    A : Integer range 1 .. 10;
+
+      --  begin
+      --     L1 : label;
+      --     L2 : label;
+
+      --     begin
+      --       %push_constraint_error_label (L1)
+      --       R1b : constant long_long_integer := long_long_integer?(b) +
+      --         long_long_integer?(c);
+      --       [constraint_error when
+      --         not (R1b in -16#8000_0000# .. 16#7FFF_FFFF#)
+      --         "overflow check failed"]
+      --        a := integer?(R1b);
+      --        %pop_constraint_error_Label
+
+      --     exception
+      --        ...
+      --        when constraint_error =>
+      --           goto L1;
+      --     end;
+
+      --     goto L2;       -- skip handler when exception not raised
+      --     <<L1>>         -- target label for local exception
+      --     estmts
+      --     <<L2>>
+      --  end;
+
+      CE_Locally_Handled : Boolean := False;
+      SE_Locally_Handled : Boolean := False;
+      PE_Locally_Handled : Boolean := False;
+      --  These three flags indicate whether a handler for the corresponding
+      --  exception (CE=Constraint_Error, SE=Storage_Error, PE=Program_Error)
+      --  is present. If so the switch is set to True, the Exception_Label
+      --  field of the corresponding handler is set, and appropriate Push
+      --  and Pop nodes are inserted into the code.
+
+      Local_Expansion_Required : Boolean := False;
+      --  Set True if we have at least one handler requiring local raise
+      --  expansion as described above.
+
+      procedure Expand_Local_Exception_Handlers is
+
+         procedure Add_Exception_Label (H : Node_Id);
+         --  H is an exception handler. First check for an Exception_Label
+         --  already allocated for H. If not, allocate one, set the field in
+         --  the handler node, add the label declaration, and set the flag
+         --  Local_Expansion_Required. Note: if Local_Handlers_Not_OK is set
+         --  the call has no effect and Exception_Label is left empty.
+
+         procedure Add_Label_Declaration (L : Entity_Id);
+         --  Add an implicit declaration of the given label to the declaration
+         --  list in the parent of the current sequence of handled statements.
+
+         generic
+            Exc_Locally_Handled : in out Boolean;
+            --  Flag indicating whether a local handler for this exception
+            --  has already been generated.
+
+            with function Make_Push_Label (Loc : Source_Ptr) return Node_Id;
+            --  Function to create a Push_xxx_Label node
+
+            with function Make_Pop_Label (Loc : Source_Ptr) return Node_Id;
+            --  Function to create a Pop_xxx_Label node
+
+         procedure Generate_Push_Pop (H : Node_Id);
+         --  Common code for Generate_Push_Pop_xxx below, used to generate an
+         --  exception label and Push/Pop nodes for Constraint_Error,
+         --  Program_Error, or Storage_Error.
+
+         -------------------------
+         -- Add_Exception_Label --
+         -------------------------
+
+         procedure Add_Exception_Label (H : Node_Id) is
+         begin
+            if No (Exception_Label (H))
+              and then not Local_Raise_Not_OK (H)
+            then
+               Local_Expansion_Required := True;
+
+               declare
+                  L : constant Entity_Id :=
+                        Make_Defining_Identifier (Sloc (H),
+                          Chars => New_Internal_Name ('L'));
+               begin
+                  Set_Exception_Label (H, L);
+                  Add_Label_Declaration (L);
+               end;
+            end if;
+         end Add_Exception_Label;
+
+         ---------------------------
+         -- Add_Label_Declaration --
+         ---------------------------
+
+         procedure Add_Label_Declaration (L : Entity_Id) is
+            P : constant Node_Id := Parent (HSS);
+
+            Decl_L : constant Node_Id :=
+                       Make_Implicit_Label_Declaration (Loc,
+                         Defining_Identifier => L);
+
+         begin
+            if Declarations (P) = No_List then
+               Set_Declarations (P, Empty_List);
+            end if;
+
+            Append (Decl_L, Declarations (P));
+            Analyze (Decl_L);
+         end Add_Label_Declaration;
+
+         -----------------------
+         -- Generate_Push_Pop --
+         -----------------------
+
+         procedure Generate_Push_Pop (H : Node_Id) is
+         begin
+            if Exc_Locally_Handled then
+               return;
+            else
+               Exc_Locally_Handled := True;
+            end if;
+
+            Add_Exception_Label (H);
+
+            declare
+               F : constant Node_Id := First (Statements (HSS));
+               L : constant Node_Id := Last  (Statements (HSS));
+
+               Push : constant Node_Id := Make_Push_Label (Sloc (F));
+               Pop  : constant Node_Id := Make_Pop_Label  (Sloc (L));
+
+            begin
+               Set_Exception_Label (Push, Exception_Label (H));
+
+               Insert_Before (F, Push);
+               Set_Analyzed (Push);
+
+               Insert_After (L, Pop);
+               Set_Analyzed (Pop);
+            end;
+         end Generate_Push_Pop;
+
+         --  Local declarations
+
+         Loc    : constant Source_Ptr := Sloc (HSS);
+         Stmts  : List_Id;
+         Choice : Node_Id;
+
+         procedure Generate_Push_Pop_For_Constraint_Error is
+           new Generate_Push_Pop
+             (Exc_Locally_Handled => CE_Locally_Handled,
+              Make_Push_Label     => Make_Push_Constraint_Error_Label,
+              Make_Pop_Label      => Make_Pop_Constraint_Error_Label);
+         --  If no Push/Pop has been generated for CE yet, then set the flag
+         --  CE_Locally_Handled, allocate an Exception_Label for handler H (if
+         --  not already done), and generate Push/Pop nodes for the exception
+         --  label at the start and end of the statements of HSS.
+
+         procedure Generate_Push_Pop_For_Program_Error is
+           new Generate_Push_Pop
+             (Exc_Locally_Handled => PE_Locally_Handled,
+              Make_Push_Label     => Make_Push_Program_Error_Label,
+              Make_Pop_Label      => Make_Pop_Program_Error_Label);
+         --  If no Push/Pop has been generated for PE yet, then set the flag
+         --  PE_Locally_Handled, allocate an Exception_Label for handler H (if
+         --  not already done), and generate Push/Pop nodes for the exception
+         --  label at the start and end of the statements of HSS.
+
+         procedure Generate_Push_Pop_For_Storage_Error is
+           new Generate_Push_Pop
+             (Exc_Locally_Handled => SE_Locally_Handled,
+              Make_Push_Label     => Make_Push_Storage_Error_Label,
+              Make_Pop_Label      => Make_Pop_Storage_Error_Label);
+         --  If no Push/Pop has been generated for SE yet, then set the flag
+         --  SE_Locally_Handled, allocate an Exception_Label for handler H (if
+         --  not already done), and generate Push/Pop nodes for the exception
+         --  label at the start and end of the statements of HSS.
+
+      begin
+         --  See if we have any potential local raises to expand
+
+         Handler := First_Non_Pragma (Handlrs);
+         while Present (Handler) loop
+
+            --  Note, we do not test Local_Raise_Not_OK here, because in the
+            --  case of Push/Pop generation we want to generate push with a
+            --  null label. The Add_Exception_Label routine has no effect if
+            --  Local_Raise_Not_OK is set, so this works as required.
+
+            if Present (Local_Raise_Statements (Handler)) then
+               Add_Exception_Label (Handler);
+            end if;
+
+            --  If we are doing local raise to goto optimization (restriction
+            --  No_Exception_Propagation set or debug flag .g set), then check
+            --  to see if handler handles CE,PE,SE and if so generate the
+            --  appropriate push/pop sequences for the back end
+
+            if Debug_Flag_Dot_G
+              or else Restriction_Active (No_Exception_Propagation)
+            then
+               Choice := First (Exception_Choices (Handler));
+               while Present (Choice) loop
+                  if Nkind (Choice) = N_Others_Choice then
+                     Generate_Push_Pop_For_Constraint_Error (Handler);
+                     Generate_Push_Pop_For_Program_Error    (Handler);
+                     Generate_Push_Pop_For_Storage_Error    (Handler);
+
+                  elsif Is_Entity_Name (Choice) then
+                     if Entity (Choice) = Standard_Constraint_Error then
+                        Generate_Push_Pop_For_Constraint_Error (Handler);
+                     elsif Entity (Choice) = Standard_Program_Error then
+                        Generate_Push_Pop_For_Program_Error (Handler);
+                     elsif Entity (Choice) = Standard_Storage_Error then
+                        Generate_Push_Pop_For_Storage_Error (Handler);
+                     end if;
+                  end if;
+
+                  Next (Choice);
+               end loop;
+            end if;
+
+            Next_Non_Pragma (Handler);
+         end loop;
+
+         --  Nothing to do if no handlers requiring the goto transformation
+
+         if not (Local_Expansion_Required) then
+            return;
+         end if;
+
+         --  Prepare to do the transformation
+
+         declare
+            L3_Dent : constant Entity_Id :=
+                        Make_Defining_Identifier (Loc,
+                          Chars => New_Internal_Name ('L'));
+
+            Labl_L3 : constant Node_Id :=
+                        Make_Label (Loc,
+                          Identifier => New_Occurrence_Of (L3_Dent, Loc));
+
+            Old_HSS : Node_Id;
+            Blk_Stm : Node_Id;
+            Relmt   : Elmt_Id;
+
+         begin
+            Add_Label_Declaration (L3_Dent);
+
+            --  If the No_Exception_Propagation restriction is not active,
+            --  then we must wrap the existing statements and exception
+            --  handlers in an inner block.
+
+            if not Restriction_Active (No_Exception_Propagation) then
+               Old_HSS := Relocate_Node (HSS);
+
+               --  Construct and analyze the block with a dummy HSS inside it
+               --  for now (if we do the analyze call with the real HSS in
+               --  place we have nasty recursion problems).
+
+               Blk_Stm :=
+                 Make_Block_Statement (Loc,
+                   Handled_Statement_Sequence =>
+                     Make_Handled_Sequence_Of_Statements (Loc,
+                       Statements => Empty_List));
+
+               Rewrite (HSS,
+                 Make_Handled_Sequence_Of_Statements (Loc,
+                   Statements => New_List (Blk_Stm)));
+               Analyze (HSS);
+
+               --  Now we can set the real statement sequence in place
+
+               Set_Handled_Statement_Sequence (Blk_Stm, Old_HSS);
+            end if;
+
+            --  Now loop through the exception handlers to deal with those that
+            --  are targets of local raise statements.
+
+            Handler := First_Non_Pragma (Handlrs);
+            while Present (Handler) loop
+               if Present (Exception_Label (Handler)) then
+
+                  --  This handler needs the goto expansion
+
+                  declare
+                     Loc : constant Source_Ptr := Sloc (Handler);
+
+                     L1_Dent : constant Entity_Id := Exception_Label (Handler);
+
+                     Labl_L1 : constant Node_Id :=
+                                 Make_Label (Loc,
+                                   Identifier =>
+                                     New_Occurrence_Of (L1_Dent, Loc));
+
+                     Name_L1 : constant Node_Id :=
+                                 New_Occurrence_Of (L1_Dent, Loc);
+
+                     Goto_L1 : constant Node_Id :=
+                                 Make_Goto_Statement (Loc,
+                                   Name => Name_L1);
+
+                     Name_L3 : constant Node_Id :=
+                                 New_Occurrence_Of (L3_Dent, Loc);
+
+                     Goto_L3 : constant Node_Id :=
+                                 Make_Goto_Statement (Loc,
+                                   Name => Name_L3);
+
+                     H_Stmts : constant List_Id := Statements (Handler);
+
+                  begin
+                     --  Replace handler by a goto L1. We can mark this as
+                     --  analyzed since it is fully formed, and we don't
+                     --  want it going through any further checks.
+
+                     Set_Statements (Handler, New_List (Goto_L1));
+                     Set_Analyzed (Goto_L1);
+                     Set_Etype (Name_L1, Standard_Void_Type);
+
+                     --  Now replace all the raise statements by goto L1
+
+                     if Present (Local_Raise_Statements (Handler)) then
+                        Relmt := First_Elmt (Local_Raise_Statements (Handler));
+                        while Present (Relmt) loop
+                           declare
+                              Raise_S : constant Node_Id := Node (Relmt);
+
+                              Name_L1 : constant Node_Id :=
+                                          New_Occurrence_Of (L1_Dent, Loc);
+
+                              Goto_L1 : constant Node_Id :=
+                                          Make_Goto_Statement (Loc,
+                                            Name => Name_L1);
+
+                           begin
+                              --  Replace raise by goto L1
+
+                              Set_Analyzed (Goto_L1);
+                              Set_Etype (Name_L1, Standard_Void_Type);
+                              Replace_Raise_By_Goto (Raise_S, Goto_L1);
+                           end;
+
+                           Next_Elmt (Relmt);
+                        end loop;
+                     end if;
+
+                     --  Add goto L3 at end of statement list in block. The
+                     --  first time, this is what skips over the exception
+                     --  handlers in the normal case. Subsequent times, it
+                     --  terminates the execution of the handler code, and
+                     --  skips subsequent handlers.
+
+                     Stmts := Statements (HSS);
+
+                     Insert_After (Last (Stmts), Goto_L3);
+                     Set_Analyzed (Goto_L3);
+                     Set_Etype (Name_L3, Standard_Void_Type);
+
+                     --  Now we drop the label that marks the handler start,
+                     --  followed by the statements of the handler.
+
+                     Set_Etype (Identifier (Labl_L1), Standard_Void_Type);
+
+                     Insert_After_And_Analyze (Last (Stmts), Labl_L1);
+                     Insert_List_After        (Last (Stmts), H_Stmts);
+                  end;
+
+                  --  Here if we have local raise statements but the handler is
+                  --  not suitable for processing with a local raise. In this
+                  --  case we have to delete the Local_Raise call and also
+                  --  generate possible diagnostics.
+
+               else
+                  Relmt := First_Elmt (Local_Raise_Statements (Handler));
+                  while Present (Relmt) loop
+                     Warn_If_No_Propagation (Node (Relmt));
+                     Remove (Prev (Node (Relmt)));
+                     Next_Elmt (Relmt);
+                  end loop;
+               end if;
+
+               Next (Handler);
+            end loop;
+
+            --  Only remaining step is to drop the L3 label and we are done
+
+            Set_Etype (Identifier (Labl_L3), Standard_Void_Type);
+            Insert_After_And_Analyze (Last (Stmts), Labl_L3);
+            return;
+         end;
+      end Expand_Local_Exception_Handlers;
+
       -----------------------------
       -- Prepend_Call_To_Handler --
       -----------------------------
@@ -185,145 +778,254 @@ package body Exp_Ch11 is
          end if;
       end Prepend_Call_To_Handler;
 
+      ---------------------------
+      -- Replace_Raise_By_Goto --
+      ---------------------------
+
+      procedure Replace_Raise_By_Goto (Raise_S : Node_Id; Goto_L1 : Node_Id) is
+         Loc   : constant Source_Ptr := Sloc (Raise_S);
+         Excep : Entity_Id;
+         LR    : Node_Id;
+         Cond  : Node_Id;
+         Orig  : Node_Id;
+
+      begin
+         --  If we have a null statement, it means that there is no replacement
+         --  needed (typically this results from a suppressed check).
+
+         if Nkind (Raise_S) = N_Null_Statement then
+            return;
+
+         --  Test for Raise_xxx_Error
+
+         elsif Nkind (Raise_S) = N_Raise_Constraint_Error then
+            Excep := Standard_Constraint_Error;
+            Cond  := Condition (Raise_S);
+
+         elsif Nkind (Raise_S) = N_Raise_Storage_Error then
+            Excep := Standard_Storage_Error;
+            Cond := Condition (Raise_S);
+
+         elsif Nkind (Raise_S) = N_Raise_Program_Error then
+            Excep := Standard_Program_Error;
+            Cond := Condition (Raise_S);
+
+            --  The only other possibility is a node that is or used to be
+            --  a simple raise statement.
+
+         else
+            Orig := Original_Node (Raise_S);
+            pragma Assert (Nkind (Orig) = N_Raise_Statement
+                             and then Present (Name (Orig))
+                             and then No (Expression (Orig)));
+            Excep := Entity (Name (Orig));
+            Cond := Empty;
+         end if;
+
+         --  Here Excep is the exception to raise, and Cond is the condition
+         --  First prepare the call to Local_Raise (excep'Identity).
+
+         if RTE_Available (RE_Local_Raise) then
+            LR :=
+              Make_Procedure_Call_Statement (Loc,
+                Name => New_Occurrence_Of (RTE (RE_Local_Raise), Loc),
+                Parameter_Associations => New_List (
+                  Make_Attribute_Reference (Loc,
+                    Prefix         => New_Occurrence_Of (Excep, Loc),
+                    Attribute_Name => Name_Identity)));
+
+            --  Use null statement if Local_Raise not available
+
+         else
+            LR :=
+              Make_Null_Statement (Loc);
+         end if;
+
+         --  If there is no condition, we rewrite as
+
+         --    begin
+         --       Local_Raise (excep'Identity);
+         --       goto L1;
+         --    end;
+
+         if No (Cond) then
+            Rewrite (Raise_S,
+              Make_Block_Statement (Loc,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => New_List (LR, Goto_L1))));
+
+         --  If there is a condition, we rewrite as
+
+         --    if condition then
+         --       Local_Raise (excep'Identity);
+         --       goto L1;
+         --    end if;
+
+         else
+            Rewrite (Raise_S,
+              Make_If_Statement (Loc,
+                Condition       => Cond,
+                Then_Statements => New_List (LR, Goto_L1)));
+         end if;
+
+         Analyze (Raise_S);
+      end Replace_Raise_By_Goto;
+
    --  Start of processing for Expand_Exception_Handlers
 
    begin
+      Expand_Local_Exception_Handlers;
+
       --  Loop through handlers
 
       Handler := First_Non_Pragma (Handlrs);
       Handler_Loop : while Present (Handler) loop
-         Loc := Sloc (Handler);
+         Next_Handler := Next_Non_Pragma (Handler);
 
          --  Remove source handler if gnat debug flag N is set
 
          if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then
-            declare
-               H : constant Node_Id := Handler;
-            begin
-               Next_Non_Pragma (Handler);
-               Remove (H);
-               goto Continue_Handler_Loop;
-            end;
-         end if;
-
-         --  If an exception occurrence is present, then we must declare it
-         --  and initialize it from the value stored in the TSD
-
-         --     declare
-         --        name : Exception_Occurrence;
-         --
-         --     begin
-         --        Save_Occurrence (name, Get_Current_Excep.all)
-         --        ...
-         --     end;
+            Remove (Handler);
 
-         if Present (Choice_Parameter (Handler)) then
-            declare
-               Cparm : constant Entity_Id  := Choice_Parameter (Handler);
-               Clc   : constant Source_Ptr := Sloc (Cparm);
-               Save  : Node_Id;
+         --  Remove handler if no exception propagation, generating a warning
+         --  if a source generated handler was not the target of a local raise.
 
-            begin
-               Save :=
-                 Make_Procedure_Call_Statement (Loc,
-                   Name =>
-                     New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc),
-                   Parameter_Associations => New_List (
-                     New_Occurrence_Of (Cparm, Clc),
-                     Make_Explicit_Dereference (Loc,
-                       Make_Function_Call (Loc,
-                         Name => Make_Explicit_Dereference (Loc,
-                           New_Occurrence_Of
-                             (RTE (RE_Get_Current_Excep), Loc))))));
-
-               Mark_Rewrite_Insertion (Save);
-               Prepend (Save, Statements (Handler));
-
-               Obj_Decl :=
-                 Make_Object_Declaration (Clc,
-                   Defining_Identifier => Cparm,
-                   Object_Definition   =>
-                     New_Occurrence_Of
-                       (RTE (RE_Exception_Occurrence), Clc));
-               Set_No_Initialization (Obj_Decl, True);
-
-               Rewrite (Handler,
-                 Make_Exception_Handler (Loc,
-                   Exception_Choices => Exception_Choices (Handler),
-
-                   Statements => New_List (
-                     Make_Block_Statement (Loc,
-                       Declarations => New_List (Obj_Decl),
-                       Handled_Statement_Sequence =>
-                         Make_Handled_Sequence_Of_Statements (Loc,
-                           Statements => Statements (Handler))))));
-
-               Analyze_List (Statements (Handler), Suppress => All_Checks);
-            end;
-         end if;
+         elsif Restriction_Active (No_Exception_Propagation) then
+            if No (Local_Raise_Statements (Handler))
+              and then Comes_From_Source (Handler)
+              and then Warn_On_Non_Local_Exception
+            then
+               Error_Msg_N
+                 ("?pragma Restrictions (No_Exception_Propagation) in effect",
+                  Handler);
+               Error_Msg_N
+                 ("\?this handler can never be entered, and has been removed",
+                  Handler);
+            end if;
 
-         --  The processing at this point is rather different for the
-         --  JVM case, so we completely separate the processing.
+            Remove (Handler);
 
-         --  For the JVM case, we unconditionally call Update_Exception,
-         --  passing a call to the intrinsic function Current_Target_Exception
-         --  (see JVM version of Ada.Exceptions in 4jexcept.adb for details).
+         --  Exception handler is active and retained and must be processed
 
-         if Hostparm.Java_VM then
-            declare
-               Arg : constant Node_Id :=
-                       Make_Function_Call (Loc,
-                         Name => New_Occurrence_Of
-                                   (RTE (RE_Current_Target_Exception), Loc));
-            begin
-               Prepend_Call_To_Handler (RE_Update_Exception, New_List (Arg));
-            end;
+         else
+            --  If an exception occurrence is present, then we must declare it
+            --  and initialize it from the value stored in the TSD
 
-         --  For the normal case, we have to worry about the state of abort
-         --  deferral. Generally, we defer abort during runtime handling of
-         --  exceptions. When control is passed to the handler, then in the
-         --  normal case we undefer aborts. In any case this entire handling
-         --  is relevant only if aborts are allowed!
+            --     declare
+            --        name : Exception_Occurrence;
+            --     begin
+            --        Save_Occurrence (name, Get_Current_Excep.all)
+            --        ...
+            --     end;
 
-         elsif Abort_Allowed then
+            if Present (Choice_Parameter (Handler)) then
+               declare
+                  Cparm : constant Entity_Id  := Choice_Parameter (Handler);
+                  Clc   : constant Source_Ptr := Sloc (Cparm);
+                  Save  : Node_Id;
 
-            --  There are some special cases in which we do not do the
-            --  undefer. In particular a finalization (AT END) handler
-            --  wants to operate with aborts still deferred.
+               begin
+                  Save :=
+                    Make_Procedure_Call_Statement (Loc,
+                      Name =>
+                        New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc),
+                      Parameter_Associations => New_List (
+                        New_Occurrence_Of (Cparm, Clc),
+                        Make_Explicit_Dereference (Loc,
+                          Make_Function_Call (Loc,
+                            Name => Make_Explicit_Dereference (Loc,
+                              New_Occurrence_Of
+                                (RTE (RE_Get_Current_Excep), Loc))))));
+
+                  Mark_Rewrite_Insertion (Save);
+                  Prepend (Save, Statements (Handler));
+
+                  Obj_Decl :=
+                    Make_Object_Declaration
+                      (Clc,
+                       Defining_Identifier => Cparm,
+                       Object_Definition   =>
+                         New_Occurrence_Of
+                           (RTE (RE_Exception_Occurrence), Clc));
+                  Set_No_Initialization (Obj_Decl, True);
+
+                  Rewrite (Handler,
+                    Make_Implicit_Exception_Handler (Loc,
+                      Exception_Choices => Exception_Choices (Handler),
+
+                      Statements => New_List (
+                        Make_Block_Statement (Loc,
+                          Declarations => New_List (Obj_Decl),
+                          Handled_Statement_Sequence =>
+                            Make_Handled_Sequence_Of_Statements (Loc,
+                              Statements => Statements (Handler))))));
+
+                  Analyze_List (Statements (Handler), Suppress => All_Checks);
+               end;
+            end if;
 
-            --  We also suppress the call if this is the special handler
-            --  for Abort_Signal, since if we are aborting, we want to keep
-            --  aborts deferred (one abort is enough thank you very much :-)
+            --  The processing at this point is rather different for the JVM
+            --  case, so we completely separate the processing.
 
-            --  If abort really needs to be deferred the expander must add
-            --  this call explicitly, see Exp_Ch9.Expand_N_Asynchronous_Select.
+            --  For the JVM case, we unconditionally call Update_Exception,
+            --  passing a call to the intrinsic Current_Target_Exception (see
+            --  JVM version of Ada.Exceptions in 4jexcept.adb for details).
 
-            Others_Choice :=
-              Nkind (First (Exception_Choices (Handler))) = N_Others_Choice;
+            if Hostparm.Java_VM then
+               declare
+                  Arg : constant Node_Id :=
+                          Make_Function_Call (Loc,
+                            Name =>
+                              New_Occurrence_Of
+                                (RTE (RE_Current_Target_Exception), Loc));
+               begin
+                  Prepend_Call_To_Handler
+                    (RE_Update_Exception, New_List (Arg));
+               end;
 
-            if (Others_Choice
-                 or else Entity (First (Exception_Choices (Handler))) /=
-                                                      Stand.Abort_Signal)
-              and then not
-                (Others_Choice
-                   and then All_Others (First (Exception_Choices (Handler))))
-              and then Abort_Allowed
-            then
-               Prepend_Call_To_Handler (RE_Abort_Undefer);
+               --  For the normal case, we have to worry about the state of
+               --  abort deferral. Generally, we defer abort during runtime
+               --  handling of exceptions. When control is passed to the
+               --  handler, then in the normal case we undefer aborts. In any
+               --  case this entire handling is relevant only if aborts are
+               --  allowed!
+
+            elsif Abort_Allowed then
+
+               --  There are some special cases in which we do not do the
+               --  undefer. In particular a finalization (AT END) handler
+               --  wants to operate with aborts still deferred.
+
+               --  We also suppress the call if this is the special handler
+               --  for Abort_Signal, since if we are aborting, we want to keep
+               --  aborts deferred (one abort is enough thank you very much :-)
+
+               --  If abort really needs to be deferred the expander must add
+               --  this call explicitly, see Expand_N_Asynchronous_Select.
+
+               Others_Choice :=
+                 Nkind (First (Exception_Choices (Handler))) = N_Others_Choice;
+
+               if (Others_Choice
+                   or else Entity (First (Exception_Choices (Handler))) /=
+                     Stand.Abort_Signal)
+                 and then not
+                   (Others_Choice
+                    and then All_Others (First (Exception_Choices (Handler))))
+                 and then Abort_Allowed
+               then
+                  Prepend_Call_To_Handler (RE_Abort_Undefer);
+               end if;
             end if;
          end if;
 
-         Next_Non_Pragma (Handler);
-
-      <<Continue_Handler_Loop>>
-         null;
+         Handler := Next_Handler;
       end loop Handler_Loop;
 
-      --  If all handlers got removed by gnatdN, then remove the list
+      --  If all handlers got removed, then remove the list
 
-      if Debug_Flag_Dot_X
-        and then Is_Empty_List (Exception_Handlers (HSS))
-      then
+      if Is_Empty_List (Exception_Handlers (HSS)) then
          Set_Exception_Handlers (HSS, No_List);
       end if;
    end Expand_Exception_Handlers;
@@ -492,21 +1194,19 @@ package body Exp_Ch11 is
       else
          Set_First_Real_Statement (N, First (Statements (N)));
       end if;
-
    end Expand_N_Handled_Sequence_Of_Statements;
 
    -------------------------------------
    -- Expand_N_Raise_Constraint_Error --
    -------------------------------------
 
-   --  The only processing required is to adjust the condition to deal
-   --  with the C/Fortran boolean case. This may well not be necessary,
-   --  as all such conditions are generated by the expander and probably
-   --  are all standard boolean, but who knows what strange optimization
-   --  in future may require this adjustment!
-
    procedure Expand_N_Raise_Constraint_Error (N : Node_Id) is
    begin
+      --  We adjust the condition to deal with the C/Fortran boolean case. This
+      --  may well not be necessary, as all such conditions are generated by
+      --  the expander and probably are all standard boolean, but who knows
+      --  what strange optimization in future may require this adjustment!
+
       Adjust_Condition (Condition (N));
    end Expand_N_Raise_Constraint_Error;
 
@@ -514,14 +1214,13 @@ package body Exp_Ch11 is
    -- Expand_N_Raise_Program_Error --
    ----------------------------------
 
-   --  The only processing required is to adjust the condition to deal
-   --  with the C/Fortran boolean case. This may well not be necessary,
-   --  as all such conditions are generated by the expander and probably
-   --  are all standard boolean, but who knows what strange optimization
-   --  in future may require this adjustment!
-
    procedure Expand_N_Raise_Program_Error (N : Node_Id) is
    begin
+      --  We adjust the condition to deal with the C/Fortran boolean case. This
+      --  may well not be necessary, as all such conditions are generated by
+      --  the expander and probably are all standard boolean, but who knows
+      --  what strange optimization in future may require this adjustment!
+
       Adjust_Condition (Condition (N));
    end Expand_N_Raise_Program_Error;
 
@@ -534,8 +1233,39 @@ package body Exp_Ch11 is
       Ehand : Node_Id;
       E     : Entity_Id;
       Str   : String_Id;
+      H     : Node_Id;
 
    begin
+      --  Debug_Flag_Dot_G := True;
+
+      --  Processing for locally handled exception (exclude reraise case)
+
+      if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
+         if Debug_Flag_Dot_G
+           or else Restriction_Active (No_Exception_Propagation)
+         then
+            --  If we have a local handler, then note that this is potentially
+            --  able to be transformed into a goto statement.
+
+            H := Find_Local_Handler (Entity (Name (N)), N);
+
+            if Present (H) then
+               if Local_Raise_Statements (H) = No_Elist then
+                  Set_Local_Raise_Statements (H, New_Elmt_List);
+               end if;
+
+               --  Append the new entry if it is not there already. Sometimes
+               --  we have situations where due to reexpansion, the same node
+               --  is analyzed twice and would otherwise be added twice.
+
+               Append_Unique_Elmt (N, Local_Raise_Statements (H));
+            end if;
+
+         else
+            Warn_If_No_Propagation (N);
+         end if;
+      end if;
+
       --  If a string expression is present, then the raise statement is
       --  converted to a call:
 
@@ -561,7 +1291,7 @@ package body Exp_Ch11 is
 
       --  There is no expansion needed for statement "raise <exception>;" when
       --  compiling for the JVM since the JVM has a built-in exception
-      --  mechanism. However we need the keep the expansion for "raise;"
+      --  mechanism. However we need to keep the expansion for "raise;"
       --  statements. See 4jexcept.ads for details.
 
       if Present (Name (N)) and then Hostparm.Java_VM then
@@ -769,14 +1499,13 @@ package body Exp_Ch11 is
    -- Expand_N_Raise_Storage_Error --
    ----------------------------------
 
-   --  The only processing required is to adjust the condition to deal
-   --  with the C/Fortran boolean case. This may well not be necessary,
-   --  as all such conditions are generated by the expander and probably
-   --  are all standard boolean, but who knows what strange optimization
-   --  in future may require this adjustment!
-
    procedure Expand_N_Raise_Storage_Error (N : Node_Id) is
    begin
+      --  We adjust the condition to deal with the C/Fortran boolean case. This
+      --  may well not be necessary, as all such conditions are generated by
+      --  the expander and probably are all standard boolean, but who knows
+      --  what strange optimization in future may require this adjustment!
+
       Adjust_Condition (Condition (N));
    end Expand_N_Raise_Storage_Error;
 
@@ -801,6 +1530,149 @@ package body Exp_Ch11 is
       Analyze_And_Resolve (N, RTE (RE_Code_Loc));
    end Expand_N_Subprogram_Info;
 
+   ------------------------
+   -- Find_Local_Handler --
+   ------------------------
+
+   function Find_Local_Handler
+     (Ename : Entity_Id;
+      Nod   : Node_Id) return Node_Id
+   is
+      N : Node_Id;
+      P : Node_Id;
+      H : Node_Id;
+      C : Node_Id;
+
+      ERaise  : Entity_Id;
+      EHandle : Entity_Id;
+      --  The entity Id's for the exception we are raising and handling, using
+      --  the renamed exception if a Renamed_Entity is present.
+
+   begin
+      --  Get the exception we are raising, allowing for renaming
+
+      ERaise := Ename;
+      while Present (Renamed_Entity (ERaise)) loop
+         ERaise := Renamed_Entity (ERaise);
+      end loop;
+
+      --  Loop to search up the tree
+
+      N := Nod;
+      loop
+         P := Parent (N);
+
+         --  If we get to the top of the tree, or to a subprogram, task, entry,
+         --  or protected body without having found a matching handler, then
+         --  there is no local handler.
+
+         if No (P)
+           or else Nkind (P) = N_Subprogram_Body
+           or else Nkind (P) = N_Task_Body
+           or else Nkind (P) = N_Protected_Body
+           or else Nkind (P) = N_Entry_Body
+         then
+            return Empty;
+
+            --  Test for handled sequence of statements, where we are in the
+            --  statement section (the exception handlers of a handled sequence
+            --  of statements do not cover themselves!)
+
+         elsif Nkind (P) = N_Handled_Sequence_Of_Statements
+           and then Is_List_Member (N)
+           and then List_Containing (N) = Statements (P)
+         then
+            --  If we have exception handlers, look at them
+
+            if Present (Exception_Handlers (P)) then
+
+               --  Loop through exception handlers
+
+               H := First (Exception_Handlers (P));
+               while Present (H) loop
+
+                  --  Loop through choices in one handler
+
+                  C := First (Exception_Choices (H));
+                  while Present (C) loop
+
+                     --  Deal with others case
+
+                     if Nkind (C) = N_Others_Choice then
+
+                        --  Matching others handler, but we need to ensure
+                        --  there is no choice parameter. If there is, then we
+                        --  don't have a local handler after all (since we do
+                        --  not allow choice parameters for local handlers).
+
+                        if No (Choice_Parameter (H)) then
+                           return H;
+                        else
+                           return Empty;
+                        end if;
+
+                     --  If not others must be entity name
+
+                     elsif Nkind (C) /= N_Others_Choice then
+                        pragma Assert (Is_Entity_Name (C));
+                        pragma Assert (Present (Entity (C)));
+
+                        --  Get exception being handled, dealing with renaming
+
+                        EHandle := Entity (C);
+                        while Present (Renamed_Entity (EHandle)) loop
+                           EHandle := Renamed_Entity (EHandle);
+                        end loop;
+
+                        --  If match, then check choice parameter
+
+                        if ERaise = EHandle then
+                           if No (Choice_Parameter (H)) then
+                              return H;
+                           else
+                              return Empty;
+                           end if;
+                        end if;
+                     end if;
+
+                     Next (C);
+                  end loop;
+
+                  Next (H);
+               end loop;
+            end if;
+         end if;
+
+         N := P;
+      end loop;
+   end Find_Local_Handler;
+
+   ---------------------------------
+   -- Get_Local_Raise_Call_Entity --
+   ---------------------------------
+
+   function Get_Local_Raise_Call_Entity return Entity_Id is
+   begin
+      if RTE_Available (RE_Local_Raise) then
+         return RTE (RE_Local_Raise);
+      else
+         return Empty;
+      end if;
+   end Get_Local_Raise_Call_Entity;
+
+   -----------------------------
+   -- Get_RT_Exception_Entity --
+   -----------------------------
+
+   function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id is
+   begin
+      case R is
+         when RT_CE_Exceptions => return Standard_Constraint_Error;
+         when RT_PE_Exceptions => return Standard_Program_Error;
+         when RT_SE_Exceptions => return Standard_Storage_Error;
+      end case;
+   end Get_RT_Exception_Entity;
+
    ----------------------
    -- Is_Non_Ada_Error --
    ----------------------
@@ -824,4 +1696,26 @@ package body Exp_Ch11 is
       return True;
    end Is_Non_Ada_Error;
 
+   ----------------------------
+   -- Warn_If_No_Propagation --
+   ----------------------------
+
+   procedure Warn_If_No_Propagation (N : Node_Id) is
+   begin
+      if Restriction_Active (No_Exception_Propagation)
+        and then Warn_On_Non_Local_Exception
+      then
+         Error_Msg_N
+           ("?No_Exception_Propagation restriction is active", N);
+
+         if Configurable_Run_Time_Mode then
+            Error_Msg_N
+              ("?Last_Chance_Handler will be called on exception", N);
+         else
+            Error_Msg_N
+              ("?program may terminate with unhandled exception", N);
+         end if;
+      end if;
+   end Warn_If_No_Propagation;
+
 end Exp_Ch11;
diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads
index 85340d6..354dcff 100644
--- a/gcc/ada/exp_ch11.ads
+++ b/gcc/ada/exp_ch11.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -56,6 +56,19 @@ package Exp_Ch11 is
    --  is also called to expand the special exception handler built for
    --  accept bodies (see Exp_Ch9.Build_Accept_Body).
 
+   function Get_Local_Raise_Call_Entity return Entity_Id;
+   --  This function is provided for use by the back end in conjunction with
+   --  generation of Local_Raise calls when an exception raise is converted to
+   --  a goto statement. If Local_Raise is defined, its entity is returned,
+   --  if not, Empty is returned (in which case the call is silently skipped).
+
+   function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id;
+   --  This function is provided for use by the back end in conjunction with
+   --  generation of Local_Raise calls when an exception raise is converted to
+   --  a goto statement. The argument is the reason code which would be used
+   --  to determine which Rcheck_nn procedure to call. The returned result is
+   --  the exception entity to be passed to Local_Raise.
+
    function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
    --  This function is provided for Gigi use. It returns True if operating on
    --  VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.
diff --git a/gcc/ada/exp_sel.adb b/gcc/ada/exp_sel.adb
index dbb7fb2..d080a32 100644
--- a/gcc/ada/exp_sel.adb
+++ b/gcc/ada/exp_sel.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -63,7 +63,7 @@ package body Exp_Sel is
 
               Exception_Handlers =>
                 New_List (
-                  Make_Exception_Handler (Loc,
+                  Make_Implicit_Exception_Handler (Loc,
                     Exception_Choices =>
                       New_List (
                         New_Reference_To (Stand.Abort_Signal, Loc)),
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 9895362..02f20e6 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -121,12 +121,15 @@ procedure Gnatbind is
 
       --  Define those restrictions that should be output if the gnatbind
       --  -r switch is used. Not all restrictions are output for the reasons
-      --  given above in the list, and this array is used to test whether
+      --  given below in the list, and this array is used to test whether
       --  the corresponding pragma should be listed. True means that it
       --  should not be listed.
 
       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
-        (No_Exceptions            => True,
+        (No_Exception_Propagation => True,
+         --  Modifies code resulting in different exception semantics
+
+         No_Exceptions            => True,
          --  Has unexpected Suppress (All_Checks) effect
 
          No_Implicit_Conditionals => True,
@@ -268,7 +271,7 @@ procedure Gnatbind is
                   "procedure names missing in -L");
             end if;
 
-         --  -Sin -Slo -Shi -Sxx
+         --  -Sin -Slo -Shi -Sxx -Sev
 
          elsif Argv'Length = 4
            and then Argv (2) = 'S'
diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb
index 1dfbfdb..ee8c72e 100644
--- a/gcc/ada/par-ch11.adb
+++ b/gcc/ada/par-ch11.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -94,6 +94,7 @@ package body Ch11 is
 
    begin
       Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
+      Set_Local_Raise_Statements (Handler_Node, No_Elist);
       T_When;
 
       --  Test for possible choice parameter present
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 93fd6f0..c13537d 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -129,22 +129,32 @@ package body Restrict is
                      Get_File_Name (U, Subunit => False);
 
          begin
-            if not Is_Predefined_File_Name (Fnam) then
-               return;
+            --  Get file name
 
-            --  Predefined spec, needs checking against list
+            Get_Name_String (Fnam);
 
-            else
-               --  Pad name to 8 characters with blanks
+            --  Nothing to do if name not at least 5 characters long ending
+            --  in .ads or .adb extension, which we strip.
+
+            if Name_Len < 5
+              or else (Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
+                         and then
+                       Name_Buffer (Name_Len - 4 .. Name_Len) /= ".adb")
+            then
+               return;
+            end if;
 
-               Get_Name_String (Fnam);
-               Name_Len := Name_Len - 4;
+            --  Strip extension and pad to eight characters
 
-               while Name_Len < 8 loop
-                  Name_Len := Name_Len + 1;
-                  Name_Buffer (Name_Len) := ' ';
-               end loop;
+            Name_Len := Name_Len - 4;
+            while Name_Len < 8 loop
+               Name_Len := Name_Len + 1;
+               Name_Buffer (Name_Len) := ' ';
+            end loop;
+
+            --  If predefined unit, check the list of restricted units
 
+            if Is_Predefined_File_Name (Fnam) then
                for J in Unit_Array'Range loop
                   if Name_Len = 8
                     and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
@@ -152,6 +162,15 @@ package body Restrict is
                      Check_Restriction (Unit_Array (J).Res_Id, N);
                   end if;
                end loop;
+
+               --  If not predefied unit, then one special check still remains.
+               --  GNAT.Current_Exception is not allowed if we have restriction
+               --  No_Exception_Propagation active.
+
+            else
+               if Name_Buffer (1 .. 8) = "g-curexc" then
+                  Check_Restriction (No_Exception_Propagation, N);
+               end if;
             end if;
          end;
       end if;
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index b873b18..b88e369 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -74,6 +74,7 @@ package System.Rident is
       No_Entry_Calls_In_Elaboration_Code,      -- GNAT
       No_Entry_Queue,                          -- GNAT (Ravenscar)
       No_Exception_Handlers,                   -- GNAT
+      No_Exception_Propagation,                -- GNAT
       No_Exception_Registration,               -- GNAT
       No_Exceptions,                           -- (RM H.4(12))
       No_Finalization,                         -- GNAT
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 8c5a2a5..7967c36 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -610,6 +610,12 @@ package body Sem is
            N_Mod_Clause                             |
            N_Modular_Type_Definition                |
            N_Ordinary_Fixed_Point_Definition        |
+           N_Pop_Constraint_Error_Label             |
+           N_Pop_Program_Error_Label                |
+           N_Pop_Storage_Error_Label                |
+           N_Push_Constraint_Error_Label            |
+           N_Push_Program_Error_Label               |
+           N_Push_Storage_Error_Label               |
            N_Parameter_Specification                |
            N_Pragma_Argument_Association            |
            N_Procedure_Specification                |
@@ -626,18 +632,24 @@ package body Sem is
 
       Debug_A_Exit ("analyzing  ", N, "  (done)");
 
-      --  Now that we have analyzed the node, we call the expander to
-      --  perform possible expansion. This is done only for nodes that
-      --  are not subexpressions, because in the case of subexpressions,
-      --  we don't have the type yet, and the expander will need to know
-      --  the type before it can do its job. For subexpression nodes, the
-      --  call to the expander happens in the Sem_Res.Resolve.
+      --  Now that we have analyzed the node, we call the expander to perform
+      --  possible expansion. We skip this for subexpressions, because we don't
+      --  have the type yet, and the expander will need to know the type before
+      --  it can do its job. For subexpression nodes, the call to the expander
+      --  happens in Sem_Res.Resolve. A special exception is Raise_xxx_Error,
+      --  which can appear in a statement context, and needs expanding now in
+      --  the case (distinguished by Etype, as documented in Sinfo).
 
       --  The Analyzed flag is also set at this point for non-subexpression
-      --  nodes (in the case of subexpression nodes, we can't set the flag
-      --  yet, since resolution and expansion have not yet been completed)
-
-      if Nkind (N) not in N_Subexpr then
+      --  nodes (in the case of subexpression nodes, we can't set the flag yet,
+      --  since resolution and expansion have not yet been completed). Note
+      --  that for N_Raise_xxx_Error we have to distinguish the expression
+      --  case from the statement case.
+
+      if Nkind (N) not in N_Subexpr
+        or else (Nkind (N) in N_Raise_xxx_Error
+                  and then Etype (N) = Standard_Void_Type)
+      then
          Expand (N);
       end if;
    end Analyze;
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index 75ee081..0f2245e 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -55,16 +55,14 @@ package body Sem_Ch11 is
    procedure Analyze_Exception_Declaration (N : Node_Id) is
       Id : constant Entity_Id := Defining_Identifier (N);
       PF : constant Boolean   := Is_Pure (Current_Scope);
-
    begin
-      Generate_Definition (Id);
-      Enter_Name          (Id);
-      Set_Ekind           (Id, E_Exception);
-      Set_Exception_Code  (Id, Uint_0);
-      Set_Etype           (Id, Standard_Exception_Type);
-
+      Generate_Definition         (Id);
+      Enter_Name                  (Id);
+      Set_Ekind                   (Id, E_Exception);
+      Set_Exception_Code          (Id, Uint_0);
+      Set_Etype                   (Id, Standard_Exception_Type);
       Set_Is_Statically_Allocated (Id);
-      Set_Is_Pure (Id, PF);
+      Set_Is_Pure                 (Id, PF);
    end Analyze_Exception_Declaration;
 
    --------------------------------
@@ -182,28 +180,35 @@ package body Sem_Ch11 is
          --  Otherwise we have a real exception handler
 
          else
-            --  Deal with choice parameter. The exception handler is
-            --  a declarative part for it, so it constitutes a scope
-            --  for visibility purposes. We create an entity to denote
-            --  the whole exception part, and use it as the scope of all
-            --  the choices, which may even have the same name without
-            --  conflict. This scope plays no other role in expansion or
-            --  or code generation.
+            --  Deal with choice parameter. The exception handler is a
+            --  declarative part for the choice parameter, so it constitutes a
+            --  scope for visibility purposes. We create an entity to denote
+            --  the whole exception part, and use it as the scope of all the
+            --  choices, which may even have the same name without conflict.
+            --  This scope plays no other role in expansion or or code
+            --  generation.
 
             Choice := Choice_Parameter (Handler);
 
             if Present (Choice) then
+               Set_Local_Raise_Not_OK (Handler);
+
+               if Comes_From_Source (Choice) then
+                  Check_Restriction (No_Exception_Propagation, Choice);
+               end if;
+
                if No (H_Scope) then
-                  H_Scope := New_Internal_Entity
-                    (E_Block, Current_Scope, Sloc (Choice), 'E');
+                  H_Scope :=
+                    New_Internal_Entity
+                     (E_Block, Current_Scope, Sloc (Choice), 'E');
                end if;
 
                New_Scope (H_Scope);
                Set_Etype (H_Scope, Standard_Void_Type);
 
                --  Set the Finalization Chain entity to Error means that it
-               --  should not be used at that level but the parent one
-               --  should be used instead.
+               --  should not be used at that level but the parent one should
+               --  be used instead.
 
                --  ??? this usage needs documenting in Einfo/Exp_Ch7 ???
                --  ??? using Error for this non-error condition is nasty ???
@@ -215,8 +220,8 @@ package body Sem_Ch11 is
                Set_Etype (Choice, RTE (RE_Exception_Occurrence));
                Generate_Definition (Choice);
 
-               --  Set source assigned flag, since in effect this field
-               --  is always assigned an initial value by the exception.
+               --  Set source assigned flag, since in effect this field is
+               --  always assigned an initial value by the exception.
 
                Set_Never_Set_In_Source (Choice, False);
             end if;
@@ -234,8 +239,20 @@ package body Sem_Ch11 is
                else
                   Analyze (Id);
 
+                  --  In most cases the choice has already been analyzed in
+                  --  Analyze_Handled_Statement_Sequence, in order to expand
+                  --  local handlers. This advance analysis does not take into
+                  --  account the case in which a choice has the same name as
+                  --  the choice parameter of the handler, which may hide an
+                  --  outer exception. This pathological case appears in ACATS
+                  --  B80001_3.adb, and requires an explicit check to verify
+                  --  that the id is not hidden.
+
                   if not Is_Entity_Name (Id)
                     or else Ekind (Entity (Id)) /= E_Exception
+                    or else
+                      (Nkind (Id) = N_Identifier
+                        and then Chars (Id) = Chars (Choice))
                   then
                      Error_Msg_N ("exception name expected", Id);
 
@@ -303,9 +320,9 @@ package body Sem_Ch11 is
                Next (Id);
             end loop;
 
-            --  Check for redundant handler (has only raise statement) and
-            --  is either an others handler, or is a specific handler when
-            --  no others handler is present.
+            --  Check for redundant handler (has only raise statement) and is
+            --  either an others handler, or is a specific handler when no
+            --  others handler is present.
 
             if Warn_On_Redundant_Constructs
               and then List_Length (Statements (Handler)) = 1
@@ -342,20 +359,45 @@ package body Sem_Ch11 is
 
    procedure Analyze_Handled_Statements (N : Node_Id) is
       Handlers : constant List_Id := Exception_Handlers (N);
+      Handler  : Node_Id;
+      Choice   : Node_Id;
 
    begin
       if Present (Handlers) then
          Kill_All_Checks;
       end if;
 
+      --  We are now going to analyze the statements and then the exception
+      --  handlers. We certainly need to do things in this order to get the
+      --  proper sequential semantics for various warnings.
+
+      --  However, there is a glitch. When we process raise statements, an
+      --  optimization is to look for local handlers and specialize the code
+      --  in this case.
+
+      --  In order to detect if a handler is matching, we must have at least
+      --  analyzed the choices in the proper scope so that proper visibility
+      --  analysis is performed. Hence we analyze just the choices first,
+      --  before we analyze the statement sequence.
+
+      Handler := First_Non_Pragma (Handlers);
+      while Present (Handler) loop
+         Choice := First_Non_Pragma (Exception_Choices (Handler));
+         while Present (Choice) loop
+            Analyze (Choice);
+            Next_Non_Pragma (Choice);
+         end loop;
+
+         Next_Non_Pragma (Handler);
+      end loop;
+
       --  Analyze statements in sequence
 
       Analyze_Statements (Statements (N));
 
-      --  If the current scope is a subprogram, and there are no explicit
-      --  exception handlers, then this is the right place to check for
-      --  hanging useless assignments from the statement sequence of the
-      --  subprogram body.
+      --  If the current scope is a subprogram, then this is the right place to
+      --  check for hanging useless assignments from the statement sequence of
+      --  the subprogram body.
 
       if Is_Subprogram (Current_Scope) then
          Warn_On_Useless_Assignments (Current_Scope);
@@ -389,9 +431,9 @@ package body Sem_Ch11 is
          Check_Restriction (No_Exceptions, N);
       end if;
 
-      --  Check for useless assignment to OUT or IN OUT scalar
-      --  immediately preceding the raise. Right now we only look
-      --  at assignment statements, we could do more.
+      --  Check for useless assignment to OUT or IN OUT scalar immediately
+      --  preceding the raise. Right now we only look at assignment statements,
+      --  we could do more.
 
       if Is_List_Member (N) then
          declare
@@ -424,7 +466,6 @@ package body Sem_Ch11 is
       --  Reraise statement
 
       if No (Exception_Id) then
-
          P := Parent (N);
          Nkind_P := Nkind (P);
 
@@ -441,6 +482,14 @@ package body Sem_Ch11 is
          if Nkind (P) /= N_Exception_Handler then
             Error_Msg_N
               ("reraise statement must appear directly in a handler", N);
+
+         --  If a handler has a reraise, it cannot be the target of a local
+         --  raise (goto optimization is impossible), and if the no exception
+         --  propagation restriction is set, this is a violation.
+
+         else
+            Set_Local_Raise_Not_OK (P);
+            Check_Restriction (No_Exception_Propagation, N);
          end if;
 
       --  Normal case with exception id present
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index f7966b1..5433790 100644
--- a/gcc/ada/tbuild.adb
+++ b/gcc/ada/tbuild.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.        --
+--          Copyright (C) 1992-2006, 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- --
@@ -53,25 +53,46 @@ package body Tbuild is
    -- Add_Unique_Serial_Number --
    ------------------------------
 
-   procedure Add_Unique_Serial_Number is
-      Unit_Node : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
+   Config_Serial_Number : Nat := 0;
+   --  Counter for use in config pragmas, see comment below
 
+   procedure Add_Unique_Serial_Number is
    begin
-      Add_Nat_To_Name_Buffer (Increment_Serial_Number);
+      --  If we are analyzing configuration pragmas, Cunit (Main_Unit) will
+      --  not be set yet. This happens for example when analyzing static
+      --  string expressions in configuration pragmas. For this case, we
+      --  just maintain a local counter, defined above and we do not need
+      --  to add a b or s indication in this case.
 
-      --  Add either b or s, depending on whether current unit is a spec
-      --  or a body. This is needed because we may generate the same name
-      --  in a spec and a body otherwise.
+      if No (Cunit (Current_Sem_Unit)) then
+         Config_Serial_Number := Config_Serial_Number + 1;
+         Add_Nat_To_Name_Buffer (Config_Serial_Number);
+         return;
 
-      Name_Len := Name_Len + 1;
+      --  Normal case, within a unit
 
-      if Nkind (Unit_Node) = N_Package_Declaration
-        or else Nkind (Unit_Node) = N_Subprogram_Declaration
-        or else Nkind (Unit_Node) in N_Generic_Declaration
-      then
-         Name_Buffer (Name_Len) := 's';
       else
-         Name_Buffer (Name_Len) := 'b';
+         declare
+            Unit_Node : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
+
+         begin
+            Add_Nat_To_Name_Buffer (Increment_Serial_Number);
+
+            --  Add either b or s, depending on whether current unit is a spec
+            --  or a body. This is needed because we may generate the same name
+            --  in a spec and a body otherwise.
+
+            Name_Len := Name_Len + 1;
+
+            if Nkind (Unit_Node) = N_Package_Declaration
+              or else Nkind (Unit_Node) = N_Subprogram_Declaration
+              or else Nkind (Unit_Node) in N_Generic_Declaration
+            then
+               Name_Buffer (Name_Len) := 's';
+            else
+               Name_Buffer (Name_Len) := 'b';
+            end if;
+         end;
       end if;
    end Add_Unique_Serial_Number;
 
@@ -178,6 +199,24 @@ package body Tbuild is
               New_Reference_To (First_Tag_Component (Full_Type), Loc)));
    end Make_DT_Access;
 
+   -------------------------------------
+   -- Make_Implicit_Exception_Handler --
+   -------------------------------------
+
+   function Make_Implicit_Exception_Handler
+     (Sloc              : Source_Ptr;
+      Choice_Parameter  : Node_Id := Empty;
+      Exception_Choices : List_Id;
+      Statements        : List_Id) return Node_Id
+   is
+      Handler : constant Node_Id :=
+                  Make_Exception_Handler
+                    (Sloc, Choice_Parameter, Exception_Choices, Statements);
+   begin
+      Set_Local_Raise_Statements (Handler, No_Elist);
+      return Handler;
+   end Make_Implicit_Exception_Handler;
+
    --------------------------------
    -- Make_Implicit_If_Statement --
    --------------------------------
diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads
index 4ffedaf..67fe5a1 100644
--- a/gcc/ada/tbuild.ads
+++ b/gcc/ada/tbuild.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -74,6 +74,17 @@ package Tbuild is
    --  Create an access to the Dispatch Table by using the Tag field
    --  of a tagged record : Acc_Dt (Rec.tag).all
 
+   function Make_Implicit_Exception_Handler
+     (Sloc              : Source_Ptr;
+      Choice_Parameter  : Node_Id := Empty;
+      Exception_Choices : List_Id;
+      Statements        : List_Id) return Node_Id;
+   pragma Inline (Make_Implicit_Exception_Handler);
+   --  This is just like Make_Exception_Handler, except that it also sets the
+   --  Local_Raise_Statements field to No_Elist, ensuring that it is properly
+   --  initialized. This should always be used when creating exception handlers
+   --  as part of the expansion.
+
    function Make_Implicit_If_Statement
      (Node            : Node_Id;
       Condition       : Node_Id;