Skip to content

R
riscv-gcc-1
Commit 2ef48385 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r178203
parent 0db16b1e
Showing with 196 additions and 16 deletions
gcc/ada/ChangeLog
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,
......
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;
......
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 --
-----------
......
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;
......
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 --
-----------
......
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;
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
......
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,
......
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,
......
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);
......
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));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment