[multiple changes]

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* ada.ads, a-unccon.ads: Add pragma No_Elaboration_Code_All.

2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_case.adb: Minor reformatting.

2017-01-06  Thomas Quinot  <quinot@adacore.com>

	* g-socthi-mingw.adb: Remove now extraneous USE TYPE clause

2017-01-06  Justin Squirek  <squirek@adacore.com>

	* aspects.adb: Register aspect in Canonical_Aspect.
	* aspects.ads: Associate qualities of Aspect_Max_Queue_Length
	into respective tables.
	* einfo.ads, einfo.adb: Add a new attribute for
	handling the parameters for Pragma_Max_Entry_Queue
	(Entry_Max_Queue_Lengths_Array) in E_Protected_Type. Subprograms
	for accessing and setting were added as well.
	* par-prag.adb (Prag): Register Pramga_Max_Entry_Queue.
	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Emit
	declaration for pramga arguments and store them in the protected
	type node.
	(Make_Initialize_Protection): Pass a reference to
	the Entry_Max_Queue_Lengths_Array in the protected type node to
	the runtime.
	* rtsfind.adb: Minor grammar fix.
	* rtsfind.ads: Register new types taken from the
	runtime libraries RE_Protected_Entry_Queue_Max and
	RE_Protected_Entry_Queue_Max_Array
	* s-tposen.adb, s-tpoben.adb
	(Initialize_Protection_Entry/Initialize_Protection_Entries):
	Add extra parameter and add assignment to local object.
	* s-tposen.ads, s-tpoben.ads: Add new types to
	store entry queue maximums and a field to the entry object record.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Add case statement
	for Aspect_Max_Queue_Length.
	(Check_Aspect_At_Freeze_Point):
	Add aspect to list of aspects that don't require delayed analysis.
	* sem_prag.adb (Analyze_Pragma): Add case statement for
	Pragma_Max_Queue_Length, check semantics, and register arugments
	in the respective entry nodes.
	* sem_util.adb, sem_util.ads Add functions Get_Max_Queue_Length
	and Has_Max_Queue_Length
	* snames.ads-tmpl: Add constant for the new aspect-name
	Name_Max_Queue_Length and corrasponding pragma.

2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Is_Controlled_Function_Call):
	Reimplemented. Consider any node which has an entity as the
	function call may appear in various ways.

From-SVN: r244126

gcc/ada/ChangeLog

@@ -1,3 +1,58 @@
+2017-01-06  Tristan Gingold  <gingold@adacore.com>
+
+	* ada.ads, a-unccon.ads: Add pragma No_Elaboration_Code_All.
+
+2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_case.adb: Minor reformatting.
+
+2017-01-06  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socthi-mingw.adb: Remove now extraneous USE TYPE clause
+
+2017-01-06  Justin Squirek  <squirek@adacore.com>
+
+	* aspects.adb: Register aspect in Canonical_Aspect.
+	* aspects.ads: Associate qualities of Aspect_Max_Queue_Length
+	into respective tables.
+	* einfo.ads, einfo.adb: Add a new attribute for
+	handling the parameters for Pragma_Max_Entry_Queue
+	(Entry_Max_Queue_Lengths_Array) in E_Protected_Type. Subprograms
+	for accessing and setting were added as well.
+	* par-prag.adb (Prag): Register Pramga_Max_Entry_Queue.
+	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Emit
+	declaration for pramga arguments and store them in the protected
+	type node.
+	(Make_Initialize_Protection): Pass a reference to
+	the Entry_Max_Queue_Lengths_Array in the protected type node to
+	the runtime.
+	* rtsfind.adb: Minor grammar fix.
+	* rtsfind.ads: Register new types taken from the
+	runtime libraries RE_Protected_Entry_Queue_Max and
+	RE_Protected_Entry_Queue_Max_Array
+	* s-tposen.adb, s-tpoben.adb
+	(Initialize_Protection_Entry/Initialize_Protection_Entries):
+	Add extra parameter and add assignment to local object.
+	* s-tposen.ads, s-tpoben.ads: Add new types to
+	store entry queue maximums and a field to the entry object record.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Add case statement
+	for Aspect_Max_Queue_Length.
+	(Check_Aspect_At_Freeze_Point):
+	Add aspect to list of aspects that don't require delayed analysis.
+	* sem_prag.adb (Analyze_Pragma): Add case statement for
+	Pragma_Max_Queue_Length, check semantics, and register arugments
+	in the respective entry nodes.
+	* sem_util.adb, sem_util.ads Add functions Get_Max_Queue_Length
+	and Has_Max_Queue_Length
+	* snames.ads-tmpl: Add constant for the new aspect-name
+	Name_Max_Queue_Length and corrasponding pragma.
+
+2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb (Is_Controlled_Function_Call):
+	Reimplemented. Consider any node which has an entity as the
+	function call may appear in various ways.
+
 2017-01-06  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_attr.adb (Rewrite_Stream_Proc_Call): Use

gcc/ada/a-unccon.ads

@@ -19,5 +19,6 @@ generic
 
 function Ada.Unchecked_Conversion (S : Source) return Target;
 
