[multiple changes]

2010-10-18  Arnaud Charlet  <charlet@adacore.com>

	* g-comlin.adb (Get_Switches): Prevent dereferencing null Config.

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

	* aspects.ads, aspects.adb: Add entries for aspects
	Read/Write/Input/Output.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Add processing for
	handling aspects Read/Write/Input/Output.

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

	* sem_util.adb (Note_Possible_Modification): Do not give warning for
	use of pragma Unmodified unless we are sure this is a modification.

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

	* sysdep.c: Add __gnat_get_stack_bounds.
	* s-taprop-mingw.adb Call __gnat_get_stack_bounds to set Pri_Stack_Info.

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

	* a-assert.ads: Fix bad name in header.
	* sem_ch4.adb, sem_ch6.adb, sem_ch7.adb, sem_ch10.adb: Minor
	reformatting.
	* exp_aggr.adb: Fix typo in comment.

From-SVN: r165615

14 files changed, 121 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 251ac57..274dde2 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2010-10-18  Arnaud Charlet  <charlet@adacore.com>
+
+	* g-comlin.adb (Get_Switches): Prevent dereferencing null Config.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* aspects.ads, aspects.adb: Add entries for aspects
+	Read/Write/Input/Output.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Add processing for
+	handling aspects Read/Write/Input/Output.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.adb (Note_Possible_Modification): Do not give warning for
+	use of pragma Unmodified unless we are sure this is a modification.
+
+2010-10-18  Tristan Gingold  <gingold@adacore.com>
+
+	* sysdep.c: Add __gnat_get_stack_bounds.
+	* s-taprop-mingw.adb Call __gnat_get_stack_bounds to set Pri_Stack_Info.
+
+2010-10-18  Robert Dewar  <dewar@adacore.com>
+
+	* a-assert.ads: Fix bad name in header.
+	* sem_ch4.adb, sem_ch6.adb, sem_ch7.adb, sem_ch10.adb: Minor
+	reformatting.
+	* exp_aggr.adb: Fix typo in comment.
+
 2010-10-18  Javier Miranda  <miranda@adacore.com>
 
 	* exp_util.adb (Side_Effect_Free): Code clean up.
diff --git a/gcc/ada/a-assert.ads b/gcc/ada/a-assert.ads
index bfc2229..232201b 100755
--- a/gcc/ada/a-assert.ads
+++ b/gcc/ada/a-assert.ads
@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT RUN-TIME COMPONENTS                         --
 --                                                                          --
---                           A D A . A S S E R T                            --
+--                       A D A . A S S E R T I O N S                        --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index a205e5e..faf50cd 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -86,9 +86,11 @@ package body Aspects is
      (Name_Favor_Top_Level,              Aspect_Favor_Top_Level),
      (Name_Inline,                       Aspect_Inline),
      (Name_Inline_Always,                Aspect_Inline_Always),
+     (Name_Input,                        Aspect_Input),
      (Name_Invariant,                    Aspect_Invariant),
      (Name_Machine_Radix,                Aspect_Machine_Radix),
      (Name_Object_Size,                  Aspect_Object_Size),
+     (Name_Output,                       Aspect_Output),
      (Name_Pack,                         Aspect_Pack),
      (Name_Persistent_BSS,               Aspect_Persistent_BSS),
      (Name_Post,                         Aspect_Post),
@@ -96,6 +98,7 @@ package body Aspects is
      (Name_Predicate,                    Aspect_Predicate),
      (Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
      (Name_Pure_Function,                Aspect_Pure_Function),
+     (Name_Read,                         Aspect_Read),
      (Name_Shared,                       Aspect_Shared),
      (Name_Size,                         Aspect_Size),
      (Name_Storage_Pool,                 Aspect_Storage_Pool),
@@ -112,7 +115,8 @@ package body Aspects is
      (Name_Value_Size,                   Aspect_Value_Size),
      (Name_Volatile,                     Aspect_Volatile),
      (Name_Volatile_Components,          Aspect_Volatile_Components),
-     (Name_Warnings,                     Aspect_Warnings));
+     (Name_Warnings,                     Aspect_Warnings),
+     (Name_Write,                        Aspect_Write));
 
    -------------------------------------
    -- Hash Table for Aspect Id Values --
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index d7c0bc9..63cb765 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -56,10 +56,12 @@ package Aspects is
       Aspect_Favor_Top_Level,               -- GNAT
       Aspect_Inline,
       Aspect_Inline_Always,                 -- GNAT
