Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P A R . C H 1 1                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2011, 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.      --
--                                                                          --
------------------------------------------------------------------------------
 
pragma Style_Checks (All_Checks);
--  Turn off subprogram body ordering check. Subprograms are in order
--  by RM section rather than alphabetical
 
with Sinfo.CN; use Sinfo.CN;
 
separate (Par)
package body Ch11 is
 
   --  Local functions, used only in this chapter
 
   function P_Exception_Handler  return Node_Id;
   function P_Exception_Choice   return Node_Id;
 
   ---------------------------------
   -- 11.1  Exception Declaration --
   ---------------------------------
 
   --  Parsed by P_Identifier_Declaration (3.3.1)
 
   ------------------------------------------
   -- 11.2  Handled Sequence Of Statements --
   ------------------------------------------
 
   --  HANDLED_SEQUENCE_OF_STATEMENTS ::=
   --      SEQUENCE_OF_STATEMENTS
   --    [exception
   --      EXCEPTION_HANDLER
   --      {EXCEPTION_HANDLER}]
 
   --  Error_Recovery : Cannot raise Error_Resync
 
   function P_Handled_Sequence_Of_Statements return Node_Id is
      Handled_Stmt_Seq_Node  : Node_Id;
      Seq_Is_Hidden_In_SPARK : Boolean;
      Hidden_Region_Start    : Source_Ptr;
 
   begin
      Handled_Stmt_Seq_Node :=
        New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
 
      --  In SPARK, a HIDE directive can be placed at the beginning of a
      --  package initialization, thus hiding the sequence of statements (and
      --  possible exception handlers) from SPARK tool-set. No violation of the
      --  SPARK restriction should be issued on nodes in a hidden part, which
      --  is obtained by marking such hidden parts.
 
      if Token = Tok_SPARK_Hide then
         Seq_Is_Hidden_In_SPARK := True;
         Hidden_Region_Start    := Token_Ptr;
         Scan; -- past HIDE directive
      else
         Seq_Is_Hidden_In_SPARK := False;
      end if;
 
      Set_Statements
        (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
 
      if Token = Tok_Exception then
         Scan; -- past EXCEPTION
         Set_Exception_Handlers
           (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
      end if;
 
      if Seq_Is_Hidden_In_SPARK then
         Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
      end if;
 
      return Handled_Stmt_Seq_Node;
   end P_Handled_Sequence_Of_Statements;
 
   -----------------------------
   -- 11.2  Exception Handler --
   -----------------------------
 
   --  EXCEPTION_HANDLER ::=
   --    when [CHOICE_PARAMETER_SPECIFICATION :]
   --      EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
   --        SEQUENCE_OF_STATEMENTS
 
   --  CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
 
   --  Error recovery: cannot raise Error_Resync
 
   function P_Exception_Handler return Node_Id is
      Scan_State        : Saved_Scan_State;
      Handler_Node      : Node_Id;
      Choice_Param_Node : Node_Id;
 
   begin
      Exception_Handler_Encountered := True;
      Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
      Set_Local_Raise_Statements (Handler_Node, No_Elist);
 
      if Style_Check then
         Style.Check_Indentation;
      end if;
 
      T_When;
 
      --  Test for possible choice parameter present
 
      if Token = Tok_Identifier then
         Choice_Param_Node := Token_Node;
         Save_Scan_State (Scan_State); -- at identifier
         Scan; -- past identifier
 
         if Token = Tok_Colon then
            if Ada_Version = Ada_83 then
               Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
            end if;
 
            Scan; -- past :
            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
 
         elsif Token = Tok_Others then
            Error_Msg_AP -- CODEFIX
              ("missing "":""");
            Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
            Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
 
         else
            Restore_Scan_State (Scan_State); -- to identifier
         end if;
      end if;
 
      --  Loop through exception choices
 
      Set_Exception_Choices (Handler_Node, New_List);
 
      loop
         Append (P_Exception_Choice, Exception_Choices (Handler_Node));
         exit when Token /= Tok_Vertical_Bar;
         Scan; -- past vertical bar
      end loop;
 
      TF_Arrow;
      Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
      return Handler_Node;
   end P_Exception_Handler;
 
   ------------------------------------------
   -- 11.2  Choice Parameter Specification --
   ------------------------------------------
 
   --  Parsed by P_Exception_Handler (11.2)
 
   ----------------------------
   -- 11.2  Exception Choice --
   ----------------------------
 
   --  EXCEPTION_CHOICE ::= exception_NAME | others
 
   --  Error recovery: cannot raise Error_Resync. If an error occurs, then the
   --  scan pointer is advanced to the next arrow or vertical bar or semicolon.
 
   function P_Exception_Choice return Node_Id is
   begin
 
      if Token = Tok_Others then
         Scan; -- past OTHERS
         return New_Node (N_Others_Choice, Prev_Token_Ptr);
 
      else
         return P_Name; -- exception name
      end if;
 
   exception
      when Error_Resync =>
         Resync_Choice;
         return Error;
   end P_Exception_Choice;
 
   ---------------------------
   -- 11.3  Raise Statement --
   ---------------------------
 
   --  RAISE_STATEMENT ::= raise [exception_NAME];
 
   --  The caller has verified that the initial token is RAISE
 
   --  Error recovery: can raise Error_Resync
 
   function P_Raise_Statement return Node_Id is
      Raise_Node : Node_Id;
 
   begin
      Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
      Scan; -- past RAISE
 
      if Token /= Tok_Semicolon then
         Set_Name (Raise_Node, P_Name);
      end if;
 
      if Token = Tok_With then
         if Ada_Version < Ada_2005 then
            Error_Msg_SC ("string expression in raise is Ada 2005 extension");
            Error_Msg_SC ("\unit must be compiled with -gnat05 switch");
         end if;
 
         Scan; -- past WITH
         Set_Expression (Raise_Node, P_Expression);
      end if;
 
      TF_Semicolon;
      return Raise_Node;
   end P_Raise_Statement;
 
   ------------------------------
   -- Parse_Exception_Handlers --
   ------------------------------
 
   --  This routine scans out a list of exception handlers appearing in a
   --  construct as:
 
   --    exception
   --      EXCEPTION_HANDLER {EXCEPTION_HANDLER}
 
   --  The caller has scanned out the EXCEPTION keyword
 
   --  Control returns after scanning the last exception handler, presumably
   --  at the keyword END, but this is not checked in this routine.
 
   --  Error recovery: cannot raise Error_Resync
 
   function Parse_Exception_Handlers return List_Id is
      Handler                    : Node_Id;
      Handlers_List              : List_Id;
      Handler_Is_Hidden_In_SPARK : Boolean;
      Hidden_Region_Start        : Source_Ptr;
 
   begin
      --  In SPARK, a HIDE directive can be placed at the beginning of a
      --  sequence of exception handlers for a subprogram implementation, thus
      --  hiding the exception handlers from SPARK tool-set. No violation of
      --  the SPARK restriction should be issued on nodes in a hidden part,
      --  which is obtained by marking such hidden parts.
 
      if Token = Tok_SPARK_Hide then
         Handler_Is_Hidden_In_SPARK := True;
         Hidden_Region_Start        := Token_Ptr;
         Scan; -- past HIDE directive
      else
         Handler_Is_Hidden_In_SPARK := False;
      end if;
 
      Handlers_List := New_List;
      P_Pragmas_Opt (Handlers_List);
 
      if Token = Tok_End then
         Error_Msg_SC ("must have at least one exception handler!");
 
      else
         loop
            Handler := P_Exception_Handler;
            Append (Handler, Handlers_List);
 
            --  Note: no need to check for pragmas here. Although the
            --  syntax officially allows them in this position, they
            --  will have been swallowed up as part of the statement
            --  sequence of the handler we just scanned out.
 
            exit when Token /= Tok_When;
         end loop;
      end if;
 
      if Handler_Is_Hidden_In_SPARK then
         Set_Hidden_Part_In_SPARK (Hidden_Region_Start, Token_Ptr);
      end if;
 
      return Handlers_List;
   end Parse_Exception_Handlers;
 
end Ch11;