+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,
-- --
-- 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 --
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;
-- --
-- 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- --
+ (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 --
-----------
-- --
-- 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 --
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;
-- --
-- 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- --
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 --
-----------
-- 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");
Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD);
end Wait_For_Release;
+
end Ada.Synchronous_Barriers;
-- 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
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,
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,
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,
(No_Aspect, -- Dummy entry for no aspect
Aspect_Address,
Aspect_Alignment,
+ Aspect_Attach_Handler,
Aspect_Bit_Order,
Aspect_Component_Size,
Aspect_Constant_Indexing,
Aspect_External_Tag,
Aspect_Implicit_Dereference,
Aspect_Input,
+ Aspect_Interrupt_Priority,
Aspect_Invariant,
Aspect_Iterator_Element,
Aspect_Machine_Radix,
Aspect_Pre,
Aspect_Precondition,
Aspect_Predicate, -- GNAT
+ Aspect_Priority,
Aspect_Read,
Aspect_Size,
+ Aspect_Small,
Aspect_Static_Predicate,
Aspect_Storage_Pool,
Aspect_Storage_Size,
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
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
(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,
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,
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,
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,
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,
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,
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,
& "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);
Aspect_Output |
Aspect_Read |
Aspect_Size |
+ Aspect_Small |
Aspect_Storage_Pool |
Aspect_Storage_Size |
Aspect_Stream_Size |
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.
-- 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;
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 =>
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));
projects / thirdparty / gcc.git / commitdiff
