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 / sem_ch9.adb < prev    next >
Text File  |  1996-09-28  |  31KB  |  1,015 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                              S E M _ C H 9                               --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.127 $                            --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 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 Atree;    use Atree;
  26. with Einfo;    use Einfo;
  27. with Errout;   use Errout;
  28. with Exp_Ch7;  use Exp_Ch7;
  29. with Exp_Ch9;
  30. with Elists;   use Elists;
  31. with Features; use Features;
  32. with Nlists;   use Nlists;
  33. with Nmake;    use Nmake;
  34. with Opt;      use Opt;
  35. with Output;   use Output;
  36. with Rtsfind;  use Rtsfind;
  37. with Sem;      use Sem;
  38. with Sem_Ch3;  use Sem_Ch3;
  39. with Sem_Ch4;  use Sem_Ch4;
  40. with Sem_Ch5;  use Sem_Ch5;
  41. with Sem_Ch6;  use Sem_Ch6;
  42. with Sem_Ch8;  use Sem_Ch8;
  43. with Sem_Dist; use Sem_Dist;
  44. with Sem_Res;  use Sem_Res;
  45. with Sem_Type; use Sem_Type;
  46. with Sem_Util; use Sem_Util;
  47. with Stand;    use Stand;
  48. with Sinfo;    use Sinfo;
  49. with Tbuild;   use Tbuild;
  50. with Ttypes;   use Ttypes;
  51. with Uintp;    use Uintp;
  52.  
  53. package body Sem_Ch9 is
  54.  
  55.    -----------------------
  56.    -- Local Subprograms --
  57.    -----------------------
  58.  
  59.    function Find_Concurrent_Spec (Body_Id : Entity_Id) return Entity_Id;
  60.    --  Find entity in corresponding task or protected declaration. Use full
  61.    --  view if first declaration was for an incomplete type.
  62.  
  63.    procedure Install_Declarations (Spec : Entity_Id);
  64.    --  Utility to make visible in corresponding body the entities defined
  65.    --  in task, protected type declaration, or entry declaration.
  66.  
  67.    -----------------------------
  68.    -- Analyze_Abort_Statement --
  69.    -----------------------------
  70.  
  71.    procedure Analyze_Abort_Statement (N : Node_Id) is
  72.       T_Name : Node_Id;
  73.  
  74.    begin
  75.       T_Name := First (Names (N));
  76.       while Present (T_Name) loop
  77.          Analyze (T_Name);
  78.  
  79.          if not Is_Task_Type (Etype (T_Name)) then
  80.             Error_Msg_N ("expect task name for ABORT", T_Name);
  81.             return;
  82.          else
  83.             Resolve (T_Name,  Etype (T_Name));
  84.          end if;
  85.  
  86.          T_Name := Next (T_Name);
  87.       end loop;
  88.    end Analyze_Abort_Statement;
  89.  
  90.    ----------------------------
  91.    -- Analyze_Abortable_Part --
  92.    ----------------------------
  93.  
  94.    procedure Analyze_Abortable_Part (N : Node_Id) is
  95.    begin
  96.       Unimplemented (N, "abortable part");
  97.    end Analyze_Abortable_Part;
  98.  
  99.    ---------------------------------
  100.    -- Analyze_Accept_Alternative  --
  101.    ---------------------------------
  102.  
  103.    procedure Analyze_Accept_Alternative (N : Node_Id) is
  104.    begin
  105.       Analyze (Accept_Statement (N));
  106.  
  107.       if Present (Condition (N)) then
  108.          Analyze (Condition (N));
  109.          Resolve (Condition (N), Any_Boolean);
  110.       end if;
  111.  
  112.       if Is_Non_Empty_List (Statements (N)) then
  113.          Analyze_Statements (Statements (N));
  114.       end if;
  115.    end Analyze_Accept_Alternative;
  116.  
  117.    ------------------------------
  118.    -- Analyze_Accept_Statement --
  119.    ------------------------------
  120.  
  121.    procedure Analyze_Accept_Statement (N : Node_Id) is
  122.       Nam       : constant Entity_Id := Entry_Direct_Name (N);
  123.       Formals   : constant List_Id   := Parameter_Specifications (N);
  124.       Index     : constant Node_Id   := Entry_Index (N);
  125.       Stats     : constant Node_Id   := Handled_Statement_Sequence (N);
  126.       Ityp      : Entity_Id;
  127.       Entry_Nam : Entity_Id;
  128.       E         : Entity_Id;
  129.       Kind      : Entity_Kind;
  130.       Task_Nam  : Entity_Id;
  131.  
  132.    begin
  133.       --  Entry name is initialized to Any_Id. It should get reset to the
  134.       --  matching entry entity. An error is signalled if it is not reset.
  135.  
  136.       Entry_Nam := Any_Id;
  137.  
  138.       for J in reverse 0 .. Scope_Stack.Last loop
  139.          Task_Nam := Scope_Stack.Table (J).Entity;
  140.          exit when Ekind (Etype (Task_Nam)) = E_Task_Type;
  141.          Kind :=  Ekind (Task_Nam);
  142.  
  143.          if Kind /= E_Block and then Kind /= E_Loop
  144.            and then Kind /= E_Entry and then Kind /= E_Entry_Family
  145.          then
  146.             Error_Msg_N ("enclosing body of accept must be a task", N);
  147.             return;
  148.          end if;
  149.       end loop;
  150.  
  151.       if Ekind (Etype (Task_Nam)) /= E_Task_Type then
  152.          Error_Msg_N ("invalid context for accept statement",  N);
  153.          return;
  154.       end if;
  155.  
  156.       --  In order to process the parameters, we create a defining
  157.       --  identifier that can be used as the name of the scope. The
  158.       --  name of the accept statement itself is not a defining identifier.
  159.  
  160.       if Present (Index) then
  161.          Ityp := New_Internal_Entity
  162.            (E_Entry_Family, Current_Scope, Sloc (N), 'E');
  163.       else
  164.          Ityp := New_Internal_Entity
  165.            (E_Entry, Current_Scope, Sloc (N), 'E');
  166.       end if;
  167.  
  168.       Set_Etype          (Ityp, Standard_Void_Type);
  169.       Set_Accept_Address (Ityp, New_Elmt_List);
  170.  
  171.       if Present (Formals) then
  172.          New_Scope (Ityp);
  173.          Process_Formals (Ityp, Formals, N);
  174.          End_Scope;
  175.       end if;
  176.  
  177.       E := First_Entity (Etype (Task_Nam));
  178.  
  179.       while Present (E) loop
  180.          if Chars (E) = Chars (Nam)
  181.            and then (Ekind (E) = Ekind (Ityp))
  182.            and then Type_Conformant (Ityp, E)
  183.          then
  184.             Entry_Nam := E;
  185.             exit;
  186.          end if;
  187.  
  188.          E := Next_Entity (E);
  189.       end loop;
  190.  
  191.       if Entry_Nam = Any_Id then
  192.          Error_Msg_N ("no entry declaration matches accept statement",  N);
  193.          return;
  194.       else
  195.          Set_Entity (Nam, Entry_Nam);
  196.       end if;
  197.  
  198.       Check_Fully_Conformant (Ityp, Entry_Nam, N);
  199.  
  200.       for J in reverse 0 .. Scope_Stack.Last loop
  201.          exit when Task_Nam = Scope_Stack.Table (J).Entity;
  202.  
  203.          if Entry_Nam = Scope_Stack.Table (J).Entity then
  204.             Error_Msg_N ("duplicate accept statement for same entry", N);
  205.          end if;
  206.       end loop;
  207.  
  208.       if Ekind (E) = E_Entry_Family then
  209.          if No (Index) then
  210.             Error_Msg_N ("missing entry index in accept for entry family", N);
  211.          else
  212.             Analyze (Index);
  213.             Resolve (Index, Etype (Discrete_Subtype_Definition (Parent (E))));
  214.          end if;
  215.  
  216.       elsif Present (Index) then
  217.          Error_Msg_N ("invalid entry index in accept for simple entry", N);
  218.       end if;
  219.  
  220.       --  If statements are present, they must be analyzed in the context
  221.       --  of the entry, so that references to formals are correcly resolved.
  222.       --  We also have to add the declarations that are required by the
  223.       --  expansion of the accept statement in this case if expansion active.
  224.  
  225.       --  In the case of a select alternative of a selective accept,
  226.       --  the expander references the address declaration even if there
  227.       --  is no statement list.
  228.  
  229.       Exp_Ch9.Expand_Accept_Declarations (N, Entry_Nam);
  230.  
  231.       if Present (Stats) then
  232.          New_Scope (Entry_Nam);
  233.          Install_Declarations (Entry_Nam);
  234.          Set_Actual_Subtypes (N, Current_Scope);
  235.          Analyze (Stats);
  236.          End_Scope;
  237.       end if;
  238.  
  239.    end Analyze_Accept_Statement;
  240.  
  241.    ---------------------------------
  242.    -- Analyze_Asynchronous_Select --
  243.    ---------------------------------
  244.  
  245.    procedure Analyze_Asynchronous_Select (N : Node_Id) is
  246.    begin
  247.       Analyze (Triggering_Alternative (N));
  248.       Analyze_Statements (Statements (Abortable_Part (N)));
  249.    end Analyze_Asynchronous_Select;
  250.  
  251.    ------------------------------------
  252.    -- Analyze_Conditional_Entry_Call --
  253.    ------------------------------------
  254.  
  255.    procedure Analyze_Conditional_Entry_Call (N : Node_Id) is
  256.    begin
  257.       Analyze (Entry_Call_Alternative (N));
  258.       Analyze_Statements (Else_Statements (N));
  259.    end Analyze_Conditional_Entry_Call;
  260.  
  261.    --------------------------------
  262.    -- Analyze_Delay_Alternative  --
  263.    --------------------------------
  264.  
  265.    procedure Analyze_Delay_Alternative (N : Node_Id) is
  266.    begin
  267.       if Nkind (Parent (N)) = N_Selective_Accept then
  268.          Analyze (Expression (Delay_Statement (N)));
  269.       else
  270.          Analyze (Delay_Statement (N));
  271.       end if;
  272.  
  273.       if Present (Condition (N)) then
  274.          Analyze (Condition (N));
  275.          Resolve (Condition (N), Any_Boolean);
  276.       end if;
  277.  
  278.       if Is_Non_Empty_List (Statements (N)) then
  279.          Analyze_Statements (Statements (N));
  280.       end if;
  281.    end Analyze_Delay_Alternative;
  282.  
  283.    ----------------------------
  284.    -- Analyze_Delay_Relative --
  285.    ----------------------------
  286.  
  287.    procedure Analyze_Delay_Relative (N : Node_Id) is
  288.       E : constant Node_Id := Expression (N);
  289.  
  290.    begin
  291.       Analyze (E);
  292.       Resolve (E,  Standard_Duration);
  293.    end Analyze_Delay_Relative;
  294.  
  295.    -------------------------
  296.    -- Analyze_Delay_Until --
  297.    -------------------------
  298.  
  299.    procedure Analyze_Delay_Until (N : Node_Id) is
  300.       E : constant Node_Id := Expression (N);
  301.  
  302.    begin
  303.       Analyze (E);
  304.  
  305.       if Etype (E) /= Etype (RTE (RO_CA_Time)) and then
  306.          Etype (E) /= Etype (RTE (RO_RT_Time))
  307.       then
  308.          Error_Msg_N ("expect Time types for `delay until`", E);
  309.       end if;
  310.    end Analyze_Delay_Until;
  311.  
  312.    ------------------------
  313.    -- Analyze_Entry_Body --
  314.    ------------------------
  315.  
  316.    procedure Analyze_Entry_Body (N : Node_Id) is
  317.       Id         : constant Entity_Id := Defining_Identifier (N);
  318.       Decls      : constant List_Id   := Declarations (N);
  319.       Stats      : constant Node_Id   := Handled_Statement_Sequence (N);
  320.       Entry_Name : Entity_Id;
  321.       E          : Entity_Id;
  322.  
  323.    begin
  324.       --  Entry_Name is initialized to Any_Id. It should get reset to the
  325.       --  matching entry entity. An error is signalled if it is not reset
  326.  
  327.       Entry_Name := Any_Id;
  328.  
  329.       Analyze (Entry_Body_Formal_Part (N));
  330.  
  331.       if Present (Entry_Index_Specification (Entry_Body_Formal_Part (N))) then
  332.          Set_Ekind (Id, E_Entry_Family);
  333.       else
  334.          Set_Ekind (Id, E_Entry);
  335.       end if;
  336.  
  337.       Set_Etype          (Id, Standard_Void_Type);
  338.       Set_Accept_Address (Id, New_Elmt_List);
  339.  
  340.       E := First_Entity (Current_Scope);
  341.       while Present (E) loop
  342.          if Chars (E) = Chars (Id)
  343.            and then (Ekind (E) = Ekind (Id))
  344.            and then Type_Conformant (Id, E)
  345.          then
  346.             Entry_Name := E;
  347.             Check_Fully_Conformant (Id, E, N);
  348.             exit;
  349.          end if;
  350.  
  351.          E := Next_Entity (E);
  352.       end loop;
  353.  
  354.       if Entry_Name = Any_Id then
  355.          Error_Msg_N ("no entry declaration matches entry body",  N);
  356.          return;
  357.       else
  358.          Set_Has_Completion (Entry_Name);
  359.       end if;
  360.  
  361.       Exp_Ch9.Expand_Entry_Barrier (N);
  362.  
  363.       New_Scope (Entry_Name);
  364.       Set_Actual_Subtypes (N, Current_Scope);
  365.  
  366.       Exp_Ch9.Expand_Entry_Body_Declarations (N);
  367.  
  368.       if Present (Decls) then
  369.          Install_Declarations (Entry_Name);
  370.          Analyze_Declarations (Decls);
  371.       end if;
  372.  
  373.       if Present (Stats) then
  374.          Analyze (Stats);
  375.       end if;
  376.  
  377.       End_Scope;
  378.    end Analyze_Entry_Body;
  379.  
  380.    ------------------------------------
  381.    -- Analyze_Entry_Body_Formal_Part --
  382.    ------------------------------------
  383.  
  384.    procedure Analyze_Entry_Body_Formal_Part (N : Node_Id) is
  385.       Id      : constant Entity_Id := Defining_Identifier (Parent (N));
  386.       Index   : constant Node_Id   := Entry_Index_Specification (N);
  387.       Formals : constant List_Id   := Parameter_Specifications (N);
  388.       Cond    : constant Node_Id   := Condition (N);
  389.  
  390.    begin
  391.       if Present (Cond) then
  392.          Analyze (Cond);
  393.          Resolve (Cond, Any_Boolean);
  394.       end if;
  395.  
  396.       if Present (Index) then
  397.          Analyze (Index);
  398.       end if;
  399.  
  400.       if Present (Formals) then
  401.          Set_Scope (Id, Current_Scope);
  402.          New_Scope (Id);
  403.          Process_Formals (Id, Formals, Parent (N));
  404.          End_Scope;
  405.       end if;
  406.  
  407.    end Analyze_Entry_Body_Formal_Part;
  408.  
  409.    ------------------------------------
  410.    -- Analyze_Entry_Call_Alternative --
  411.    ------------------------------------
  412.  
  413.    procedure Analyze_Entry_Call_Alternative (N : Node_Id) is
  414.    begin
  415.       Analyze (Entry_Call_Statement (N));
  416.  
  417.       if Is_Non_Empty_List (Statements (N)) then
  418.          Analyze_Statements (Statements (N));
  419.       end if;
  420.    end Analyze_Entry_Call_Alternative;
  421.  
  422.    -------------------------------
  423.    -- Analyze_Entry_Declaration --
  424.    -------------------------------
  425.  
  426.    procedure Analyze_Entry_Declaration (N : Node_Id) is
  427.       Id       : Entity_Id := Defining_Identifier (N);
  428.       D_Sdef   : Node_Id   := Discrete_Subtype_Definition (N);
  429.       Formals  : List_Id   := Parameter_Specifications (N);
  430.       Task_Ent : Entity_Id := Current_Scope;
  431.  
  432.    begin
  433.       if No (D_Sdef) then
  434.          Set_Ekind (Id, E_Entry);
  435.       else
  436.          Enter_Name (Id);
  437.          Set_Ekind (Id, E_Entry_Family);
  438.          Analyze (D_Sdef);
  439.          Make_Index (D_Sdef, N, Id);
  440.       end if;
  441.  
  442.       Set_Etype          (Id, Standard_Void_Type);
  443.       Set_Accept_Address (Id, New_Elmt_List);
  444.  
  445.       if Present (Formals) then
  446.          Set_Scope (Id, Current_Scope);
  447.          New_Scope (Id);
  448.          Process_Formals (Id, Formals, N);
  449.          End_Scope;
  450.       end if;
  451.  
  452.       if Ekind (Id) = E_Entry then
  453.          New_Overloaded_Entity (Id);
  454.       end if;
  455.  
  456.    end Analyze_Entry_Declaration;
  457.  
  458.    ---------------------------------------
  459.    -- Analyze_Entry_Index_Specification --
  460.    ---------------------------------------
  461.  
  462.    --  ??? Cargo cult, adapted from for loop iterator analysis.
  463.    --      To make this work, I put N_Entry_Index_Specification
  464.    --      in the N_Has_Itypes set. I am not sure that this
  465.    --      is correct; there is already an Itype associated with
  466.    --      the declaration of the entry family. However,
  467.    --      the N_Entry_Index_Specification node is associated with
  468.    --      then N_Entry_Body node, and it is not at all easy to
  469.    --      get to the corresponding N_Entry_Family node from
  470.    --      here. I am not sure it is worth the effort unless there
  471.    --      is some overriding reason to use the Itype associated
  472.    --      with the N_Entry_Family node.
  473.  
  474.    procedure Analyze_Entry_Index_Specification (N : Node_Id) is
  475.       Iden : constant Node_Id := Defining_Identifier (N);
  476.       Def  : constant Node_Id := Discrete_Subtype_Definition (N);
  477.  
  478.    begin
  479.       Analyze (Def);
  480.       Make_Index (Def, N);
  481.       Enter_Name (Iden);
  482.       Set_Ekind (Iden, E_Entry_Index_Parameter);
  483.       Set_Etype (Iden, Etype (Def));
  484.    end Analyze_Entry_Index_Specification;
  485.  
  486.    ----------------------------
  487.    -- Analyze_Protected_Body --
  488.    ----------------------------
  489.  
  490.    procedure Analyze_Protected_Body (N : Node_Id) is
  491.       Body_Id   : constant Entity_Id := Defining_Identifier (N);
  492.       Spec_Id   : Entity_Id;
  493.  
  494.    begin
  495.       Set_Ekind (Body_Id, E_Protected_Body);
  496.       Spec_Id := Find_Concurrent_Spec (Body_Id);
  497.  
  498.       if No (Spec_Id)
  499.         or else Ekind (Etype (Spec_Id)) /= E_Protected_Type
  500.       then
  501.          Error_Msg_N ("missing specification for protected body", Body_Id);
  502.          return;
  503.       end if;
  504.  
  505.       --  The declarations are always attached to the type
  506.  
  507.       if Ekind (Spec_Id) /= E_Protected_Type then
  508.          Spec_Id := Etype (Spec_Id);
  509.       end if;
  510.  
  511.       New_Scope (Spec_Id);
  512.       Set_Corresponding_Spec (N, Spec_Id);
  513.       Set_Corresponding_Body (Parent (Spec_Id), Body_Id);
  514.       Set_Has_Completion (Spec_Id);
  515.       Install_Declarations (Spec_Id);
  516.  
  517.       Exp_Ch9.Expand_Protected_Body_Declarations (N, Spec_Id);
  518.  
  519.       Analyze_Declarations (Declarations (N));
  520.       Check_Completion (Body_Id);
  521.       End_Scope;
  522.    end Analyze_Protected_Body;
  523.  
  524.    ----------------------------------
  525.    -- Analyze_Protected_Definition --
  526.    ----------------------------------
  527.  
  528.    procedure Analyze_Protected_Definition (N : Node_Id) is
  529.       L : Entity_Id;
  530.  
  531.    begin
  532.       Analyze_Declarations (Visible_Declarations (N));
  533.  
  534.       if Present (Private_Declarations (N))
  535.         and then not Is_Empty_List (Private_Declarations (N))
  536.       then
  537.          L := Last_Entity (Current_Scope);
  538.          Analyze_Declarations (Private_Declarations (N));
  539.          Set_First_Private_Entity (Current_Scope,  Next_Entity (L));
  540.       end if;
  541.    end Analyze_Protected_Definition;
  542.  
  543.    ----------------------------
  544.    -- Analyze_Protected_Type --
  545.    ----------------------------
  546.  
  547.    procedure Analyze_Protected_Type (N : Node_Id) is
  548.       E : Entity_Id;
  549.       T : Entity_Id;
  550.  
  551.    begin
  552.       T := Find_Type_Name (N);
  553.       Set_Ekind              (T, E_Protected_Type);
  554.       Set_Etype              (T, T);
  555.       Set_Has_Controlled     (T, Is_Controlled (RTE (RE_Protection)));
  556.       Set_Is_First_Subtype   (T, True);
  557.       Set_Has_Delayed_Freeze (T, True);
  558.       New_Scope (T);
  559.  
  560.       --  RCI unit (user source) specification cannot have limited
  561.       --  type declaration (RM E.2.3(10))
  562.  
  563.       if Comes_From_Source (T) then
  564.          Validate_RCI_Limited_Type_Declaration (N);
  565.       end if;
  566.  
  567.       if Present (Discriminant_Specifications (N)) then
  568.          Process_Discriminants (N);
  569.       end if;
  570.  
  571.       Analyze (Protected_Definition (N));
  572.  
  573.       --  The Ekind of components is E_Void during analysis to detect
  574.       --  illegal uses. Now it can be set correctly.
  575.  
  576.       E := First_Entity (Current_Scope);
  577.  
  578.       while Present (E) loop
  579.          if Ekind (E) = E_Void then
  580.             Set_Ekind (E, E_Component);
  581.          end if;
  582.  
  583.          E := Next_Entity (E);
  584.       end loop;
  585.  
  586.       End_Scope;
  587.    end Analyze_Protected_Type;
  588.  
  589.    ---------------------
  590.    -- Analyze_Requeue --
  591.    ---------------------
  592.  
  593.    procedure Analyze_Requeue (N : Node_Id) is
  594.       Entry_Name : Node_Id := Name (N);
  595.       Entry_Id   : Entity_Id;
  596.       Found      : Boolean;
  597.       I          : Interp_Index;
  598.       It         : Interp;
  599.       Enclosing  : Entity_Id;
  600.  
  601.    begin
  602.       Enclosing := Current_Scope;
  603.       loop
  604.          if Ekind (Enclosing) = E_Entry
  605.             or else Ekind (Enclosing) = E_Entry_Family
  606.          then
  607.             exit;
  608.  
  609.          elsif Ekind (Enclosing) = E_Loop
  610.            or else Ekind (Enclosing) = E_Block
  611.          then
  612.             Enclosing := Scope (Enclosing);
  613.  
  614.          else
  615.             Error_Msg_N ("requeue must appear within accept or entry body", N);
  616.             return;
  617.          end if;
  618.       end loop;
  619.  
  620.       Analyze (Entry_Name);
  621.  
  622.       if Etype (Entry_Name) = Any_Type then
  623.          return;
  624.       end if;
  625.  
  626.       if Nkind (Entry_Name) = N_Selected_Component then
  627.          Entry_Name := Selector_Name (Entry_Name);
  628.       end if;
  629.  
  630.       --  Overloaded case, find right interpretation
  631.  
  632.       if Is_Overloaded (Entry_Name) then
  633.          Get_First_Interp (Entry_Name, I, It);
  634.          Found := False;
  635.  
  636.          while Present (It.Nam) loop
  637.  
  638.             if No (First_Formal (It.Nam))
  639.               or else Subtype_Conformant (Enclosing, It.Nam)
  640.             then
  641.                if not Found then
  642.                   Found := True;
  643.                   Entry_Id := It.Nam;
  644.                else
  645.                   Error_Msg_N ("ambiguous entry name in requeue", N);
  646.                   return;
  647.                end if;
  648.             end if;
  649.  
  650.             Get_Next_Interp (I, It);
  651.          end loop;
  652.  
  653.          if not Found then
  654.             Error_Msg_N ("no entry matches context",  N);
  655.             return;
  656.          else
  657.             Set_Entity (Entry_Name, Entry_Id);
  658.          end if;
  659.  
  660.       --  Non-overloaded cases
  661.  
  662.       --  For the case of a reference to an element of an entry family,
  663.       --  the Entry_Name is an indexed component.
  664.  
  665.       elsif Nkind (Entry_Name) = N_Indexed_Component then
  666.  
  667.          --  Requeue to an entry out of the body
  668.  
  669.          if Nkind (Prefix (Entry_Name)) = N_Selected_Component then
  670.             Entry_Id := Entity (Selector_Name (Prefix (Entry_Name)));
  671.  
  672.          --  Requeue from within the body itself
  673.  
  674.          elsif Nkind (Prefix (Entry_Name)) = N_Identifier then
  675.             Entry_Id := Entity (Prefix (Entry_Name));
  676.  
  677.          else
  678.             Error_Msg_N ("invalid entry_name specified",  N);
  679.             return;
  680.          end if;
  681.  
  682.       else
  683.          Entry_Id := Entity (Entry_Name);
  684.       end if;
  685.  
  686.       --  Resolve entry, and check that it is subtype conformant with the
  687.       --  enclosing construct if this construct has formals (RM 9.5.4(5)).
  688.  
  689.       Resolve_Entry (Name (N));
  690.  
  691.       if Present (First_Formal (Entry_Id)) then
  692.          Check_Subtype_Conformant (Enclosing, Entry_Id, Name (N));
  693.       end if;
  694.  
  695.    end Analyze_Requeue;
  696.  
  697.    ------------------------------
  698.    -- Analyze_Selective_Accept --
  699.    ------------------------------
  700.  
  701.    procedure Analyze_Selective_Accept (N : Node_Id) is
  702.       Alts : constant List_Id := Select_Alternatives (N);
  703.       Alt  : Node_Id;
  704.       Accept_Present    : Boolean := False;
  705.       Terminate_Present : Boolean := False;
  706.       Delay_Present     : Boolean := False;
  707.  
  708.    begin
  709.       Alt := First (Alts);
  710.       while Present (Alt) loop
  711.          Analyze (Alt);
  712.  
  713.          if Nkind (Alt) = N_Delay_Alternative then
  714.             Delay_Present := True;
  715.  
  716.          elsif Nkind (Alt) = N_Terminate_Alternative then
  717.             if Terminate_Present then
  718.                Error_Msg_N ("Only one terminate alternative allowed", N);
  719.             else
  720.                Terminate_Present := True;
  721.             end if;
  722.  
  723.          else
  724.             Accept_Present := True;
  725.          end if;
  726.  
  727.          Alt := Next (Alt);
  728.       end loop;
  729.  
  730.       if Terminate_Present and Delay_Present then
  731.          Error_Msg_N ("at most one of terminate or delay alternative", N);
  732.  
  733.       elsif not Accept_Present then
  734.          Error_Msg_N
  735.            ("select must contain at least one accept alternative", N);
  736.       end if;
  737.  
  738.       if Present (Else_Statements (N)) then
  739.          if Terminate_Present or Delay_Present then
  740.             Error_Msg_N ("else part not allowed with other alternatives", N);
  741.          end if;
  742.  
  743.          Analyze_Statements (Else_Statements (N));
  744.       end if;
  745.    end Analyze_Selective_Accept;
  746.  
  747.    ------------------------------
  748.    -- Analyze_Single_Protected --
  749.    ------------------------------
  750.  
  751.    procedure Analyze_Single_Protected (N : Node_Id) is
  752.       Loc    : constant Source_Ptr := Sloc (N);
  753.       Id     : constant Node_Id    := Defining_Identifier (N);
  754.       T      : Entity_Id;
  755.       T_Decl : Node_Id;
  756.       O_Decl : Node_Id;
  757.  
  758.    begin
  759.       --  The node is rewritten as a protected type declaration,
  760.       --  in exact analogy with what is done with single tasks.
  761.  
  762.       T :=
  763.         Make_Defining_Identifier (Loc,
  764.           New_External_Name (Chars (Id), 'T'));
  765.  
  766.       T_Decl :=
  767.         Make_Protected_Type_Declaration (Loc,
  768.          Defining_Identifier => T,
  769.          Protected_Definition => Relocate_Node (Protected_Definition (N)));
  770.  
  771.       O_Decl :=
  772.         Make_Object_Declaration (Loc,
  773.           Defining_Identifier => New_Copy (Id),
  774.           Object_Definition => Make_Identifier (Loc,  Chars (T)));
  775.  
  776.       Rewrite_Substitute_Tree (N, T_Decl);
  777.       Insert_After (N, O_Decl);
  778.       Mark_Rewrite_Insertion (O_Decl);
  779.  
  780.       --  Instead of calling Analyze on the new node,  call directly
  781.       --  the proper analysis procedure. Otherwise the node would be
  782.       --  expanded twice, with disastrous result.
  783.  
  784.       Analyze_Protected_Type (N);
  785.  
  786.    end Analyze_Single_Protected;
  787.  
  788.    -------------------------
  789.    -- Analyze_Single_Task --
  790.    -------------------------
  791.  
  792.    procedure Analyze_Single_Task (N : Node_Id) is
  793.       Id     : constant Node_Id := Defining_Identifier (N);
  794.       Loc    : constant Source_Ptr := Sloc (N);
  795.       T      : Entity_Id;
  796.       T_Decl : Node_Id;
  797.       O_Decl : Node_Id;
  798.  
  799.    begin
  800.       --  The node is rewritten as a task type declaration,  followed
  801.       --  by an object declaration of that anonymous task type.
  802.  
  803.       T :=
  804.         Make_Defining_Identifier (Loc,
  805.           New_External_Name (Chars (Id), 'T'));
  806.  
  807.       T_Decl :=
  808.         Make_Task_Type_Declaration (Loc,
  809.           Defining_Identifier => T,
  810.           Task_Definition     => Relocate_Node (Task_Definition (N)));
  811.  
  812.       O_Decl :=
  813.         Make_Object_Declaration (Loc,
  814.           Defining_Identifier => New_Copy (Id),
  815.           Object_Definition   => Make_Identifier (Loc, Chars (T)));
  816.  
  817.       Rewrite_Substitute_Tree (N, T_Decl);
  818.       Insert_After (N, O_Decl);
  819.       Mark_Rewrite_Insertion (O_Decl);
  820.  
  821.       --  Instead of calling Analyze on the new node,  call directly
  822.       --  the proper analysis procedure. Otherwise the node would be
  823.       --  expanded twice, with disastrous result.
  824.  
  825.       Analyze_Task_Type (N);
  826.  
  827.    end Analyze_Single_Task;
  828.  
  829.    -----------------------
  830.    -- Analyze_Task_Body --
  831.    -----------------------
  832.  
  833.    procedure Analyze_Task_Body (N : Node_Id) is
  834.       Body_Id : constant Entity_Id := Defining_Identifier (N);
  835.       Spec_Id : Entity_Id;
  836.  
  837.    begin
  838.       Set_Ekind (Body_Id, E_Task_Body);
  839.       Spec_Id := Find_Concurrent_Spec (Body_Id);
  840.  
  841.       if No (Spec_Id)
  842.         or else Ekind (Etype (Spec_Id)) /= E_Task_Type
  843.       then
  844.          Error_Msg_N ("missing specification for task body", Body_Id);
  845.          return;
  846.       end if;
  847.  
  848.       --  Deal with case of body of single task (anonymous type was created)
  849.  
  850.       if Ekind (Spec_Id) = E_Variable then
  851.          Spec_Id := Etype (Spec_Id);
  852.       end if;
  853.  
  854.       New_Scope (Spec_Id);
  855.       Set_Corresponding_Spec (N, Spec_Id);
  856.       Set_Corresponding_Body (Parent (Spec_Id), Body_Id);
  857.       Set_Has_Completion (Spec_Id);
  858.       Install_Declarations (Spec_Id);
  859.  
  860.       Analyze_Declarations (Declarations (N));
  861.  
  862.       Analyze (Handled_Statement_Sequence (N));
  863.       Check_Completion (Body_Id);
  864.       End_Scope;
  865.    end Analyze_Task_Body;
  866.  
  867.    -----------------------------
  868.    -- Analyze_Task_Definition --
  869.    -----------------------------
  870.  
  871.    procedure Analyze_Task_Definition (N : Node_Id) is
  872.       L       : Entity_Id;
  873.       E_Index : Uint;
  874.  
  875.    begin
  876.       if Present (Visible_Declarations (N)) then
  877.          Analyze_Declarations (Visible_Declarations (N));
  878.       end if;
  879.  
  880.       if Present (Private_Declarations (N)) then
  881.          L := Last_Entity (Current_Scope);
  882.          Analyze_Declarations (Private_Declarations (N));
  883.  
  884.          if Present (L) then
  885.             Set_First_Private_Entity
  886.               (Current_Scope, Next_Entity (L));
  887.          else
  888.             Set_First_Private_Entity
  889.               (Current_Scope, First_Entity (Current_Scope));
  890.          end if;
  891.       end if;
  892.  
  893.    end Analyze_Task_Definition;
  894.  
  895.    -----------------------
  896.    -- Analyze_Task_Type --
  897.    -----------------------
  898.  
  899.    procedure Analyze_Task_Type (N : Node_Id) is
  900.       T : Entity_Id;
  901.  
  902.    begin
  903.       T := Find_Type_Name (N);
  904.  
  905.       Set_Ekind              (T, E_Task_Type);
  906.       Set_Is_First_Subtype   (T, True);
  907.       Set_Has_Tasks          (T, True);
  908.       Set_Esize              (T, UI_From_Int (System_Address_Size));
  909.       Set_Etype              (T, T);
  910.       Set_Has_Delayed_Freeze (T, True);
  911.  
  912.       New_Scope (T);
  913.  
  914.       --  RCI unit (user source) specification cannot have limited type
  915.       --  declaration. (RM E.2.3(10)).
  916.  
  917.       if Comes_From_Source (T) then
  918.          Validate_RCI_Limited_Type_Declaration (N);
  919.       end if;
  920.  
  921.       if Present (Discriminant_Specifications (N)) then
  922.          Note_Feature (Task_Discriminants, Sloc (N));
  923.  
  924.          if Ada_83 and then Comes_From_Source (N) then
  925.             Error_Msg_N ("(Ada 83) task discriminant not allowed!", N);
  926.          end if;
  927.  
  928.          Process_Discriminants (N);
  929.       end if;
  930.  
  931.       if Present (Task_Definition (N)) then
  932.          Analyze_Task_Definition (Task_Definition (N));
  933.       end if;
  934.  
  935.       End_Scope;
  936.    end Analyze_Task_Type;
  937.  
  938.    -----------------------------------
  939.    -- Analyze_Terminate_Alternative --
  940.    -----------------------------------
  941.  
  942.    procedure Analyze_Terminate_Alternative (N : Node_Id) is
  943.    begin
  944.       if Present (Condition (N)) then
  945.          Analyze (Condition (N));
  946.          Resolve (Condition (N), Any_Boolean);
  947.       end if;
  948.  
  949.    end Analyze_Terminate_Alternative;
  950.  
  951.    ------------------------------
  952.    -- Analyze_Timed_Entry_Call --
  953.    ------------------------------
  954.  
  955.    procedure Analyze_Timed_Entry_Call (N : Node_Id) is
  956.    begin
  957.       Analyze (Entry_Call_Alternative (N));
  958.       Analyze (Delay_Alternative (N));
  959.    end Analyze_Timed_Entry_Call;
  960.  
  961.    ------------------------------------
  962.    -- Analyze_Triggering_Alternative --
  963.    ------------------------------------
  964.  
  965.    procedure Analyze_Triggering_Alternative (N : Node_Id) is
  966.    begin
  967.       Analyze (Triggering_Statement (N));
  968.  
  969.       if Is_Non_Empty_List (Statements (N)) then
  970.          Analyze_Statements (Statements (N));
  971.       end if;
  972.    end Analyze_Triggering_Alternative;
  973.  
  974.    --------------------------
  975.    -- Find_Concurrent_Spec --
  976.    --------------------------
  977.  
  978.    function Find_Concurrent_Spec (Body_Id : Entity_Id) return Entity_Id is
  979.       Spec_Id : Entity_Id := Current_Entity_In_Scope (Body_Id);
  980.  
  981.    begin
  982.       --  The type may have been given by an incomplete type declaration.
  983.       --  Find full view now.
  984.  
  985.       if Present (Spec_Id) and then Ekind (Spec_Id) = E_Incomplete_Type then
  986.          Spec_Id := Full_View (Spec_Id);
  987.       end if;
  988.  
  989.       return Spec_Id;
  990.    end Find_Concurrent_Spec;
  991.  
  992.    --------------------------
  993.    -- Install_Declarations --
  994.    --------------------------
  995.  
  996.    procedure Install_Declarations (Spec : Entity_Id) is
  997.       E    : Entity_Id;
  998.       Prev : Entity_Id;
  999.  
  1000.    begin
  1001.       E := First_Entity (Spec);
  1002.  
  1003.       while Present (E) loop
  1004.          Prev := Current_Entity (E);
  1005.          Set_Current_Entity (E);
  1006.          Set_Is_Immediately_Visible (E);
  1007.          Set_Homonym (E, Prev);
  1008.          E := Next_Entity (E);
  1009.       end loop;
  1010.    end Install_Declarations;
  1011.  
  1012. begin
  1013.    null;
  1014. end Sem_Ch9;
  1015.