2011-08-29 Thomas Quinot <quinot@adacore.com>

	* a-synbar-posix.adb: Minor reformatting.

2011-08-29  Jose Ruiz  <ruiz@adacore.com>

	* a-exetim-posix.adb, a-exetim-mingw.adb, a-exetim-mingw.ads,
	a-exetim-default.ads (Interrupt_Clocks_Supported,
	Separate_Interrupt_Clocks_Supported, Clock_For_Interrupts): Add these
	definitions to be compliant with AI-0171. The target systems do not
	support separate account for the execution time of interrupt handlers.

2011-08-29  Jose Ruiz  <ruiz@adacore.com>

	* a-synbar.adb (Wait): Change the order of evaluation of the conditions
	in the barrier to put first the easiest to evaluate (and the one which
	will be True more often). More efficient.

2011-08-29  Eric Botcazou  <ebotcazou@adacore.com>

	* s-atocou-x86.adb: Fix constraint in machine code insertion.

2011-08-29  Bob Duff  <duff@adacore.com>

	* aspects.ads, aspects.adb: Add new aspects for various pragmas and
	attributes that are now aspects, as specified by AI05-0229-1.
	* sem_ch13.adb (Analyze_Aspect_Specifications,
	Check_Aspect_At_Freeze_Point): Analyze the new aspects. Turn them into
	pragmas or attribute references, as appropriate.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178203 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 196 insertions, 16 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4dfff556c2b..17a2e5d2a34 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,33 @@
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+	* a-synbar-posix.adb: Minor reformatting.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-exetim-posix.adb, a-exetim-mingw.adb, a-exetim-mingw.ads,
+	a-exetim-default.ads (Interrupt_Clocks_Supported,
+	Separate_Interrupt_Clocks_Supported, Clock_For_Interrupts): Add these
+	definitions to be compliant with AI-0171. The target systems do not
+	support separate account for the execution time of interrupt handlers.
+
+2011-08-29  Jose Ruiz  <ruiz@adacore.com>
+
+	* a-synbar.adb (Wait): Change the order of evaluation of the conditions
+	in the barrier to put first the easiest to evaluate (and the one which
+	will be True more often). More efficient.
+
+2011-08-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* s-atocou-x86.adb: Fix constraint in machine code insertion.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+	* aspects.ads, aspects.adb: Add new aspects for various pragmas and
+	attributes that are now aspects, as specified by AI05-0229-1.
+	* sem_ch13.adb (Analyze_Aspect_Specifications,
+	Check_Aspect_At_Freeze_Point): Analyze the new aspects. Turn them into
+	pragmas or attribute references, as appropriate.
+
 2011-08-29  Robert Dewar  <dewar@adacore.com>
 
 	* a-synbar.ads, a-synbar.adb, a-synbar-posix.adb,
diff --git a/gcc/ada/a-exetim-default.ads b/gcc/ada/a-exetim-default.ads
index edc6f19a205..3267baad606 100644
--- a/gcc/ada/a-exetim-default.ads
+++ b/gcc/ada/a-exetim-default.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2007-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2007-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -81,6 +81,11 @@ package Ada.Execution_Time is
       TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
       return CPU_Time;
 
+   Interrupt_Clocks_Supported          : constant Boolean := False;
+   Separate_Interrupt_Clocks_Supported : constant Boolean := False;
+
+   function Clock_For_Interrupts return CPU_Time;
+
 private
 
    type CPU_Time is new Ada.Real_Time.Time;
diff --git a/gcc/ada/a-exetim-mingw.adb b/gcc/ada/a-exetim-mingw.adb
index 973817c0bec..c80d1128609 100755
--- a/gcc/ada/a-exetim-mingw.adb
+++ b/gcc/ada/a-exetim-mingw.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2007-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2007-2011, 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- --
@@ -129,6 +129,19 @@ package body Ada.Execution_Time is
                  + (Long_Long_Float (U_Time) / Hundreds_Nano_In_Sec))));
    end Clock;
 
+   --------------------------
+   -- Clock_For_Interrupts --
+   --------------------------
+
+   function Clock_For_Interrupts return CPU_Time is
+   begin
+      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
+      --  is set to False the function raises Program_Error.
+
+      raise Program_Error;
+      return CPU_Time_First;
+   end Clock_For_Interrupts;
+
    -----------
    -- Split --
    -----------
