Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             E X P _ C H 1 1                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

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;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Restrict; use Restrict;

with Rident;   use Rident;

with Rtsfind;  use Rtsfind;

with Sem;      use Sem;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Sinfo;    use Sinfo;

with Sinput;   use Sinput;

with Snames;   use Snames;

with Stand;    use Stand;

with Stringt;  use Stringt;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Uintp;    use Uintp;

package body Exp_Ch11 is

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Warn_No_Exception_Propagation_Active (N : Node_Id);

   --  Generates warning that pragma Restrictions (No_Exception_Propagation)

   --  is in effect. Caller then generates appropriate continuation message.

   --  N is the node on which the warning is placed.

   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 --

   ---------------------------

   --  For a handled statement sequence that has a cleanup (At_End_Proc

   --  field set), an exception handler of the following form is required:

   --     exception

   --       when all others =>

   --          cleanup call

   --          raise;

   --  Note: this exception handler is treated rather specially by

   --  subsequent expansion in two respects:

   --    The normal call to Undefer_Abort is omitted

   --    The raise call does not do Defer_Abort

   --  This is because the current tasking code seems to assume that

   --  the call to the cleanup routine that is made from an exception

   --  handler for the abort signal is called with aborts deferred.

   --  This expansion is only done if we have front end exception handling.

   --  If we have back end exception handling, then the AT END handler is

   --  left alone, and cleanups (including the exceptional case) are handled

   --  by the back end.

   --  In the front end case, the exception handler described above handles

   --  the exceptional case. The AT END handler is left in the generated tree

   --  and the code generator (e.g. gigi) must still handle proper generation

   --  of cleanup calls for the non-exceptional case.

   procedure Expand_At_End_Handler (HSS : Node_Id; Block : Node_Id) is

      Clean   : constant Entity_Id  := Entity (At_End_Proc (HSS));

      Ohandle : Node_Id;

      Stmnts  : List_Id;

      Loc : constant Source_Ptr := No_Location;

      --  Location used for expansion. We quite deliberately do not set a

      --  specific source location for the expanded handler. This makes

      --  sense since really the handler is not associated with specific

      --  source. We used to set this to Sloc (Clean), but that caused

      --  useless and annoying bouncing around of line numbers in the

      --  debugger in some circumstances.

   begin

      pragma Assert (Present (Clean));

      pragma Assert (No (Exception_Handlers (HSS)));

      --  Don't expand if back end exception handling active

      if Exception_Mechanism = Back_End_Exceptions then

         return;

      end if;

      --  Don't expand an At End handler if we have already had configurable

      --  run-time violations, since likely this will just be a matter of

      --  generating useless cascaded messages

      if Configurable_Run_Time_Violations > 0 then

         return;

      end if;

      --  Don't expand an At End handler if we are not allowing exceptions

      --  or if exceptions are transformed into local gotos, and never

      --  propagated (No_Exception_Propagation).

      if No_Exception_Handlers_Set then

         return;

      end if;

      if Present (Block) then

         Push_Scope (Block);

      end if;

      Ohandle :=

        Make_Others_Choice (Loc);

      Set_All_Others (Ohandle);

      Stmnts := New_List (

        Make_Procedure_Call_Statement (Loc,

          Name => New_Occurrence_Of (Clean, Loc)));

      --  Generate reraise statement as last statement of AT-END handler,

      --  unless we are under control of No_Exception_Propagation, in which

      --  case no exception propagation is possible anyway, so we do not need

      --  a reraise (the AT END handler in this case is only for normal exits

      --  not for exceptional exits). Also, we flag the Reraise statement as

      --  being part of an AT END handler to prevent signalling this reraise

      --  as a violation of the restriction when it is not set.

      if not Restriction_Active (No_Exception_Propagation) then

         declare

            Rstm : constant Node_Id := Make_Raise_Statement (Loc);

         begin

            Set_From_At_End (Rstm);

            Append_To (Stmnts, Rstm);

         end;

      end if;

      Set_Exception_Handlers (HSS, New_List (

        Make_Implicit_Exception_Handler (Loc,

          Exception_Choices => New_List (Ohandle),

          Statements        => Stmnts)));

      Analyze_List (Stmnts, Suppress => All_Checks);

      Expand_Exception_Handlers (HSS);

      if Present (Block) then

         Pop_Scope;

      end if;

   end Expand_At_End_Handler;

   -------------------------------

   -- Expand_Exception_Handlers --

   -------------------------------

   procedure Expand_Exception_Handlers (HSS : Node_Id) is

      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;

         Args : List_Id := No_List);

      --  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;                        -- marked Exception_Junk

      --     L2 : label;                        -- marked Exception_Junk

      --     L3 : label;                        -- marked Exception_Junk

      --     begin                              -- marked Exception_Junk

      --        ...

      --        local_raise (excep1'address);   -- was raise excep1

      --        goto L1;

      --        ...

      --        local_raise (excep2'address);   -- was raise excep2

      --        goto L2;

      --        ...

      --     exception

      --        when excep1 =>

      --           goto L1;

      --        when excep2 =>

      --           goto L2;

      --     end;

      --     goto L3;        -- skip handler if no raise, marked Exception_Junk

      --     <<L1>>          -- local excep target label, marked Exception_Junk

      --        begin        -- marked Exception_Junk

      --           estmts1

      --        end;

      --        goto L3;     -- marked Exception_Junk

      --     <<L2>>          -- marked Exception_Junk

      --        begin        -- marked Exception_Junk

      --           estmts2

      --        end;

      --        goto L3;     -- marked Exception_Junk

      --     <<L3>>          -- marked Exception_Junk

      --  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.

      --  begin

      --     L1 : label;                        -- marked Exception_Junk

      --     L2 : label;                        -- marked Exception_Junk

      --     L3 : label;                        -- marked Exception_Junk

      --     begin                              -- marked Exception_Junk

      --        ...

      --        local_raise (excep1'address);   -- was raise excep1

      --        goto L1;

      --        ...

      --        local_raise (excep2'address);   -- was raise excep2

      --        goto L2;

      --        ...

      --     end;

      --     goto L3;        -- skip handler if no raise, marked Exception_Junk

      --     <<L1>>          -- local excep target label, marked Exception_Junk

      --        begin        -- marked Exception_Junk

      --           estmts1

      --        end;

      --        goto L3;     -- marked Exception_Junk

      --     <<L2>>          -- marked Exception_Junk

      --        begin        -- marked Exception_Junk

      --           estmts2

      --        end;

      --     <<L3>>          -- marked Exception_Junk

      --  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 N_Raise_xxx_Error nodes are

      --  left unchanged and passed to the back end.

      --  Instead, the front end generates three 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.

      --  These Push/Pop nodes are inhibited if No_Exception_Handlers is set

      --  since they are useless in this case, and in CodePeer mode, where

      --  they serve no purpose and can intefere with the analysis.

      --  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. 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;

      --  Note: the generated labels and goto statements all have the flag

      --  Exception_Junk set True, so that Sem_Ch6.Check_Returns will ignore

      --  this generated exception stuff when checking for missing return

      --  statements (see circuitry in Check_Statement_Sequence).

      --  Note: All of the processing described above occurs only if

      --  restriction No_Exception_Propagation applies or debug flag .g is

      --  enabled.

      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 none, allocate one, set the field in

         --  the handler node, add the label declaration, and set the flag

         --  Local_Expansion_Required. Note: if Local_Raise_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)

              and then not Special_Exception_Package_Used

            then

               Local_Expansion_Required := True;

               declare

                  L : constant Entity_Id := Make_Temporary (Sloc (H), '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 Restriction_Active (No_Exception_Handlers)

              or else CodePeer_Mode

            then

               return;

            end if;

            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

               --  We make sure that a call to Get_Local_Raise_Call_Entity is

               --  made during front end processing, so that when we need it

               --  in the back end, it will already be available and loaded.

               Discard_Node (Get_Local_Raise_Call_Entity);

               --  Prepare and insert Push and Pop nodes

               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 := No_List;

         Choice : Node_Id;

         Excep  : Entity_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.

      --  Start of processing for Expand_Local_Exception_Handlers

      begin

         --  No processing if all exception handlers will get removed

         if Debug_Flag_Dot_X then

            return;

         end if;

         --  See for each handler if we have any 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 sequence for the back end.

            if (Debug_Flag_Dot_G

                 or else Restriction_Active (No_Exception_Propagation))

              and then Has_Local_Raise (Handler)

            then

               Choice := First (Exception_Choices (Handler));

               while Present (Choice) loop

                  if Nkind (Choice) = N_Others_Choice

                    and then not All_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

                     Excep := Get_Renamed_Entity (Entity (Choice));

                     if Excep = Standard_Constraint_Error then

                        Generate_Push_Pop_For_Constraint_Error (Handler);

                     elsif Excep = Standard_Program_Error then

                        Generate_Push_Pop_For_Program_Error    (Handler);

                     elsif Excep = 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 is the label to exit the HSS

            L3_Dent : constant Entity_Id := Make_Temporary (Loc, 'L');

            Labl_L3 : constant Node_Id :=

                        Make_Label (Loc,

                          Identifier => New_Occurrence_Of (L3_Dent, Loc));

            Blk_Stm : Node_Id;

            Relmt   : Elmt_Id;

         begin

            Set_Exception_Junk (Labl_L3);

            Add_Label_Declaration (L3_Dent);

            --  Wrap existing statements and handlers in an inner block

            Blk_Stm :=

              Make_Block_Statement (Loc,

                Handled_Statement_Sequence => Relocate_Node (HSS));

            Set_Exception_Junk (Blk_Stm);

            Rewrite (HSS,

              Make_Handled_Sequence_Of_Statements (Loc,

                Statements => New_List (Blk_Stm),

                End_Label  => Relocate_Node (End_Label (HSS))));

            --  Set block statement as analyzed, we don't want to actually call

            --  Analyze on this block, it would cause a recursion in exception

            --  handler processing which would mess things up.

            Set_Analyzed (Blk_Stm);

            --  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 is the start label for this handler

                     L1_Dent : constant Entity_Id := Exception_Label (Handler);

                     Labl_L1 : constant Node_Id :=

                                 Make_Label (Loc,

                                   Identifier =>

                                     New_Occurrence_Of (L1_Dent, Loc));

                     --  Jump to L1 to be used as replacement for the original

                     --  handler (used in the case where exception propagation

                     --  may still occur).

                     Name_L1 : constant Node_Id :=

                                 New_Occurrence_Of (L1_Dent, Loc);

                     Goto_L1 : constant Node_Id :=

                                 Make_Goto_Statement (Loc,

                                   Name => Name_L1);

                     --  Jump to L3 to be used at the end of handler

                     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

                     Set_Exception_Junk (Labl_L1);

                     Set_Exception_Junk (Goto_L3);

                     --  Note: we do NOT set Exception_Junk in Goto_L1, since

                     --  this is a real transfer of control that we want the

                     --  Sem_Ch6.Check_Returns procedure to recognize properly.

                     --  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. We save

                     --  the last statement location in the goto L1 node for

                     --  the benefit of Sem_Ch6.Check_Returns.

                     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);

                              RLoc    : constant Source_Ptr := Sloc (Raise_S);

                              Name_L1 : constant Node_Id :=

                                          New_Occurrence_Of (L1_Dent, Loc);

                              Goto_L1 : constant Node_Id :=

                                          Make_Goto_Statement (RLoc,

                                            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 a 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 previous 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);

                     declare

                        Loc : constant Source_Ptr := Sloc (First (H_Stmts));

                        Blk : constant Node_Id :=

                                Make_Block_Statement (Loc,

                                  Handled_Statement_Sequence =>