[multiple changes]

2010-10-18  Vincent Celier  <celier@adacore.com>

	* prj.ads (Source_Data): New Boolean flag In_The_Queue.

2010-10-18  Tristan Gingold  <gingold@adacore.com>

	* s-stausa.ads: Add the Top parameter to Initialize_Analyzer.
	* s-stausa.adb: Use the top parameter.  In Fill_Stack, use the
	stack top if known.
	* s-tassta.adb (Task_Wrapper): Call Initialize_Analyzer after Enter_Task
	so that Pri_Stack_Info.Limit can be set and used.

2010-10-18  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Minor reformatting.
	* sem_res.adb (Resolve_Allocator): Add test for violating
	No_Anonymous_Allocators.

From-SVN: r165624

7 files changed, 145 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7240bce..172416b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2010-10-18  Vincent Celier  <celier@adacore.com>
+
+	* prj.ads (Source_Data): New Boolean flag In_The_Queue.
+
+2010-10-18  Tristan Gingold  <gingold@adacore.com>
+
+	* s-stausa.ads: Add the Top parameter to Initialize_Analyzer.
+	* s-stausa.adb: Use the top parameter.  In Fill_Stack, use the
+	stack top if known.
+	* s-tassta.adb (Task_Wrapper): Call Initialize_Analyzer after Enter_Task
+	so that Pri_Stack_Info.Limit can be set and used.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* einfo.ads: Minor reformatting.
+	* sem_res.adb (Resolve_Allocator): Add test for violating
+	No_Anonymous_Allocators.
+
 2010-10-18  Robert Dewar  <dewar@adacore.com>
 
 	* prj-nmsc.adb, prj.adb, sem_res.adb: Minor reformatting.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index cbfa632..d78bcca 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3778,15 +3778,14 @@ package Einfo is
    --  E_Access_Subtype is for an access subtype created by a subtype
    --  declaration.
 
-   --  In addition, we define the kind E_Allocator_Type to label
-   --  allocators. This is because special resolution rules apply to this
-   --  construct. Eventually the constructs are labeled with the access
-   --  type imposed by the context. Gigi should never see the type
-   --  E_Allocator.
-
-   --  Similarly, the type E_Access_Attribute_Type is used as the initial
-   --  kind associated with an access attribute. After resolution a specific
-   --  access type will be established as determined by the context.
+   --  In addition, we define the kind E_Allocator_Type to label allocators.
+   --  This is because special resolution rules apply to this construct.
+   --  Eventually the constructs are labeled with the access type imposed by
+   --  the context. Gigi should never see the type E_Allocator.
+
+   --  Similarly, the type E_Access_Attribute_Type is used as the initial kind
+   --  associated with an access attribute. After resolution a specific access
+   --  type will be established as determined by the context.
 
    --  Finally, the type Any_Access is used to label -null- during type
    --  resolution. Any_Access is also replaced by the context type after
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index dd3c981..ccf0853 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -710,6 +710,9 @@ package Prj is
       --  Updated at the first call to Is_Compilable. Yes if source file is
       --  compilable.
 
+      In_The_Queue : Boolean := False;
+      --  True if the source has been put in the queue
+
       Locally_Removed : Boolean := False;
       --  True if the source has been "excluded"
 
@@ -793,6 +796,7 @@ package Prj is
                        Index                  => 0,
                        Locally_Removed        => False,
                        Compilable             => Unknown,
+                       In_The_Queue           => False,
                        Replaced_By            => No_Source,
                        File                   => No_File,
                        Display_File           => No_File,
diff --git a/gcc/ada/s-stausa.adb b/gcc/ada/s-stausa.adb
index 37dda6f..d533e0c 100644
--- a/gcc/ada/s-stausa.adb
+++ b/gcc/ada/s-stausa.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2004-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2004-2010, 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- --
@@ -232,7 +232,8 @@ package body System.Stack_Usage is
                "ENVIRONMENT TASK",
                My_Stack_Size,
                My_Stack_Size,
-               System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address));
+               System.Storage_Elements.To_Integer (Bottom_Of_Stack'Address),
+               0);
 
             Fill_Stack (Environment_Task_Analyzer);
 
@@ -259,56 +260,90 @@ package body System.Stack_Usage is
       Stack_Used_When_Filling : Integer;
       Current_Stack_Level     : aliased Integer;
 
+      Guard : constant Integer := 256;
+      --  Guard space between the Current_Stack_Level'Address and the last
+      --  allocated byte on the stack.
    begin
-      --  Readjust the pattern size. When we arrive in this function, there is
-      --  already a given amount of stack used, that we won't analyze.
+      if Analyzer.Top_Pattern_Mark /= 0 then
+         --  Easiest and most accurate method: the top of the stack is known.
 