+      Aspect_Input,
       Aspect_Invariant,
       Aspect_Machine_Radix,
       Aspect_No_Return,
       Aspect_Object_Size,                   -- GNAT
+      Aspect_Output,
       Aspect_Pack,
       Aspect_Persistent_BSS,                -- GNAT
       Aspect_Post,
@@ -67,6 +69,7 @@ package Aspects is
       Aspect_Predicate,                     -- GNAT???
       Aspect_Preelaborable_Initialization,
       Aspect_Pure_Function,                 -- GNAT
+      Aspect_Read,
       Aspect_Shared,                        -- GNAT (equivalent to Atomic)
       Aspect_Size,
       Aspect_Storage_Pool,
@@ -83,7 +86,8 @@ package Aspects is
       Aspect_Value_Size,                    -- GNAT
       Aspect_Volatile,
       Aspect_Volatile_Components,
-      Aspect_Warnings);                     -- GNAT
+      Aspect_Warnings,
+      Aspect_Write);                        -- GNAT
 
    --  The following array indicates aspects that accept 'Class
 
@@ -118,10 +122,12 @@ package Aspects is
                         Aspect_Favor_Top_Level              => Optional,
                         Aspect_Inline                       => Optional,
                         Aspect_Inline_Always                => Optional,
+                        Aspect_Input                        => Name,
                         Aspect_Invariant                    => Expression,
                         Aspect_Machine_Radix                => Expression,
                         Aspect_No_Return                    => Optional,
                         Aspect_Object_Size                  => Expression,
+                        Aspect_Output                       => Name,
                         Aspect_Persistent_BSS               => Optional,
                         Aspect_Pack                         => Optional,
                         Aspect_Post                         => Expression,
@@ -129,6 +135,7 @@ package Aspects is
                         Aspect_Predicate                    => Expression,
                         Aspect_Preelaborable_Initialization => Optional,
                         Aspect_Pure_Function                => Optional,
+                        Aspect_Read                         => Name,
                         Aspect_Shared                       => Optional,
                         Aspect_Size                         => Expression,
                         Aspect_Storage_Pool                 => Name,
@@ -145,7 +152,8 @@ package Aspects is
                         Aspect_Value_Size                   => Expression,
                         Aspect_Volatile                     => Optional,
                         Aspect_Volatile_Components          => Optional,
-                        Aspect_Warnings                     => Name);
+                        Aspect_Warnings                     => Name,
+                        Aspect_Write                        => Name);
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id;
    pragma Inline (Get_Aspect_Id);
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 566b1a3..1b1d9f5 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5421,7 +5421,7 @@ package body Exp_Aggr is
       --  of the following form (c1 and c2 are inherited components)
 
       --   (Exp with c3 => a, c4 => b)
-      --      ==> (c1 => Exp.c1, c2 => Exp.c2, c1 => a, c2 => b)
+      --      ==> (c1 => Exp.c1, c2 => Exp.c2, c3 => a, c4 => b)
 
       else
          Set_Etype (N, Typ);
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index 843dcd7..eb98696 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -1462,6 +1462,10 @@ package body GNAT.Command_Line is
    --  Start of processing for Get_Switches
 
    begin
+      if Config = null then
+         return "";
+      end if;
+
       Foreach (Config, Section => Section);
 
       --  Adding relevant aliases
diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb
index 2339e52..29465a1 100644
--- a/gcc/ada/s-taprop-mingw.adb
+++ b/gcc/ada/s-taprop-mingw.adb
@@ -794,6 +794,9 @@ package body System.Task_Primitives.Operations is
       pragma Import (C, Init_Float, "__gnat_init_float");
       --  Properly initializes the FPU for x86 systems
 