diff --git a/gcc/ada/a-exetim-mingw.ads b/gcc/ada/a-exetim-mingw.ads
index 374e066abe1..a2b68061838 100755
--- a/gcc/ada/a-exetim-mingw.ads
+++ b/gcc/ada/a-exetim-mingw.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2009  Free Software Foundation, Inc.           --
+--          Copyright (C) 2009-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -81,6 +81,11 @@ package Ada.Execution_Time is
        TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
        return CPU_Time;
 
+   Interrupt_Clocks_Supported          : constant Boolean := False;
+   Separate_Interrupt_Clocks_Supported : constant Boolean := False;
+
+   function Clock_For_Interrupts return CPU_Time;
+
 private
 
    type CPU_Time is new Ada.Real_Time.Time;
diff --git a/gcc/ada/a-exetim-posix.adb b/gcc/ada/a-exetim-posix.adb
index fe00abe5595..65b21d61d7a 100644
--- a/gcc/ada/a-exetim-posix.adb
+++ b/gcc/ada/a-exetim-posix.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2007-2010, Free Software Foundation, Inc.          --
+--         Copyright (C) 2007-2011, 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- --
@@ -127,6 +127,19 @@ package body Ada.Execution_Time is
       return To_CPU_Time (To_Duration (TS));
    end Clock;
 
+   --------------------------
+   -- Clock_For_Interrupts --
+   --------------------------
+
+   function Clock_For_Interrupts return CPU_Time is
+   begin
+      --  According to AI 0170-1, D.14(18.1/3), if Interrupt_Clocks_Supported
+      --  is set to False the function raises Program_Error.
+
+      raise Program_Error;
+      return CPU_Time_First;
+   end Clock_For_Interrupts;
+
    -----------
    -- Split --
    -----------
diff --git a/gcc/ada/a-synbar-posix.adb b/gcc/ada/a-synbar-posix.adb
index c98a460dcdf..73dc9fa2008 100644
--- a/gcc/ada/a-synbar-posix.adb
+++ b/gcc/ada/a-synbar-posix.adb
@@ -52,7 +52,6 @@ package body Ada.Synchronous_Barriers is
    --  when count waiters arrived. If attr is null the default barrier
    --  attributes shall be used.
 
-   --  Destroy a previously dynamically initialized barrier
    function pthread_barrier_destroy
      (barrier : not null access pthread_barrier_t) return int;
    pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy");
@@ -106,4 +105,5 @@ package body Ada.Synchronous_Barriers is
 
       Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD);
    end Wait_For_Release;
+
 end Ada.Synchronous_Barriers;
diff --git a/gcc/ada/a-synbar.adb b/gcc/ada/a-synbar.adb
index 8142dcd395f..7966b23b727 100644
--- a/gcc/ada/a-synbar.adb
+++ b/gcc/ada/a-synbar.adb
@@ -44,7 +44,7 @@ package body Ada.Synchronous_Barriers is
       --  barrier will remain open only for those tasks already inside.
 
       entry Wait (Notified : out Boolean)
-        when Wait'Count = Release_Threshold or else Keep_Open
+        when Keep_Open or else Wait'Count = Release_Threshold
       is
       begin
          --  If we are executing the entry it means that the required number of
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 74d17c7cea7..43d0df600c2 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -185,8 +185,10 @@ package body Aspects is
     Aspect_Ada_2012                     => Aspect_Ada_2005,
     Aspect_Address                      => Aspect_Address,
     Aspect_Alignment                    => Aspect_Alignment,
+    Aspect_Asynchronous                 => Aspect_Asynchronous,
     Aspect_Atomic                       => Aspect_Atomic,
     Aspect_Atomic_Components            => Aspect_Atomic_Components,
+    Aspect_Attach_Handler               => Aspect_Attach_Handler,
     Aspect_Bit_Order                    => Aspect_Bit_Order,
     Aspect_Component_Size               => Aspect_Component_Size,
     Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