+pragma No_Elaboration_Code_All (Unchecked_Conversion);
 pragma Pure (Unchecked_Conversion);
 pragma Import (Intrinsic, Unchecked_Conversion);

gcc/ada/ada.ads

@@ -14,6 +14,7 @@
 ------------------------------------------------------------------------------
 
 package Ada is
+   pragma No_Elaboration_Code_All;
    pragma Pure;
 
 end Ada;

gcc/ada/aspects.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-2016, 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- --
@@ -568,6 +568,7 @@ package body Aspects is
     Aspect_Linker_Section               => Aspect_Linker_Section,
     Aspect_Lock_Free                    => Aspect_Lock_Free,
     Aspect_Machine_Radix                => Aspect_Machine_Radix,
+    Aspect_Max_Queue_Length             => Aspect_Max_Queue_Length,
     Aspect_No_Elaboration_Code_All      => Aspect_No_Elaboration_Code_All,
     Aspect_No_Return                    => Aspect_No_Return,
     Aspect_No_Tagged_Streams            => Aspect_No_Tagged_Streams,

gcc/ada/aspects.ads

@@ -116,6 +116,7 @@ package Aspects is
       Aspect_Link_Name,
       Aspect_Linker_Section,                -- GNAT
       Aspect_Machine_Radix,
+      Aspect_Max_Queue_Length,              -- GNAT
       Aspect_Object_Size,                   -- GNAT
       Aspect_Obsolescent,                   -- GNAT
       Aspect_Output,
@@ -247,6 +248,7 @@ package Aspects is
       Aspect_Inline_Always              => True,
       Aspect_Invariant                  => True,
       Aspect_Lock_Free                  => True,
+      Aspect_Max_Queue_Length           => True,
       Aspect_Object_Size                => True,
       Aspect_Persistent_BSS             => True,
       Aspect_Predicate                  => True,
@@ -353,6 +355,7 @@ package Aspects is
       Aspect_Link_Name                  => Expression,
       Aspect_Linker_Section             => Expression,
       Aspect_Machine_Radix              => Expression,
+      Aspect_Max_Queue_Length           => Expression,
       Aspect_Object_Size                => Expression,
       Aspect_Obsolescent                => Optional_Expression,
       Aspect_Output                     => Name,
@@ -460,6 +463,7 @@ package Aspects is
       Aspect_Linker_Section               => Name_Linker_Section,
       Aspect_Lock_Free                    => Name_Lock_Free,
       Aspect_Machine_Radix                => Name_Machine_Radix,
+      Aspect_Max_Queue_Length             => Name_Max_Queue_Length,
       Aspect_No_Elaboration_Code_All      => Name_No_Elaboration_Code_All,
       Aspect_No_Return                    => Name_No_Return,
       Aspect_No_Tagged_Streams            => Name_No_Tagged_Streams,
@@ -731,6 +735,7 @@ package Aspects is
       Aspect_Import                       => Never_Delay,
       Aspect_Initial_Condition            => Never_Delay,
       Aspect_Initializes                  => Never_Delay,
+      Aspect_Max_Queue_Length             => Never_Delay,
       Aspect_No_Elaboration_Code_All      => Never_Delay,
       Aspect_No_Tagged_Streams            => Never_Delay,
       Aspect_Obsolescent                  => Never_Delay,

gcc/ada/einfo.adb

@@ -267,6 +267,7 @@ package body Einfo is
    --    Contract                        Node34
 
    --    Anonymous_Designated_Type       Node35
+   --    Entry_Max_Queue_Lengths_Array   Node35
    --    Import_Pragma                   Node35
 
    --    Class_Wide_Preconds             List38
@@ -1221,6 +1222,12 @@ package body Einfo is
       return Node18 (Id);
    end Entry_Index_Constant;
 
+   function Entry_Max_Queue_Lengths_Array (Id : E) return N is
+   begin
+      pragma Assert (Ekind (Id) = E_Protected_Type);
+      return Node35 (Id);
+   end Entry_Max_Queue_Lengths_Array;
+
    function Contains_Ignored_Ghost_Code (Id : E) return B is
    begin
       pragma Assert
@@ -4286,6 +4293,12 @@ package body Einfo is
       Set_Node18 (Id, V);
    end Set_Entry_Index_Constant;
 
+   procedure Set_Entry_Max_Queue_Lengths_Array (Id : E; V : E) is
+   begin
+      pragma Assert (Ekind (Id) = E_Protected_Type);
+      Set_Node35 (Id, V);
+   end Set_Entry_Max_Queue_Lengths_Array;
+
    procedure Set_Entry_Parameters_Type (Id : E; V : E) is
    begin
       Set_Node15 (Id, V);
@@ -10738,6 +10751,10 @@ package body Einfo is
          when E_Variable                                   =>
             Write_Str ("Anonymous_Designated_Type");
 
+         when E_Entry                                      |
+              E_Entry_Family                               =>
+            Write_Str ("Entry_Max_Queue_Lenghts_Array");
+
          when Subprogram_Kind                              =>
             Write_Str ("Import_Pragma");
 

gcc/ada/einfo.ads

@@ -1154,6 +1154,11 @@ package Einfo is
 --       accept statement for a member of the family, and in the prefix of
 --       'COUNT when it applies to a family member.
 
+--    Entry_Max_Queue_Lengths_Array (Node35)
+--       Defined in protected types for which Has_Entries is true. Contains the
+--       defining identifier for the array of naturals used by the runtime to
+--       limit the queue size of each entry individually.
+
 --    Entry_Parameters_Type (Node15)
 --       Defined in entries. Points to the access-to-record type that is
 --       constructed by the expander to hold a reference to the parameter
@@ -6381,6 +6386,7 @@ package Einfo is
    --    Stored_Constraint                   (Elist23)
    --    Anonymous_Object                    (Node30)
    --    Contract                            (Node34)
+   --    Entry_Max_Queue_Lengths_Array       (Node35)
    --    SPARK_Pragma                        (Node40)
    --    SPARK_Aux_Pragma                    (Node41)
    --    Sec_Stack_Needed_For_Return         (Flag167)  ???
@@ -6928,6 +6934,7 @@ package Einfo is
    function Entry_Formal                        (Id : E) return E;
    function Entry_Index_Constant                (Id : E) return E;
    function Entry_Index_Type                    (Id : E) return E;
+   function Entry_Max_Queue_Lengths_Array       (Id : E) return E;
    function Entry_Parameters_Type               (Id : E) return E;
    function Enum_Pos_To_Rep                     (Id : E) return E;
    function Enumeration_Pos                     (Id : E) return U;
@@ -7608,6 +7615,7 @@ package Einfo is
    procedure Set_Entry_Component                 (Id : E; V : E);
    procedure Set_Entry_Formal                    (Id : E; V : E);
    procedure Set_Entry_Index_Constant            (Id : E; V : E);
+   procedure Set_Entry_Max_Queue_Lengths_Array   (Id : E; V : E);
    procedure Set_Entry_Parameters_Type           (Id : E; V : E);
    procedure Set_Enum_Pos_To_Rep                 (Id : E; V : E);
    procedure Set_Enumeration_Pos                 (Id : E; V : U);
@@ -8921,6 +8929,7 @@ package Einfo is
    pragma Inline (Set_Entry_Cancel_Parameter);
    pragma Inline (Set_Entry_Component);
    pragma Inline (Set_Entry_Formal);
+   pragma Inline (Set_Entry_Max_Queue_Lengths_Array);
    pragma Inline (Set_Entry_Parameters_Type);
    pragma Inline (Set_Enum_Pos_To_Rep);
    pragma Inline (Set_Enumeration_Pos);

gcc/ada/exp_ch9.adb

@@ -9045,7 +9045,7 @@ package body Exp_Ch9 is
    --  the specs refer to this type.
 
    procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
-      Discr_Map : constant Elist_Id := New_Elmt_List;
+      Discr_Map : constant Elist_Id   := New_Elmt_List;
       Loc       : constant Source_Ptr := Sloc (N);
       Prot_Typ  : constant Entity_Id  := Defining_Identifier (N);
 
@@ -9055,17 +9055,9 @@ package body Exp_Ch9 is
       Pdef : constant Node_Id := Protected_Definition (N);
       --  This contains two lists; one for visible and one for private decls
 
-      Body_Arr     : Node_Id;
-      Body_Id      : Entity_Id;
-      Cdecls       : List_Id;
-      Comp         : Node_Id;
       Current_Node : Node_Id := N;
       E_Count      : Int;
       Entries_Aggr : Node_Id;
-      New_Priv     : Node_Id;
-      Object_Comp  : Node_Id;
-      Priv         : Node_Id;
-      Rec_Decl     : Node_Id;
 
       procedure Check_Inlining (Subp : Entity_Id);
       --  If the original operation has a pragma Inline, propagate the flag
@@ -9295,7 +9287,17 @@ package body Exp_Ch9 is
 
       --  Local variables
 
-      Sub : Node_Id;
+      Body_Arr     : Node_Id;
+      Body_Id      : Entity_Id;
+      Cdecls       : List_Id;
+      Comp         : Node_Id;
+      Expr         : Node_Id;
+      New_Priv     : Node_Id;
+      Obj_Def      : Node_Id;
+      Object_Comp  : Node_Id;
+      Priv         : Node_Id;
+      Rec_Decl     : Node_Id;
+      Sub          : Node_Id;
 
    --  Start of processing for Expand_N_Protected_Type_Declaration
 
@@ -9760,6 +9762,96 @@ package body Exp_Ch9 is
          end loop;
       end if;
 
+      --  Create the declaration of an array object which contains the values
+      --  of aspect/pragma Max_Queue_Length for all entries of the protected
+      --  type. This object is later passed to the appropriate protected object
+      --  initialization routine.
+
+      declare
+         Maxs     : constant List_Id := New_List;
+         Count    : Int;
+         Item     : Entity_Id;
+         Maxs_Id  : Entity_Id;
+         Max_Vals : Node_Id;
+
+      begin
+         if Has_Entries (Prot_Typ) then
+
+            --  Gather the Max_Queue_Length values of all entries in a list. A
+            --  value of zero indicates that the entry has no limitation on its
+            --  queue length.
+
+            Count := 0;
+            Item  := First_Entity (Prot_Typ);
+            while Present (Item) loop
+               if Is_Entry (Item) then
+                  Count := Count + 1;
+
+                  Append_To (Maxs,
+                    Make_Integer_Literal (Loc,
+                      Intval => Get_Max_Queue_Length (Item)));
+               end if;
+
+               Next_Entity (Item);
+            end loop;
+
+            --  Create the declaration of the array object. Generate:
+
+            --    Maxs_Id : aliased Protected_Entry_Queue_Max_Array
+            --                        (1 .. Count) := (..., ...);
+            --      or
+            --    Maxs_Id : aliased Protected_Entry_Queue_Max := <value>;
+
+            Maxs_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => New_External_Name (Chars (Prot_Typ), 'B'));
+
+            case Corresponding_Runtime_Package (Prot_Typ) is
+               when System_Tasking_Protected_Objects_Entries =>
+                  Expr := Make_Aggregate (Loc, Maxs);
+
+                  Obj_Def :=
+                    Make_Subtype_Indication (Loc,
+                      Subtype_Mark =>
+                        New_Occurrence_Of
+                          (RTE (RE_Protected_Entry_Queue_Max_Array), Loc),
+                      Constraint   =>
+                        Make_Index_Or_Discriminant_Constraint (Loc,
+                          Constraints => New_List (
+                            Make_Range (Loc,
+                              Make_Integer_Literal (Loc, 1),
+                              Make_Integer_Literal (Loc, Count)))));
+
+               when System_Tasking_Protected_Objects_Single_Entry =>
+                  Expr := Make_Integer_Literal (Loc, Intval (First (Maxs)));
+
+                  Obj_Def :=
+                    New_Occurrence_Of
+                      (RTE (RE_Protected_Entry_Queue_Max), Loc);
+
+               when others =>
+                  raise Program_Error;
+            end case;
+
+            Max_Vals :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Maxs_Id,
+                Aliased_Present     => True,
+                Object_Definition   => Obj_Def,
+                Expression          => Expr);
+
+            --  A pointer to this array will be placed in the corresponding
+            --  record by its initialization procedure so this needs to be
+            --  analyzed here.
+
+            Insert_After (Current_Node, Max_Vals);
+            Current_Node := Max_Vals;
+            Analyze (Max_Vals);
+
+            Set_Entry_Max_Queue_Lengths_Array (Prot_Typ, Maxs_Id);
+         end if;
+      end;
+
       --  Emit declaration for Entry_Bodies_Array, now that the addresses of
       --  all protected subprograms have been collected.
 
@@ -9770,37 +9862,34 @@ package body Exp_Ch9 is
 
          case Corresponding_Runtime_Package (Prot_Typ) is
             when System_Tasking_Protected_Objects_Entries =>
-               Body_Arr :=
+               Expr    := Entries_Aggr;
-                 Make_Object_Declaration (Loc,
+               Obj_Def :=
-                   Defining_Identifier => Body_Id,
+                  Make_Subtype_Indication (Loc,
-                   Aliased_Present     => True,
+                    Subtype_Mark =>
-                   Object_Definition   =>
+                      New_Occurrence_Of
-                     Make_Subtype_Indication (Loc,
+                        (RTE (RE_Protected_Entry_Body_Array), Loc),
-                       Subtype_Mark =>
+                    Constraint   =>
-                         New_Occurrence_Of
+                      Make_Index_Or_Discriminant_Constraint (Loc,
-                           (RTE (RE_Protected_Entry_Body_Array), Loc),
+                        Constraints => New_List (
-                       Constraint   =>
+                          Make_Range (Loc,
-                         Make_Index_Or_Discriminant_Constraint (Loc,
+                            Make_Integer_Literal (Loc, 1),
-                           Constraints => New_List (
+                            Make_Integer_Literal (Loc, E_Count)))));
-                              Make_Range (Loc,
-                                Make_Integer_Literal (Loc, 1),
-                                Make_Integer_Literal (Loc, E_Count))))),
-                   Expression          => Entries_Aggr);
 
             when System_Tasking_Protected_Objects_Single_Entry =>
-               Body_Arr :=
+               Expr    := Remove_Head (Expressions (Entries_Aggr));
-                 Make_Object_Declaration (Loc,
+               Obj_Def := New_Occurrence_Of (RTE (RE_Entry_Body), Loc);
-                   Defining_Identifier => Body_Id,
-                   Aliased_Present     => True,
-                   Object_Definition   =>
-                     New_Occurrence_Of (RTE (RE_Entry_Body), Loc),
-                   Expression          =>
-                     Remove_Head (Expressions (Entries_Aggr)));
 
             when others =>
                raise Program_Error;
          end case;
 
+         Body_Arr :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Body_Id,
+             Aliased_Present     => True,
+             Object_Definition   => Obj_Def,
+             Expression          => Expr);
+
          --  A pointer to this array will be placed in the corresponding record
          --  by its initialization procedure so this needs to be analyzed here.
 
@@ -9821,6 +9910,7 @@ package body Exp_Ch9 is
             Sub :=
               Make_Subprogram_Declaration (Loc,
                 Specification => Build_Find_Body_Index_Spec (Prot_Typ));