+      procedure Get_Stack_Bounds (Base : Address; Limit : Address);
+      pragma Import (C, Get_Stack_Bounds, "__gnat_get_stack_bounds");
+      --  Get stack boundaries
    begin
       Specific.Set (Self_ID);
       Init_Float;
@@ -806,6 +809,10 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Self_ID.Common.LL.Thread_Id := GetCurrentThreadId;
+
+      Get_Stack_Bounds
+        (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base'Address,
+         Self_ID.Common.Compiler_Data.Pri_Stack_Info.Limit'Address);
    end Enter_Task;
 
    --------------
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 4db2fb7..89dda5d 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -86,8 +86,8 @@ package body Sem_Ch10 is
    --  included in a standalone library.
 
    procedure Check_Private_Child_Unit (N : Node_Id);
-   --  If a with_clause mentions a private child unit, the compilation
-   --  unit must be a member of the same family, as described in 10.1.2.
+   --  If a with_clause mentions a private child unit, the compilation unit
+   --  must be a member of the same family, as described in 10.1.2.
 
    procedure Check_Stub_Level (N : Node_Id);
    --  Verify that a stub is declared immediately within a compilation unit,
@@ -126,8 +126,8 @@ package body Sem_Ch10 is
    --  example through a limited_with clause in a parent unit.
 
    procedure Install_Context_Clauses (N : Node_Id);
-   --  Subsidiary to Install_Context and Install_Parents. Process only with_
-   --  and use_clauses for current unit and its library unit if any.
+   --  Subsidiary to Install_Context and Install_Parents. Process all with
+   --  and use clauses for current unit and its library unit if any.
 
    procedure Install_Limited_Context_Clauses (N : Node_Id);
    --  Subsidiary to Install_Context. Process only limited with_clauses for
@@ -187,18 +187,18 @@ package body Sem_Ch10 is
    --  that all parents are removed in the nested case.
 
    procedure Remove_Unit_From_Visibility (Unit_Name : Entity_Id);
-   --  Reset all visibility flags on unit after compiling it, either as a
-   --  main unit or as a unit in the context.
+   --  Reset all visibility flags on unit after compiling it, either as a main
+   --  unit or as a unit in the context.
 
    procedure Unchain (E : Entity_Id);
    --  Remove single entity from visibility list
 
    procedure Analyze_Proper_Body (N : Node_Id; Nam : Entity_Id);
    --  Common processing for all stubs (subprograms, tasks, packages, and
-   --  protected cases). N is the stub to be analyzed. Once the subunit
-   --  name is established, load and analyze. Nam is the non-overloadable
-   --  entity for which the proper body provides a completion. Subprogram
-   --  stubs are handled differently because they can be declarations.
+   --  protected cases). N is the stub to be analyzed. Once the subunit name
+   --  is established, load and analyze. Nam is the non-overloadable entity
+   --  for which the proper body provides a completion. Subprogram stubs are
+   --  handled differently because they can be declarations.
 
    procedure sm;
    --  A dummy procedure, for debugging use, called just before analyzing the
@@ -272,11 +272,10 @@ package body Sem_Ch10 is
            Clause            : Node_Id;
            Used              : in out Boolean;
            Used_Type_Or_Elab : in out Boolean);
-         --  Examine the context clauses of a package body, trying to match
-         --  the name entity of Clause with any list element. If the match
-         --  occurs on a use package clause, set Used to True, for a use
-         --  type clause, pragma Elaborate or pragma Elaborate_All, set
-         --  Used_Type_Or_Elab to True.
+         --  Examine the context clauses of a package body, trying to match the
+         --  name entity of Clause with any list element. If the match occurs
+         --  on a use package clause set Used to True, for a use type clause or
+         --  pragma Elaborate[_All], set Used_Type_Or_Elab to True.
 
          procedure Process_Spec_Clauses
           (Context_List : List_Id;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d23868d..8966e15 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -870,13 +870,34 @@ package body Sem_Ch13 is
                         New_Occurrence_Of (E, Eloc),
                         Relocate_Node (Expr)),
                       Pragma_Identifier            =>
