summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-29 11:04:03 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2011-08-29 11:04:03 +0000
commit7f694ca266b36e36030869f26f2359f7624a0245 (patch)
tree4aba7bb8be42df71db6f5f369d691f9ddcdf7256
parent27f427e4789eb74d3ba3ccd667ec3b9f93a1503d (diff)
downloadgcc-7f694ca266b36e36030869f26f2359f7624a0245.tar.gz
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
-rw-r--r--gcc/ada/ChangeLog30
-rw-r--r--gcc/ada/a-exetim-default.ads7
-rwxr-xr-xgcc/ada/a-exetim-mingw.adb15
-rwxr-xr-xgcc/ada/a-exetim-mingw.ads7
-rw-r--r--gcc/ada/a-exetim-posix.adb15
-rw-r--r--gcc/ada/a-synbar-posix.adb2
-rw-r--r--gcc/ada/a-synbar.adb2
-rwxr-xr-xgcc/ada/aspects.adb8
-rwxr-xr-xgcc/ada/aspects.ads22
-rw-r--r--gcc/ada/s-atocou-x86.adb2
-rw-r--r--gcc/ada/sem_ch13.adb102
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));