+
             Insert_After (Current_Node, Sub);
             Analyze (Sub);
          end if;
@@ -14107,6 +14197,27 @@ package body Exp_Ch9 is
                      raise Program_Error;
             end case;
 
+            --  Entry_Queue_Maxs parameter. This is a pointer to an array of
+            --  naturals representing the entry queue maximums for each entry
+            --  in the protected type. Zero represents no max.
+
+            if Has_Entry then
+               Append_To (Args,
+                 Make_Attribute_Reference (Loc,
+                   Prefix         =>
+                     New_Occurrence_Of
+                       (Entry_Max_Queue_Lengths_Array (Ptyp), Loc),
+                   Attribute_Name => Name_Unrestricted_Access));
+
+            --  Edge cases exist where entry initialization functions are
+            --  called, but no entries exist, so null is appended.
+
+            elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry
+              or else Pkg_Id = System_Tasking_Protected_Objects_Entries
+            then
+               Append_To (Args, Make_Null (Loc));
+            end if;
+
             --  Entry_Bodies parameter. This is a pointer to an array of
             --  pointers to the entry body procedures and barrier functions of
             --  the object. If the protected type has no entries this object

gcc/ada/exp_util.adb

@@ -4912,35 +4912,28 @@ package body Exp_Util is
          --    Obj.Func (Formal => Actual) N_Function_Call, whose Name is an
          --                                N_Selected_Component
 
-         case Nkind (Expr) is
+         loop
-            when N_Function_Call =>
+            if Nkind (Expr) = N_Function_Call then
                Expr := Name (Expr);
 
-               --  Check for "Obj.Func (Formal => Actual)" case
-
-               if Nkind (Expr) = N_Selected_Component then
-                  Expr := Selector_Name (Expr);
-               end if;
-
             --  "Obj.Func (Actual)" case
 
-            when N_Indexed_Component =>
+            elsif Nkind (Expr) = N_Indexed_Component then
                Expr := Prefix (Expr);
 
-               if Nkind (Expr) = N_Selected_Component then
+            --  "Obj.Func" or "Obj.Func (Formal => Actual) case
-                  Expr := Selector_Name (Expr);
-               end if;
 
-            --  "Obj.Func" case
+            elsif Nkind (Expr) = N_Selected_Component then
-
-            when N_Selected_Component =>
                Expr := Selector_Name (Expr);
 
-            when others => null;
+            else
-         end case;
+               exit;
+            end if;
+         end loop;
 
          return
-           Nkind_In (Expr, N_Expanded_Name, N_Identifier)
+           Nkind (Expr) in N_Has_Entity
+             and then Present (Entity (Expr))
              and then Ekind (Entity (Expr)) = E_Function
              and then Needs_Finalization (Etype (Entity (Expr)));
       end Is_Controlled_Function_Call;

gcc/ada/g-socthi-mingw.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2014, AdaCore                     --
+--                     Copyright (C) 2001-2016, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -43,7 +43,6 @@ with System.Storage_Elements; use System.Storage_Elements;
 package body GNAT.Sockets.Thin is
 
    use type C.unsigned;
-   use type C.int;
 
    WSAData_Dummy : array (1 .. 512) of C.int;
 

gcc/ada/par-prag.adb

@@ -1396,6 +1396,7 @@ begin
            Pragma_Machine_Attribute              |
            Pragma_Main                           |
            Pragma_Main_Storage                   |
+           Pragma_Max_Queue_Length               |
            Pragma_Memory_Size                    |
            Pragma_No_Body                        |
            Pragma_No_Elaboration_Code_All        |

gcc/ada/rtsfind.adb

@@ -1351,7 +1351,7 @@ package body Rtsfind is
       --  is System. If so, return the value from the already compiled
       --  declaration and otherwise do a regular find.
 
-      --  Not pleasant, but these kinds of annoying recursion when
+      --  Not pleasant, but these kinds of annoying recursion senarios when
       --  writing an Ada compiler in Ada have to be broken somewhere.
 
       if Present (Main_Unit_Entity)

gcc/ada/rtsfind.ads

@@ -1684,6 +1684,7 @@ package Rtsfind is
 
      RE_Protected_Entry_Body_Array,      -- Tasking.Protected_Objects.Entries
      RE_Protected_Entry_Names_Array,     -- Tasking.Protected_Objects.Entries
+     RE_Protected_Entry_Queue_Max_Array, -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries,              -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries_Access,       -- Tasking.Protected_Objects.Entries
      RE_Initialize_Protection_Entries,   -- Tasking.Protected_Objects.Entries
@@ -1716,6 +1717,7 @@ package Rtsfind is
      RE_Service_Entry,                   -- Protected_Objects.Single_Entry
      RE_Exceptional_Complete_Single_Entry_Body,
      RE_Protected_Count_Entry,           -- Protected_Objects.Single_Entry
+     RE_Protected_Entry_Queue_Max,       -- Protected_Objects.Single_Entry
      RE_Protected_Single_Entry_Caller,   -- Protected_Objects.Single_Entry
 
      RE_Protected_Entry_Index,           -- System.Tasking.Protected_Objects
