home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / par-ch11.adb < prev    next >
Text File  |  1996-09-28  |  7KB  |  226 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             P A R . C H 1 1                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.16 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Sinfo.CN; use Sinfo.CN;
  26.  
  27. separate (Par)
  28. package body Ch11 is
  29.  
  30.    --  Local functions, used only in this chapter
  31.  
  32.    function P_Exception_Handler  return Node_Id;
  33.    function P_Exception_Choice   return Node_Id;
  34.  
  35.    ---------------------------------
  36.    -- 11.1  Exception Declaration --
  37.    ---------------------------------
  38.  
  39.    --  Parsed by P_Identifier_Declaration (3.3.1)
  40.  
  41.    ------------------------------------------
  42.    -- 11.2  Handled Sequence Of Statements --
  43.    ------------------------------------------
  44.  
  45.    --  HANDLED_SEQUENCE_OF_STATEMENTS ::=
  46.    --      SEQUENCE_OF_STATEMENTS
  47.    --    [exception
  48.    --      EXCEPTION_HANDLER
  49.    --      {EXCEPTION_HANDLER}]
  50.  
  51.    --  Error_Recovery : Cannot raise Error_Resync
  52.  
  53.    function P_Handled_Sequence_Of_Statements return Node_Id is
  54.       Handled_Stmt_Seq_Node : Node_Id;
  55.  
  56.    begin
  57.       Handled_Stmt_Seq_Node :=
  58.         New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
  59.       Set_Statements
  60.         (Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
  61.  
  62.       if Token = Tok_Exception then
  63.          Scan; -- past EXCEPTION
  64.          Set_Exception_Handlers
  65.            (Handled_Stmt_Seq_Node, Parse_Exception_Handlers);
  66.       end if;
  67.  
  68.       return Handled_Stmt_Seq_Node;
  69.    end P_Handled_Sequence_Of_Statements;
  70.  
  71.    -----------------------------
  72.    -- 11.2  Exception Handler --
  73.    -----------------------------
  74.  
  75.    --  EXCEPTION_HANDLER ::=
  76.    --    when [CHOICE_PARAMETER_SPECIFICATION :]
  77.    --      EXCEPTION_CHOICE {| EXCEPTION_CHOICE} =>
  78.    --        SEQUENCE_OF_STATEMENTS
  79.  
  80.    --  CHOICE_PARAMETER_SPECIFICATION ::= DEFINING_IDENTIFIER
  81.  
  82.    --  Error recovery: cannot raise Error_Resync
  83.  
  84.    function P_Exception_Handler return Node_Id is
  85.       Scan_State        : Saved_Scan_State;
  86.       Handler_Node      : Node_Id;
  87.       Choice_Param_Node : Node_Id;
  88.  
  89.    begin
  90.       Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
  91.       T_When;
  92.  
  93.       --  Test for possible choice parameter present
  94.  
  95.       if Token = Tok_Identifier then
  96.          Choice_Param_Node := Token_Node;
  97.          Save_Scan_State (Scan_State); -- at identifier
  98.          Scan; -- past identifier
  99.  
  100.          if Token = Tok_Colon then
  101.             if Ada_83 then
  102.                Error_Msg_SP ("(Ada 83) choice parameter not allowed!");
  103.             end if;
  104.  
  105.             Note_Feature (Exception_Choices, Prev_Token_Ptr);
  106.             Scan; -- past :
  107.             Change_Identifier_To_Defining_Identifier (Choice_Param_Node);
  108.             Set_Choice_Parameter (Handler_Node, Choice_Param_Node);
  109.  
  110.          else
  111.             Restore_Scan_State (Scan_State); -- to identifier
  112.          end if;
  113.       end if;
  114.  
  115.       --  Loop through exception choices
  116.  
  117.       Set_Exception_Choices (Handler_Node, New_List);
  118.  
  119.       loop
  120.          Append (P_Exception_Choice, Exception_Choices (Handler_Node));
  121.          exit when Token /= Tok_Vertical_Bar;
  122.          Scan; -- past vertical bar
  123.       end loop;
  124.  
  125.       TF_Arrow;
  126.       Set_Statements (Handler_Node, P_Sequence_Of_Statements (SS_Sreq_Whtm));
  127.       return Handler_Node;
  128.    end P_Exception_Handler;
  129.  
  130.    ------------------------------------------
  131.    -- 11.2  Choice Parameter Specification --
  132.    ------------------------------------------
  133.  
  134.    --  Parsed by P_Exception_Handler (11.2)
  135.  
  136.    ----------------------------
  137.    -- 11.2  Exception Choice --
  138.    ----------------------------
  139.  
  140.    --  EXCEPTION_CHOICE ::= exception_NAME | others
  141.  
  142.    --  Error recovery: cannot raise Error_Resync. If an error occurs, then the
  143.    --  scan pointer is advanced to the next arrow or vertical bar or semicolon.
  144.  
  145.    function P_Exception_Choice return Node_Id is
  146.    begin
  147.  
  148.       if Token = Tok_Others then
  149.          Scan; -- past OTHERS
  150.          return New_Node (N_Others_Choice, Prev_Token_Ptr);
  151.  
  152.       else
  153.          return P_Name; -- exception name
  154.       end if;
  155.  
  156.    exception
  157.       when Error_Resync =>
  158.          Resync_Choice;
  159.          return Error;
  160.    end P_Exception_Choice;
  161.  
  162.    ---------------------------
  163.    -- 11.3  Raise Statement --
  164.    ---------------------------
  165.  
  166.    --  RAISE_STATEMENT ::= raise [exception_NAME];
  167.  
  168.    --  The caller has verified that the initial token is RAISE
  169.  
  170.    --  Error recovery: can raise Error_Resync
  171.  
  172.    function P_Raise_Statement return Node_Id is
  173.       Raise_Node : Node_Id;
  174.  
  175.    begin
  176.       Raise_Node := New_Node (N_Raise_Statement, Token_Ptr);
  177.       Scan; -- past RAISE
  178.  
  179.       if Token /= Tok_Semicolon then
  180.          Set_Name (Raise_Node, P_Name);
  181.       end if;
  182.  
  183.       TF_Semicolon;
  184.       return Raise_Node;
  185.    end P_Raise_Statement;
  186.  
  187.    ------------------------------
  188.    -- Parse_Exception_Handlers --
  189.    ------------------------------
  190.  
  191.    --  This routine scans out a list of exception handlers appearing in a
  192.    --  construct as:
  193.  
  194.    --    exception
  195.    --      EXCEPTION_HANDLER {EXCEPTION_HANDLER}
  196.  
  197.    --  The caller has scanned out the EXCEPTION keyword
  198.  
  199.    --  Control returns after scanning the last exception handler, presumably
  200.    --  at the keyword END, but this is not checked in this routine.
  201.  
  202.    --  Error recovery: cannot raise Error_Resync
  203.  
  204.    function Parse_Exception_Handlers return List_Id is
  205.       Handlers_List : List_Id;
  206.  
  207.    begin
  208.       Handlers_List := New_List;
  209.       P_Pragmas_Opt (Handlers_List);
  210.  
  211.       if Token = Tok_End then
  212.          Error_Msg_SC ("must have at least one exception handler!");
  213.  
  214.       else
  215.          loop
  216.             Append (P_Exception_Handler, Handlers_List);
  217.             P_Pragmas_Opt (Handlers_List);
  218.             exit when Token /= Tok_When;
  219.          end loop;
  220.       end if;
  221.  
  222.       return Handlers_List;
  223.    end Parse_Exception_Handlers;
  224.  
  225. end Ch11;
  226.