@@ -198,8 +200,12 @@ package body Aspects is
     Aspect_External_Tag                 => Aspect_External_Tag,
     Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,
     Aspect_Implicit_Dereference         => Aspect_Implicit_Dereference,
+    Aspect_Independent                  => Aspect_Independent,
+    Aspect_Independent_Components       => Aspect_Independent_Components,
     Aspect_Inline                       => Aspect_Inline,
     Aspect_Inline_Always                => Aspect_Inline,
+    Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
+    Aspect_Interrupt_Priority           => Aspect_Interrupt_Priority,
     Aspect_Iterator_Element             => Aspect_Iterator_Element,
     Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
     Aspect_Compiler_Unit                => Aspect_Compiler_Unit,
@@ -226,10 +232,12 @@ package body Aspects is
     Aspect_Precondition                 => Aspect_Pre,
     Aspect_Predicate                    => Aspect_Predicate,
     Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
+    Aspect_Priority                     => Aspect_Priority,
     Aspect_Pure_Function                => Aspect_Pure_Function,
     Aspect_Read                         => Aspect_Read,
     Aspect_Shared                       => Aspect_Atomic,
     Aspect_Size                         => Aspect_Size,
+    Aspect_Small                        => Aspect_Small,
     Aspect_Static_Predicate             => Aspect_Predicate,
     Aspect_Storage_Pool                 => Aspect_Storage_Pool,
     Aspect_Storage_Size                 => Aspect_Storage_Size,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index af4448f3ce9..ee992a6383f 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -46,6 +46,7 @@ package Aspects is
      (No_Aspect,                            -- Dummy entry for no aspect
       Aspect_Address,
       Aspect_Alignment,
+      Aspect_Attach_Handler,
       Aspect_Bit_Order,
       Aspect_Component_Size,
       Aspect_Constant_Indexing,
@@ -56,6 +57,7 @@ package Aspects is
       Aspect_External_Tag,
       Aspect_Implicit_Dereference,
       Aspect_Input,
+      Aspect_Interrupt_Priority,
       Aspect_Invariant,
       Aspect_Iterator_Element,
       Aspect_Machine_Radix,
@@ -66,8 +68,10 @@ package Aspects is
       Aspect_Pre,
       Aspect_Precondition,
       Aspect_Predicate,                     -- GNAT
+      Aspect_Priority,
       Aspect_Read,
       Aspect_Size,
+      Aspect_Small,
       Aspect_Static_Predicate,
       Aspect_Storage_Pool,
       Aspect_Storage_Size,
@@ -104,12 +108,16 @@ package Aspects is
 
       Aspect_Ada_2005,                      -- GNAT
       Aspect_Ada_2012,                      -- GNAT
+      Aspect_Asynchronous,
       Aspect_Atomic,
       Aspect_Atomic_Components,
       Aspect_Discard_Names,
       Aspect_Favor_Top_Level,               -- GNAT
+      Aspect_Independent,
+      Aspect_Independent_Components,
       Aspect_Inline,
       Aspect_Inline_Always,                 -- GNAT
+      Aspect_Interrupt_Handler,
       Aspect_No_Return,
       Aspect_Pack,
       Aspect_Persistent_BSS,                -- GNAT
@@ -166,7 +174,7 @@ package Aspects is
 
    type Aspect_Expression is
      (Optional,               -- Optional boolean expression
-      Expression,             -- Required non-boolean expression
+      Expression,             -- Required expression
       Name);                  -- Required name
 
    --  The following array indicates what argument type is required
@@ -175,6 +183,7 @@ package Aspects is
                        (No_Aspect                      => Optional,
                         Aspect_Address                 => Expression,
                         Aspect_Alignment               => Expression,
+                        Aspect_Attach_Handler          => Expression,
                         Aspect_Bit_Order               => Expression,
                         Aspect_Component_Size          => Expression,
                         Aspect_Constant_Indexing       => Name,
@@ -185,6 +194,7 @@ package Aspects is
                         Aspect_External_Tag            => Expression,
                         Aspect_Implicit_Dereference    => Name,
                         Aspect_Input                   => Name,
+                        Aspect_Interrupt_Priority      => Expression,
                         Aspect_Invariant               => Expression,
                         Aspect_Iterator_Element        => Name,
                         Aspect_Machine_Radix           => Expression,
@@ -195,8 +205,10 @@ package Aspects is
                         Aspect_Pre                     => Expression,
                         Aspect_Precondition            => Expression,
                         Aspect_Predicate               => Expression,
+                        Aspect_Priority                => Expression,
                         Aspect_Read                    => Name,
                         Aspect_Size                    => Expression,
+                        Aspect_Small                   => Expression,
                         Aspect_Static_Predicate        => Expression,
                         Aspect_Storage_Pool            => Name,
                         Aspect_Storage_Size            => Expression,
@@ -226,8 +238,10 @@ package Aspects is
      Aspect_Address                      => Name_Address,
      Aspect_Alignment                    => Name_Alignment,
      Aspect_All_Calls_Remote             => Name_All_Calls_Remote,
+     Aspect_Asynchronous                 => Name_Asynchronous,
      Aspect_Atomic                       => Name_Atomic,
      Aspect_Atomic_Components            => Name_Atomic_Components,
+     Aspect_Attach_Handler               => Name_Attach_Handler,
      Aspect_Bit_Order                    => Name_Bit_Order,
      Aspect_Compiler_Unit                => Name_Compiler_Unit,
      Aspect_Component_Size               => Name_Component_Size,
@@ -241,9 +255,13 @@ package Aspects is
      Aspect_External_Tag                 => Name_External_Tag,
      Aspect_Favor_Top_Level              => Name_Favor_Top_Level,
      Aspect_Implicit_Dereference         => Name_Implicit_Dereference,
+     Aspect_Independent                  => Name_Independent,
+     Aspect_Independent_Components       => Name_Independent_Components,
      Aspect_Inline                       => Name_Inline,
      Aspect_Inline_Always                => Name_Inline_Always,
      Aspect_Input                        => Name_Input,
+     Aspect_Interrupt_Handler            => Name_Interrupt_Handler,
+     Aspect_Interrupt_Priority           => Name_Interrupt_Priority,
      Aspect_Invariant                    => Name_Invariant,
      Aspect_Iterator_Element             => Name_Iterator_Element,
      Aspect_Machine_Radix                => Name_Machine_Radix,
@@ -260,6 +278,7 @@ package Aspects is
      Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization,
      Aspect_Preelaborate                 => Name_Preelaborate,
      Aspect_Preelaborate_05              => Name_Preelaborate_05,
+     Aspect_Priority                     => Name_Priority,
      Aspect_Pure                         => Name_Pure,
      Aspect_Pure_05                      => Name_Pure_05,
      Aspect_Pure_Function                => Name_Pure_Function,
@@ -269,6 +288,7 @@ package Aspects is
      Aspect_Shared                       => Name_Shared,
      Aspect_Shared_Passive               => Name_Shared_Passive,
      Aspect_Size                         => Name_Size,
+     Aspect_Small                        => Name_Small,
      Aspect_Static_Predicate             => Name_Static_Predicate,
      Aspect_Storage_Pool                 => Name_Storage_Pool,
      Aspect_Storage_Size                 => Name_Storage_Size,
diff --git a/gcc/ada/s-atocou-x86.adb b/gcc/ada/s-atocou-x86.adb
index 1625ebaecbe..f7c0bcb3147 100644
--- a/gcc/ada/s-atocou-x86.adb
+++ b/gcc/ada/s-atocou-x86.adb
@@ -54,7 +54,7 @@ package body System.Atomic_Counters is
              & "sete %1",
          Outputs  =>
            (Unsigned_32'Asm_Output ("=m", Item.Value),
-            Boolean'Asm_Output ("=rm", Aux)),
+            Boolean'Asm_Output ("=qm", Aux)),
          Inputs   => Unsigned_32'Asm_Input ("m", Item.Value),
          Volatile => True);
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b0ea4da08ec..b6d00db9450 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1026,6 +1026,7 @@ package body Sem_Ch13 is
                     Aspect_Output         |
                     Aspect_Read           |
                     Aspect_Size           |
+                    Aspect_Small          |
                     Aspect_Storage_Pool   |
                     Aspect_Storage_Size   |
                     Aspect_Stream_Size    |
@@ -1135,6 +1136,36 @@ package body Sem_Ch13 is
                   Set_Is_Delayed_Aspect (Aspect);
                   Set_Has_Default_Aspect (Base_Type (Entity (Ent)));
 
+               when Aspect_Attach_Handler =>
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Name_Attach_Handler),
+                      Pragma_Argument_Associations =>
+                        New_List (Ent, Relocate_Node (Expr)));
+
+                  Set_From_Aspect_Specification (Aitem, True);
+
+               when Aspect_Priority | Aspect_Interrupt_Priority => declare
+                  Pname : Name_Id;
+
+               begin
+                  if A_Id = Aspect_Priority then
+                     Pname := Name_Priority;
+                  else
+                     Pname := Name_Interrupt_Priority;
+                  end if;
+
+                  Aitem :=
+                    Make_Pragma (Loc,
+                      Pragma_Identifier            =>
+                        Make_Identifier (Sloc (Id), Pname),
+                      Pragma_Argument_Associations =>
+                        New_List (Relocate_Node (Expr)));
+
+                  Set_From_Aspect_Specification (Aitem, True);
+               end;
+
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
                --  with a first argument that is the expression, and a second
                --  argument that is an informative message if the test fails.