@@ -2927,6 +2929,8 @@ package Rtsfind is
        System_Tasking_Protected_Objects_Entries,
      RE_Protected_Entry_Names_Array      =>
        System_Tasking_Protected_Objects_Entries,
+     RE_Protected_Entry_Queue_Max_Array  =>
+       System_Tasking_Protected_Objects_Entries,
      RE_Protection_Entries               =>
        System_Tasking_Protected_Objects_Entries,
      RE_Protection_Entries_Access        =>
@@ -2989,6 +2993,8 @@ package Rtsfind is
        System_Tasking_Protected_Objects_Single_Entry,
      RE_Protected_Count_Entry            =>
        System_Tasking_Protected_Objects_Single_Entry,
+     RE_Protected_Entry_Queue_Max        =>
+       System_Tasking_Protected_Objects_Single_Entry,
      RE_Protected_Single_Entry_Caller    =>
        System_Tasking_Protected_Objects_Single_Entry,
 

gcc/ada/s-tpoben.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                               B o d y                                    --
 --                                                                          --
---          Copyright (C) 1998-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -174,6 +174,7 @@ package body System.Tasking.Protected_Objects.Entries is
      (Object           : Protection_Entries_Access;
       Ceiling_Priority : Integer;
       Compiler_Info    : System.Address;
+      Entry_Queue_Maxs : Protected_Entry_Queue_Max_Access;
       Entry_Bodies     : Protected_Entry_Body_Access;
       Find_Body_Index  : Find_Body_Index_Access)
    is
@@ -211,6 +212,7 @@ package body System.Tasking.Protected_Objects.Entries is
       Object.Compiler_Info    := Compiler_Info;
       Object.Pending_Action   := False;
       Object.Call_In_Progress := null;
+      Object.Entry_Queue_Maxs := Entry_Queue_Maxs;
       Object.Entry_Bodies     := Entry_Bodies;
       Object.Find_Body_Index  := Find_Body_Index;
 

gcc/ada/s-tpoben.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -66,6 +66,12 @@ package System.Tasking.Protected_Objects.Entries is
    type Protected_Entry_Queue_Array is
      array (Protected_Entry_Index range <>) of Entry_Queue;
 
+   type Protected_Entry_Queue_Max_Array is
+     array (Positive_Protected_Entry_Index range <>) of Natural;
+
+   type Protected_Entry_Queue_Max_Access is
+     access all Protected_Entry_Queue_Max_Array;
+
    --  The following declarations define an array that contains the string
    --  names of entries and entry family members, together with an associated
    --  access type.
@@ -144,6 +150,10 @@ package System.Tasking.Protected_Objects.Entries is
 
       Entry_Queues : Protected_Entry_Queue_Array (1 .. Num_Entries);
 
+      Entry_Queue_Maxs : Protected_Entry_Queue_Max_Access;
+      --  Access to an array of naturals representing the max value for
+      --  each entry's queue length. A value of 0 signifies no max.
+
       Entry_Names : Protected_Entry_Names_Access := null;
       --  An array of string names which denotes entry [family member] names.
       --  The structure is indexed by protected entry index and contains Num_
@@ -178,6 +188,7 @@ package System.Tasking.Protected_Objects.Entries is
      (Object           : Protection_Entries_Access;
       Ceiling_Priority : Integer;
       Compiler_Info    : System.Address;
+      Entry_Queue_Maxs : Protected_Entry_Queue_Max_Access;
       Entry_Bodies     : Protected_Entry_Body_Access;
       Find_Body_Index  : Find_Body_Index_Access);
    --  Initialize the Object parameter so that it can be used by the runtime

gcc/ada/s-tposen.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---         Copyright (C) 1998-2013, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2016, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -218,6 +218,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
      (Object            : Protection_Entry_Access;
       Ceiling_Priority  : Integer;
       Compiler_Info     : System.Address;
+      Entry_Queue_Max   : Protected_Entry_Queue_Max_Access;
       Entry_Body        : Entry_Body_Access)
    is
    begin
@@ -226,6 +227,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       Object.Compiler_Info := Compiler_Info;
       Object.Call_In_Progress := null;
       Object.Entry_Body := Entry_Body;
+      Object.Entry_Queue_Max := Entry_Queue_Max;
       Object.Entry_Queue := null;
    end Initialize_Protection_Entry;
 

gcc/ada/s-tposen.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -182,10 +182,16 @@ package System.Tasking.Protected_Objects.Single_Entry is
 
    type Protection_Entry_Access is access all Protection_Entry;
 
+   type Protected_Entry_Queue_Max is new Natural;
+
+   type Protected_Entry_Queue_Max_Access is
+     access all Protected_Entry_Queue_Max;
+
    procedure Initialize_Protection_Entry
      (Object            : Protection_Entry_Access;
       Ceiling_Priority  : Integer;
       Compiler_Info     : System.Address;
+      Entry_Queue_Max   : Protected_Entry_Queue_Max_Access;
       Entry_Body        : Entry_Body_Access);
    --  Initialize the Object parameter so that it can be used by the run time
    --  to keep track of the runtime state of a protected object.
@@ -270,6 +276,10 @@ private
 
       Entry_Queue : Entry_Call_Link;
       --  Place to store the waiting entry call (if any)
