diff options
author | Richard Kenner <kenner@gcc.gnu.org> | 2001-10-02 10:23:52 -0400 |
---|---|---|
committer | Richard Kenner <kenner@gcc.gnu.org> | 2001-10-02 10:23:52 -0400 |
commit | 19235870adf79a3422aed017819c537f1d1375ac (patch) | |
tree | 0509e847916fc00cfe5c311617e039600afa9622 /gcc/ada/par-ch11.adb | |
parent | 38cbfe40a046b12a3d9bc56e6cf76d86c458ef39 (diff) | |
download | gcc-19235870adf79a3422aed017819c537f1d1375ac.zip gcc-19235870adf79a3422aed017819c537f1d1375ac.tar.gz gcc-19235870adf79a3422aed017819c537f1d1375ac.tar.bz2 |
New Language: Ada
From-SVN: r45956
Diffstat (limited to 'gcc/ada/par-ch11.adb')
-rw-r--r-- | gcc/ada/par-ch11.adb | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb new file mode 100644 index 0000000..8b59c54 --- /dev/null +++ b/gcc/ada/par-ch11.adb @@ -0,0 +1,246 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P A R . C H 1 1 -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.22 $ +-- -- +-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +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; + + begin + Handled_Stmt_Seq_Node := + New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr); + 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; + + 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 + Handler_Node := New_Node (N_Exception_Handler, Token_Ptr); + 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_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 ("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; + + 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; + Pragmas_List : List_Id; + + begin + 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; + Pragmas_List := No_List; + 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; + + return Handlers_List; + end Parse_Exception_Handlers; + +end Ch11; |