@@ -1433,18 +1464,64 @@ package body Sem_Ch13 is
                --  Here if not compilation unit case
 
                else
-                  --  For Pre/Post cases, insert immediately after the entity
-                  --  declaration, since that is the required pragma placement.
+                  case A_Id is
+                     --  For Pre/Post cases, insert immediately after the
+                     --  entity declaration, since that is the required pragma
+                     --  placement.
 
-                  if A_Id in Pre_Post_Aspects then
-                     Insert_After (N, Aitem);
+                     when Pre_Post_Aspects =>
+                        Insert_After (N, Aitem);
+
+                     --  For Priority aspects, insert into the task or
+                     --  protected definition, which we need to create if it's
+                     --  not there.
+
+                     when Aspect_Priority | Aspect_Interrupt_Priority =>
+                        declare
+                           T : Node_Id; -- the type declaration
+                           L : List_Id; -- list of decls of task/protected
+
+                        begin
+                           if Nkind (N) = N_Object_Declaration then
+                              T := Parent (Etype (Defining_Identifier (N)));
+
+                           else
+                              T := N;
+                           end if;
+
+                           if Nkind (T) = N_Protected_Type_Declaration then
+                              pragma Assert
+                                (Present (Protected_Definition (T)));
+
+                              L := Visible_Declarations
+                                     (Protected_Definition (T));
+
+                           elsif Nkind (T) = N_Task_Type_Declaration then
+                              if No (Task_Definition (T)) then
+                                 Set_Task_Definition
+                                   (T,
+                                    Make_Task_Definition
+                                      (Sloc (T),
+                                       Visible_Declarations => New_List,
+                                       End_Label => Empty));
+                              end if;
+
+                              L := Visible_Declarations
+                                     (Task_Definition (T));
+
+                           else
+                              raise Program_Error;
+                           end if;
+
+                           Prepend (Aitem, To => L);
+                        end;
 
                   --  For all other cases, insert in sequence
 
-                  else
-                     Insert_After (Ins_Node, Aitem);
-                     Ins_Node := Aitem;
-                  end if;
+                     when others =>
+                        Insert_After (Ins_Node, Aitem);
+                        Ins_Node := Aitem;
+                  end case;
                end if;
             end if;
          end;
@@ -5758,6 +5835,9 @@ package body Sem_Ch13 is
          when Aspect_Test_Case =>
             raise Program_Error;
 
+         when Aspect_Attach_Handler =>
+            T := RTE (RE_Interrupt_ID);
+
          --  Default_Value is resolved with the type entity in question
 
          when Aspect_Default_Value =>
@@ -5779,6 +5859,12 @@ package body Sem_Ch13 is
          when Aspect_External_Tag =>
             T := Standard_String;
 
+         when Aspect_Priority | Aspect_Interrupt_Priority =>
+            T := Standard_Integer;
+
+         when Aspect_Small =>
+            T := Universal_Real;
+
          when Aspect_Storage_Pool =>
             T := Class_Wide_Type (RTE (RE_Root_Storage_Pool));