+
+      Entry_Queue_Max : Protected_Entry_Queue_Max_Access;
+      --  Access to a natural representing the max value for the single
+      --  entry's queue length. A value of 0 signifies no max.
    end record;
 
 end System.Tasking.Protected_Objects.Single_Entry;

gcc/ada/sem_case.adb

@@ -1369,9 +1369,9 @@ package body Sem_Case is
             Lo  : Node_Id;
             Hi  : Node_Id);
          --  If the type of the alternative has predicates, we must examine
-         --  each subset of the predicate rather than the bounds of the
+         --  each subset of the predicate rather than the bounds of the type
-         --  type itself. This is relevant when the choice is a subtype mark
+         --  itself. This is relevant when the choice is a subtype mark or a
-         --  or a subtype indication.
+         --  subtype indication.
 
          -----------
          -- Check --
@@ -1509,8 +1509,8 @@ package body Sem_Case is
             P := First (Static_Discrete_Predicate (Typ));
             while Present (P) loop
 
-               --  Check that part of the predicate choice is included in
+               --  Check that part of the predicate choice is included in the
-               --  the given bounds.
+               --  given bounds.
 
                if Expr_Value (High_Bound (P)) >= Expr_Value (Lo)
                  and then Expr_Value (Low_Bound (P)) <= Expr_Value (Hi)
@@ -1643,8 +1643,8 @@ package body Sem_Case is
                                  & "predicate as case alternative",
                                  Choice, E, Suggest_Static => True);
 
-                           --  Static predicate case. The bounds are
+                           --  Static predicate case. The bounds are those of
-                           --  those of the given subtype.
+                           --  the given subtype.
 
                            else
                               Handle_Static_Predicate (E,
@@ -1702,11 +1702,10 @@ package body Sem_Case is
                                  end if;
                               end if;
 
-                              if Has_Static_Predicate (E) then
-
                               --  Check applicable predicate values within the
                               --  bounds of the given range.
 
+                              if Has_Static_Predicate (E) then
                                  Handle_Static_Predicate (E, L, H);
 
                               else

gcc/ada/sem_ch13.adb

@@ -2823,6 +2823,19 @@ package body Sem_Ch13 is
                   goto Continue;
                end Initializes;
 
+               --  Max_Queue_Length
+
+               when Aspect_Max_Queue_Length =>
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  => Name_Max_Queue_Length);
+
+                  Decorate (Aspect, Aitem);
+                  Insert_Pragma (Aitem);
+                  goto Continue;
+
                --  Obsolescent
 
                when Aspect_Obsolescent => declare
@@ -9251,6 +9264,7 @@ package body Sem_Ch13 is
               Aspect_Implicit_Dereference       |
               Aspect_Initial_Condition          |
               Aspect_Initializes                |
+              Aspect_Max_Queue_Length           |
               Aspect_Obsolescent                |
               Aspect_Part_Of                    |
               Aspect_Post                       |

gcc/ada/sem_prag.adb

@@ -17659,6 +17659,86 @@ package body Sem_Prag is
             end loop;
          end Main_Storage;
 
+         ----------------------
+         -- Max_Queue_Length --
+         ----------------------
+
+         --  pragma Max_Queue_Length (static_integer_EXPRESSION);
+
+         when Pragma_Max_Queue_Length => Max_Queue_Length : declare
+            Arg        : Node_Id;
+            Entry_Decl : Node_Id;
+            Entry_Id   : Entity_Id;
+            Val        : Uint;
+
+         begin
+            GNAT_Pragma;
+            Check_Arg_Count (1);
+
+            Entry_Decl :=
+              Find_Related_Declaration_Or_Body (N, Do_Checks => True);
+
+            --  Entry declaration
+
+            if Nkind (Entry_Decl) = N_Entry_Declaration then
+
+               --  Entry illegally within a task
+
+               if Nkind (Parent (N)) = N_Task_Definition then
+                  Error_Pragma ("pragma % cannot apply to task entries");
+                  return;
+               end if;
+
+               Entry_Id := Unique_Defining_Entity (Entry_Decl);
+
+               --  Pragma illegally applied to an entry family
+
+               if Ekind (Entry_Id) = E_Entry_Family then
+                  Error_Pragma ("pragma % cannot apply to entry families");
+                  return;
+               end if;
+
+            --  Otherwise the pragma is associated with an illegal construct
+
+            else
+               Error_Pragma ("pragma % must apply to a protected entry");
+               return;
+            end if;
+
+            --  Mark the pragma as Ghost if the related subprogram is also
+            --  Ghost. This also ensures that any expansion performed further
+            --  below will produce Ghost nodes.
+
+            Mark_Pragma_As_Ghost (N, Entry_Id);
+
+            --  Analyze the Integer expression
+
+            Arg := Get_Pragma_Arg (Arg1);
+            Check_Arg_Is_OK_Static_Expression (Arg, Any_Integer);
+
+            Val := Expr_Value (Arg);
+
+            if Val <= 0 then
+               Error_Pragma_Arg
+                 ("argument for pragma% must be positive", Arg1);
+
+            elsif not UI_Is_In_Int_Range (Val) then
+               Error_Pragma_Arg
+                 ("argument for pragma% out of range of Integer", Arg1);
+
+            end if;
+
+            --  Manually subsitute the expression value of the pragma argument
+            --  if it not an integer literally because this is not taken care
+            --  of automatically elsewhere.
+
+            if Nkind (Arg) /= N_Integer_Literal then
+               Rewrite (Arg, Make_Integer_Literal (Sloc (Arg), Val));
+            end if;
+
+            Record_Rep_Item (Entry_Id, N);
+         end Max_Queue_Length;
+
          -----------------
          -- Memory_Size --
          -----------------