-      Stack_Used_When_Filling :=
-        Stack_Size
-         (Analyzer.Bottom_Of_Stack,
-          To_Stack_Address (Current_Stack_Level'Address))
-          + Natural (Current_Stack_Level'Size);
+         Analyzer.Pattern_Size :=
+           Stack_Size (Analyzer.Top_Pattern_Mark,
+                       To_Stack_Address (Current_Stack_Level'Address))
+           - Guard;
 
-      if Stack_Used_When_Filling > Analyzer.Pattern_Size then
-         --  In this case, the known size of the stack is too small, we've
-         --  already taken more than expected, so there's no possible
-         --  computation
+         if System.Parameters.Stack_Grows_Down then
+            Analyzer.Stack_Overlay_Address :=
+              To_Address (Analyzer.Top_Pattern_Mark);
+         else
+            Analyzer.Stack_Overlay_Address :=
+              To_Address (Analyzer.Top_Pattern_Mark
+                            - Stack_Address (Analyzer.Pattern_Size));
+         end if;
 
-         Analyzer.Pattern_Size := 0;
-      else
-         Analyzer.Pattern_Size :=
-           Analyzer.Pattern_Size - Stack_Used_When_Filling;
-      end if;
+         declare
+            Pattern : aliased Stack_Slots
+              (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
+            for Pattern'Address use Analyzer.Stack_Overlay_Address;
+         begin
+            if System.Parameters.Stack_Grows_Down then
+               for I in reverse Pattern'Range loop
+                  Pattern (I) := Analyzer.Pattern;
+               end loop;
+               Analyzer.Bottom_Pattern_Mark :=
+                 To_Stack_Address (Pattern (Pattern'Last)'Address);
+            else
+               for I in Pattern'Range loop
+                  Pattern (I) := Analyzer.Pattern;
+               end loop;
+               Analyzer.Bottom_Pattern_Mark :=
+                 To_Stack_Address (Pattern (Pattern'First)'Address);
+            end if;
+         end;
 
-      declare
-         Stack : aliased Stack_Slots
-                           (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
+      else
+         --  Readjust the pattern size. When we arrive in this function, there
+         --  is already a given amount of stack used, that we won't analyze.
 
-      begin
-         Stack := (others => Analyzer.Pattern);
+         Stack_Used_When_Filling :=
+           Stack_Size (Analyzer.Bottom_Of_Stack,
+                       To_Stack_Address (Current_Stack_Level'Address));
 
-         Analyzer.Stack_Overlay_Address := Stack'Address;
+         if Stack_Used_When_Filling > Analyzer.Pattern_Size then
+            --  In this case, the known size of the stack is too small, we've
+            --  already taken more than expected, so there's no possible
+            --  computation
 
-         if Analyzer.Pattern_Size /= 0 then
-            Analyzer.Bottom_Pattern_Mark :=
-              To_Stack_Address (Stack (Bottom_Slot_Index_In (Stack))'Address);
-            Analyzer.Top_Pattern_Mark :=
-              To_Stack_Address (Stack (Top_Slot_Index_In (Stack))'Address);
+            Analyzer.Pattern_Size := 0;
          else
-            Analyzer.Bottom_Pattern_Mark := To_Stack_Address (Stack'Address);
-            Analyzer.Top_Pattern_Mark := To_Stack_Address (Stack'Address);
+            Analyzer.Pattern_Size :=
+              Analyzer.Pattern_Size - Stack_Used_When_Filling;
          end if;
 
-         --  If Arr has been packed, the following assertion must be true (we
-         --  add the size of the element whose address is:
-         --    Min (Analyzer.Inner_Pattern_Mark, Analyzer.Outer_Pattern_Mark)):
+         declare
+            Stack : aliased Stack_Slots
+              (1 .. Analyzer.Pattern_Size / Bytes_Per_Pattern);
 
-         pragma Assert
-           (Analyzer.Pattern_Size = 0 or else
-            Analyzer.Pattern_Size =
-              Stack_Size
-                (Analyzer.Top_Pattern_Mark, Analyzer.Bottom_Pattern_Mark));
-      end;
+         begin
+            Stack := (others => Analyzer.Pattern);
+
+            Analyzer.Stack_Overlay_Address := Stack'Address;
+
+            if Analyzer.Pattern_Size /= 0 then
+               Analyzer.Bottom_Pattern_Mark :=
+                 To_Stack_Address
+                   (Stack (Bottom_Slot_Index_In (Stack))'Address);
+               Analyzer.Top_Pattern_Mark :=
+                 To_Stack_Address
+                   (Stack (Top_Slot_Index_In (Stack))'Address);
+            else
+               Analyzer.Bottom_Pattern_Mark :=
+                 To_Stack_Address (Stack'Address);
+               Analyzer.Top_Pattern_Mark :=
+                 To_Stack_Address (Stack'Address);
+            end if;
+         end;
+      end if;
    end Fill_Stack;
 
    -------------------------
@@ -321,17 +356,19 @@ package body System.Stack_Usage is
       My_Stack_Size    : Natural;
       Max_Pattern_Size : Natural;
       Bottom           : Stack_Address;
+      Top              : Stack_Address;
       Pattern          : Unsigned_32 := 16#DEAD_BEEF#)
    is
    begin
       --  Initialize the analyzer fields
 
-      Analyzer.Bottom_Of_Stack := Bottom;
-      Analyzer.Stack_Size      := My_Stack_Size;
-      Analyzer.Pattern_Size    := Max_Pattern_Size;
-      Analyzer.Pattern         := Pattern;
-      Analyzer.Result_Id       := Next_Id;
-      Analyzer.Task_Name       := (others => ' ');
+      Analyzer.Bottom_Of_Stack  := Bottom;
+      Analyzer.Stack_Size       := My_Stack_Size;
+      Analyzer.Pattern_Size     := Max_Pattern_Size;
+      Analyzer.Pattern          := Pattern;
+      Analyzer.Result_Id        := Next_Id;
+      Analyzer.Task_Name        := (others => ' ');
+      Analyzer.Top_Pattern_Mark := Top;
 
       --  Compute the task name, and truncate if bigger than Task_Name_Length
 
diff --git a/gcc/ada/s-stausa.ads b/gcc/ada/s-stausa.ads
index 9aa432b..1cd78ea 100644
--- a/gcc/ada/s-stausa.ads
+++ b/gcc/ada/s-stausa.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---         Copyright (C) 2004-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2004-2010, 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,10 +218,11 @@ package System.Stack_Usage is
    --  |  of Fill_Stack         |                                     |
    --  |  (deallocated at       |                                     |
    --  |  the end of the call)  |                                     |
-   --  ^                        |                                     |
-   --  Analyzer.Bottom_Of_Stack ^                                     |
-   --                    Analyzer.Bottom_Pattern_Mark                 ^
-   --                                            Analyzer.Top_Pattern_Mark
+   --  ^                        |                                     ^
+   --  Analyzer.Bottom_Of_Stack |                  Analyzer.Top_Pattern_Mark
+   --                           ^
+   --                    Analyzer.Bottom_Pattern_Mark
+   --
 
    procedure Initialize_Analyzer
      (Analyzer         : in out Stack_Analyzer;
@@ -229,6 +230,7 @@ package System.Stack_Usage is
       My_Stack_Size    : Natural;
       Max_Pattern_Size : Natural;
       Bottom           : Stack_Address;
+      Top              : Stack_Address;
       Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
    --  Should be called before any use of a Stack_Analyzer, to initialize it.
    --  Max_Pattern_Size is the size of the pattern zone, might be smaller than
diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
index a78b0d8..c10cdd8 100644
--- a/gcc/ada/s-tassta.adb
+++ b/gcc/ada/s-tassta.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2010, 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- --
@@ -1093,11 +1093,6 @@ package body System.Tasking.Stages is
 
       --  Assume a size of the stack taken at this stage
 
-      Overflow_Guard :=
-        (if Size < Small_Stack_Limit
-         then Small_Overflow_Guard
-         else Big_Overflow_Guard);
-
       if not Parameters.Sec_Stack_Dynamic then
          Self_ID.Common.Compiler_Data.Sec_Stack_Addr :=
            Secondary_Stack'Address;
@@ -1109,9 +1104,24 @@ package body System.Tasking.Stages is
          Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address;
       end if;
 
-      Size := Size - Overflow_Guard;
+      --  Set the guard page at the bottom of the stack. The call to unprotect
+      --  the page is done in Terminate_Task
+
+      Stack_Guard (Self_ID, True);
+
+      --  Initialize low-level TCB components, that cannot be initialized by
+      --  the creator. Enter_Task sets Self_ID.LL.Thread
+
+      Enter_Task (Self_ID);
+
+      --  Initialize dynamic stack usage
 
       if System.Stack_Usage.Is_Enabled then
+         Overflow_Guard :=
+           (if Size < Small_Stack_Limit
+              then Small_Overflow_Guard
+              else Big_Overflow_Guard);
+
          STPO.Lock_RTS;
          Initialize_Analyzer
            (Self_ID.Common.Analyzer,
@@ -1119,22 +1129,14 @@ package body System.Tasking.Stages is
               (1 .. Self_ID.Common.Task_Image_Len),
             Natural
               (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size),
-            Size,
-            SSE.To_Integer (Bottom_Of_Stack'Address));
+            Size - Overflow_Guard,
+            SSE.To_Integer (Bottom_Of_Stack'Address),
+            SSE.To_Integer
+              (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Limit));
          STPO.Unlock_RTS;
          Fill_Stack (Self_ID.Common.Analyzer);
       end if;
 
-      --  Set the guard page at the bottom of the stack. The call to unprotect
-      --  the page is done in Terminate_Task
-
-      Stack_Guard (Self_ID, True);
-
-      --  Initialize low-level TCB components, that cannot be initialized by
-      --  the creator. Enter_Task sets Self_ID.LL.Thread
-
-      Enter_Task (Self_ID);
-
       --  We setup the SEH (Structured Exception Handling) handler if supported
       --  on the target.
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index efd44e8..0e67047 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4324,6 +4324,10 @@ package body Sem_Res is
            (Typ, Associated_Storage_Pool (Etype (Parent (N))));
       end if;
 
+      if Ekind (Etype (N)) = E_Anonymous_Access_Type then
+         Check_Restriction (No_Anonymous_Allocators, N);
+      end if;
+
       --  An erroneous allocator may be rewritten as a raise Program_Error
       --  statement.