-                      Make_Identifier (Sloc (Id), Chars (Id)));
+                        Make_Identifier (Sloc (Id), Chars (Id)));
 
                   --  We don't have to play the delay game here, since the only
                   --  values are check names which don't get analyzed anyway.
 
                   Delay_Required := False;
 
+               --  Aspects corresponding to stream routines
+
+               when Aspect_Input  |
+                    Aspect_Output |
+                    Aspect_Read   |
+                    Aspect_Write  =>
+
+                  --  Construct the attribute definition clause
+
+                  Aitem :=
+                    Make_Attribute_Definition_Clause (Loc,
+                      Name       => Ent,
+                      Chars      => Chars (Id),
+                      Expression => Relocate_Node (Expr));
+
+                  --  These are always delayed (typically the subprogram that
+                  --  is referenced cannot have been declared yet, since it has
+                  --  a reference to the type for which this aspect is defined.
+
+                  Delay_Required := True;
+
                --  Aspects corresponding to pragmas with two arguments, where
                --  the second argument is a local name referring to the entity,
                --  and the first argument is the aspect definition expression.
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 2d6feb2..37efac8 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -99,7 +99,7 @@ package body Sem_Ch4 is
    --  the operand of the operator node.
 
    procedure Ambiguous_Operands (N : Node_Id);
-   --  for equality, membership, and comparison operators with overloaded
+   --  For equality, membership, and comparison operators with overloaded
    --  arguments, list possible interpretations.
 
    procedure Analyze_One_Call
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index bc228e4..761bed9 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -180,7 +180,7 @@ package body Sem_Ch6 is
    --  entity with that name.
 
    procedure Install_Entity (E : Entity_Id);
-   --  Make single entity visible. Used for generic formals as well
+   --  Make single entity visible (used for generic formals as well)
 
    function Is_Non_Overriding_Operation
      (Prev_E : Entity_Id;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index e53fb55..ae14084 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -254,9 +254,8 @@ package body Sem_Ch7 is
          end if;
 
          if Is_Package_Or_Generic_Package (Spec_Id)
-           and then
-             (Scope (Spec_Id) = Standard_Standard
-               or else Is_Child_Unit (Spec_Id))
+           and then (Scope (Spec_Id) = Standard_Standard
+                      or else Is_Child_Unit (Spec_Id))
            and then not Unit_Requires_Body (Spec_Id)
          then
             if Ada_Version = Ada_83 then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 461f509..c78d4a9 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9451,7 +9451,10 @@ package body Sem_Util is
                if Comes_From_Source (Exp)
                  or else Modification_Comes_From_Source
                then
-                  if Has_Pragma_Unmodified (Ent) then
+                  --  Give warning if pragma unmodified given and we are
+                  --  sure this is a modification.
+
+                  if Has_Pragma_Unmodified (Ent) and then Sure then
                      Error_Msg_NE ("?pragma Unmodified given for &!", N, Ent);
                   end if;
 
diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c
index 49d2f83..1961288 100644
--- a/gcc/ada/sysdep.c
+++ b/gcc/ada/sysdep.c
@@ -235,7 +235,7 @@ winflush_nt (void)
   /* Does nothing as there is no problem under NT.  */
 }
 
-#else
+#else /* !RTX */
 
 static void winflush_init (void);
 
@@ -301,9 +301,27 @@ __gnat_is_windows_xp (void)
   return is_win_xp;
 }
 
-#endif
+#endif /* !RTX */
 
-#endif
+/* Get the bounds of the stack.  The stack pointer is supposed to be
+   initialized to BASE when a thread is created and the stack can be extended
+   to LIMIT before reaching a guard page.
+   Note: for the main thread, the system automatically extend the stack, so
+   LIMIT is only the current limit.  */
+
+void
+__gnat_get_stack_bounds (void **base, void **limit)
+{
+  NT_TIB *tib;
+
+  /* We know that the first field of the TEB is the TIB.  */
+  tib = (NT_TIB *)NtCurrentTeb ();
+
+  *base = tib->StackBase;
+  *limit = tib->StackLimit;
+}
+
+#endif /* !__MINGW32__ */
 
 #else