@@ -28642,6 +28722,7 @@ package body Sem_Prag is
       Pragma_Machine_Attribute              => -1,
       Pragma_Main                           => -1,
       Pragma_Main_Storage                   => -1,
+      Pragma_Max_Queue_Length               =>  0,
       Pragma_Memory_Size                    =>  0,
       Pragma_No_Return                      =>  0,
       Pragma_No_Body                        =>  0,

gcc/ada/sem_util.adb

@@ -8351,6 +8351,24 @@ package body Sem_Util is
       pragma Assert (Name_Buffer (Name_Len + 1) = ' ');
    end Get_Library_Unit_Name_String;
 
+   --------------------------
+   -- Get_Max_Queue_Length --
+   --------------------------
+
+   function Get_Max_Queue_Length (Id : Entity_Id) return Uint is
+      Prag : constant Entity_Id := Get_Pragma (Id, Pragma_Max_Queue_Length);
+
+   begin
+      --  A value of 0 represents no maximum specified and entries and entry
+      --  families with no Max_Queue_Length aspect or pragma defaults to it.
+
+      if not Has_Max_Queue_Length (Id) or else not Present (Prag) then
+         return Uint_0;
+      end if;
+
+      return Intval (Expression (First (Pragma_Argument_Associations (Prag))));
+   end Get_Max_Queue_Length;
+
    ------------------------
    -- Get_Name_Entity_Id --
    ------------------------
@@ -9648,15 +9666,25 @@ package body Sem_Util is
       return False;
    end Has_Interfaces;
 
+   --------------------------
+   -- Has_Max_Queue_Length --
+   --------------------------
+
+   function Has_Max_Queue_Length (Id : Entity_Id) return Boolean is
+   begin
+      return
+        Ekind (Id) = E_Entry
+          and then Present (Get_Pragma (Id, Pragma_Max_Queue_Length));
+   end Has_Max_Queue_Length;
+
    ---------------------------------
    -- Has_No_Obvious_Side_Effects --
    ---------------------------------
 
    function Has_No_Obvious_Side_Effects (N : Node_Id) return Boolean is
    begin
-      --  For now, just handle literals, constants, and non-volatile
+      --  For now handle literals, constants, and non-volatile variables and
-      --  variables and expressions combining these with operators or
+      --  expressions combining these with operators or short circuit forms.
-      --  short circuit forms.
 
       if Nkind (N) in N_Numeric_Or_String_Literal then
          return True;

gcc/ada/sem_util.ads

@@ -931,6 +931,10 @@ package Sem_Util is
    --  Retrieve the fully expanded name of the library unit declared by
    --  Decl_Node into the name buffer.
 
+   function Get_Max_Queue_Length (Id : Entity_Id) return Uint;
+   --  Return the argument of pragma Max_Queue_Length or zero if the annotation
+   --  is not present. It is assumed that Id denotes an entry.
+
    function Get_Name_Entity_Id (Id : Name_Id) return Entity_Id;
    pragma Inline (Get_Name_Entity_Id);
    --  An entity value is associated with each name in the name table. The
@@ -1104,6 +1108,10 @@ package Sem_Util is
    --  Use_Full_View controls if the check is done using its full view (if
    --  available).
 
+   function Has_Max_Queue_Length (Id : Entity_Id) return Boolean;
+   --  Determine whether Id is subject to pragma Max_Queue_Length. It is
+   --  assumed that Id denotes an entry.
+
    function Has_No_Obvious_Side_Effects (N : Node_Id) return Boolean;
    --  This is a simple minded function for determining whether an expression
    --  has no obvious side effects. It is used only for determining whether

gcc/ada/snames.ads-tmpl

@@ -575,6 +575,7 @@ package Snames is
    Name_Machine_Attribute              : constant Name_Id := N + $; -- GNAT
    Name_Main                           : constant Name_Id := N + $; -- GNAT
    Name_Main_Storage                   : constant Name_Id := N + $; -- GNAT
+   Name_Max_Queue_Length               : constant Name_Id := N + $; -- GNAT
    Name_Memory_Size                    : constant Name_Id := N + $; -- Ada 83
    Name_No_Body                        : constant Name_Id := N + $; -- GNAT
    Name_No_Elaboration_Code_All        : constant Name_Id := N + $; -- GNAT
@@ -1904,6 +1905,7 @@ package Snames is
       Pragma_Machine_Attribute,
       Pragma_Main,
       Pragma_Main_Storage,
+      Pragma_Max_Queue_Length,
       Pragma_Memory_Size,
       Pragma_No_Body,
       Pragma_No_Elaboration_Code_All,