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 193 additions and 13 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> 2011-08-29 Robert Dewar <dewar@adacore.com>
* a-synbar.ads, a-synbar.adb, a-synbar-posix.adb, * a-synbar.ads, a-synbar.adb, a-synbar-posix.adb,
......
gcc/ada/a-exetim-default.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -81,6 +81,11 @@ package Ada.Execution_Time is ...@@ -81,6 +81,11 @@ package Ada.Execution_Time is
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero) TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
return CPU_Time; return CPU_Time;
Interrupt_Clocks_Supported : constant Boolean := False;
Separate_Interrupt_Clocks_Supported : constant Boolean := False;
function Clock_For_Interrupts return CPU_Time;
private private
type CPU_Time is new Ada.Real_Time.Time; type CPU_Time is new Ada.Real_Time.Time;
......
gcc/ada/a-exetim-mingw.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -129,6 +129,19 @@ package body Ada.Execution_Time is ...@@ -129,6 +129,19 @@ package body Ada.Execution_Time is
+ (Long_Long_Float (U_Time) / Hundreds_Nano_In_Sec)))); + (Long_Long_Float (U_Time) / Hundreds_Nano_In_Sec))));
end Clock; 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 -- -- Split --
----------- -----------
......
gcc/ada/a-exetim-mingw.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -81,6 +81,11 @@ package Ada.Execution_Time is ...@@ -81,6 +81,11 @@ package Ada.Execution_Time is
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero) TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
return CPU_Time; return CPU_Time;
Interrupt_Clocks_Supported : constant Boolean := False;
Separate_Interrupt_Clocks_Supported : constant Boolean := False;
function Clock_For_Interrupts return CPU_Time;
private private
type CPU_Time is new Ada.Real_Time.Time; type CPU_Time is new Ada.Real_Time.Time;
......
gcc/ada/a-exetim-posix.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -127,6 +127,19 @@ package body Ada.Execution_Time is ...@@ -127,6 +127,19 @@ package body Ada.Execution_Time is
return To_CPU_Time (To_Duration (TS)); return To_CPU_Time (To_Duration (TS));
end Clock; 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 -- -- Split --
----------- -----------
......
gcc/ada/a-synbar-posix.adb
...@@ -52,7 +52,6 @@ package body Ada.Synchronous_Barriers is ...@@ -52,7 +52,6 @@ package body Ada.Synchronous_Barriers is
-- when count waiters arrived. If attr is null the default barrier -- when count waiters arrived. If attr is null the default barrier
-- attributes shall be used. -- attributes shall be used.
-- Destroy a previously dynamically initialized barrier
function pthread_barrier_destroy function pthread_barrier_destroy
(barrier : not null access pthread_barrier_t) return int; (barrier : not null access pthread_barrier_t) return int;
pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy"); pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy");
...@@ -106,4 +105,5 @@ package body Ada.Synchronous_Barriers is ...@@ -106,4 +105,5 @@ package body Ada.Synchronous_Barriers is
Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD); Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD);
end Wait_For_Release; end Wait_For_Release;
end Ada.Synchronous_Barriers; end Ada.Synchronous_Barriers;
gcc/ada/a-synbar.adb
...@@ -44,7 +44,7 @@ package body Ada.Synchronous_Barriers is ...@@ -44,7 +44,7 @@ package body Ada.Synchronous_Barriers is
-- barrier will remain open only for those tasks already inside. -- barrier will remain open only for those tasks already inside.
entry Wait (Notified : out Boolean) entry Wait (Notified : out Boolean)
when Wait'Count = Release_Threshold or else Keep_Open when Keep_Open or else Wait'Count = Release_Threshold
is is
begin begin
-- If we are executing the entry it means that the required number of -- 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 ...@@ -185,8 +185,10 @@ package body Aspects is
Aspect_Ada_2012 => Aspect_Ada_2005, Aspect_Ada_2012 => Aspect_Ada_2005,
Aspect_Address => Aspect_Address, Aspect_Address => Aspect_Address,
Aspect_Alignment => Aspect_Alignment, Aspect_Alignment => Aspect_Alignment,
Aspect_Asynchronous => Aspect_Asynchronous,
Aspect_Atomic => Aspect_Atomic, Aspect_Atomic => Aspect_Atomic,
Aspect_Atomic_Components => Aspect_Atomic_Components, Aspect_Atomic_Components => Aspect_Atomic_Components,
Aspect_Attach_Handler => Aspect_Attach_Handler,
Aspect_Bit_Order => Aspect_Bit_Order, Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Component_Size => Aspect_Component_Size, Aspect_Component_Size => Aspect_Component_Size,
Aspect_Constant_Indexing => Aspect_Constant_Indexing, Aspect_Constant_Indexing => Aspect_Constant_Indexing,
...@@ -198,8 +200,12 @@ package body Aspects is ...@@ -198,8 +200,12 @@ package body Aspects is
Aspect_External_Tag => Aspect_External_Tag, Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level, Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
Aspect_Implicit_Dereference => Aspect_Implicit_Dereference, Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
Aspect_Independent => Aspect_Independent,
Aspect_Independent_Components => Aspect_Independent_Components,
Aspect_Inline => Aspect_Inline, Aspect_Inline => Aspect_Inline,
Aspect_Inline_Always => 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_Iterator_Element => Aspect_Iterator_Element,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote, Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
Aspect_Compiler_Unit => Aspect_Compiler_Unit, Aspect_Compiler_Unit => Aspect_Compiler_Unit,
...@@ -226,10 +232,12 @@ package body Aspects is ...@@ -226,10 +232,12 @@ package body Aspects is
Aspect_Precondition => Aspect_Pre, Aspect_Precondition => Aspect_Pre,
Aspect_Predicate => Aspect_Predicate, Aspect_Predicate => Aspect_Predicate,
Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization, Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
Aspect_Priority => Aspect_Priority,
Aspect_Pure_Function => Aspect_Pure_Function, Aspect_Pure_Function => Aspect_Pure_Function,
Aspect_Read => Aspect_Read, Aspect_Read => Aspect_Read,
Aspect_Shared => Aspect_Atomic, Aspect_Shared => Aspect_Atomic,
Aspect_Size => Aspect_Size, Aspect_Size => Aspect_Size,
Aspect_Small => Aspect_Small,
Aspect_Static_Predicate => Aspect_Predicate, Aspect_Static_Predicate => Aspect_Predicate,
Aspect_Storage_Pool => Aspect_Storage_Pool, Aspect_Storage_Pool => Aspect_Storage_Pool,
Aspect_Storage_Size => Aspect_Storage_Size, Aspect_Storage_Size => Aspect_Storage_Size,
......
gcc/ada/aspects.ads
...@@ -46,6 +46,7 @@ package Aspects is ...@@ -46,6 +46,7 @@ package Aspects is
(No_Aspect, -- Dummy entry for no aspect (No_Aspect, -- Dummy entry for no aspect
Aspect_Address, Aspect_Address,
Aspect_Alignment, Aspect_Alignment,
Aspect_Attach_Handler,
Aspect_Bit_Order, Aspect_Bit_Order,
Aspect_Component_Size, Aspect_Component_Size,
Aspect_Constant_Indexing, Aspect_Constant_Indexing,
...@@ -56,6 +57,7 @@ package Aspects is ...@@ -56,6 +57,7 @@ package Aspects is
Aspect_External_Tag, Aspect_External_Tag,
Aspect_Implicit_Dereference, Aspect_Implicit_Dereference,
Aspect_Input, Aspect_Input,
Aspect_Interrupt_Priority,
Aspect_Invariant, Aspect_Invariant,
Aspect_Iterator_Element, Aspect_Iterator_Element,
Aspect_Machine_Radix, Aspect_Machine_Radix,
...@@ -66,8 +68,10 @@ package Aspects is ...@@ -66,8 +68,10 @@ package Aspects is
Aspect_Pre, Aspect_Pre,
Aspect_Precondition, Aspect_Precondition,
Aspect_Predicate, -- GNAT Aspect_Predicate, -- GNAT
Aspect_Priority,
Aspect_Read, Aspect_Read,
Aspect_Size, Aspect_Size,
Aspect_Small,
Aspect_Static_Predicate, Aspect_Static_Predicate,
Aspect_Storage_Pool, Aspect_Storage_Pool,
Aspect_Storage_Size, Aspect_Storage_Size,
...@@ -104,12 +108,16 @@ package Aspects is ...@@ -104,12 +108,16 @@ package Aspects is
Aspect_Ada_2005, -- GNAT Aspect_Ada_2005, -- GNAT
Aspect_Ada_2012, -- GNAT Aspect_Ada_2012, -- GNAT
Aspect_Asynchronous,
Aspect_Atomic, Aspect_Atomic,
Aspect_Atomic_Components, Aspect_Atomic_Components,
Aspect_Discard_Names, Aspect_Discard_Names,
Aspect_Favor_Top_Level, -- GNAT Aspect_Favor_Top_Level, -- GNAT
Aspect_Independent,
Aspect_Independent_Components,
Aspect_Inline, Aspect_Inline,
Aspect_Inline_Always, -- GNAT Aspect_Inline_Always, -- GNAT
Aspect_Interrupt_Handler,
Aspect_No_Return, Aspect_No_Return,
Aspect_Pack, Aspect_Pack,
Aspect_Persistent_BSS, -- GNAT Aspect_Persistent_BSS, -- GNAT
...@@ -166,7 +174,7 @@ package Aspects is ...@@ -166,7 +174,7 @@ package Aspects is
type Aspect_Expression is type Aspect_Expression is
(Optional, -- Optional boolean expression (Optional, -- Optional boolean expression
Expression, -- Required non-boolean expression Expression, -- Required expression
Name); -- Required name Name); -- Required name
-- The following array indicates what argument type is required -- The following array indicates what argument type is required
...@@ -175,6 +183,7 @@ package Aspects is ...@@ -175,6 +183,7 @@ package Aspects is
(No_Aspect => Optional, (No_Aspect => Optional,
Aspect_Address => Expression, Aspect_Address => Expression,
Aspect_Alignment => Expression, Aspect_Alignment => Expression,
Aspect_Attach_Handler => Expression,
Aspect_Bit_Order => Expression, Aspect_Bit_Order => Expression,
Aspect_Component_Size => Expression, Aspect_Component_Size => Expression,
Aspect_Constant_Indexing => Name, Aspect_Constant_Indexing => Name,
...@@ -185,6 +194,7 @@ package Aspects is ...@@ -185,6 +194,7 @@ package Aspects is
Aspect_External_Tag => Expression, Aspect_External_Tag => Expression,
Aspect_Implicit_Dereference => Name, Aspect_Implicit_Dereference => Name,
Aspect_Input => Name, Aspect_Input => Name,
Aspect_Interrupt_Priority => Expression,
Aspect_Invariant => Expression, Aspect_Invariant => Expression,
Aspect_Iterator_Element => Name, Aspect_Iterator_Element => Name,
Aspect_Machine_Radix => Expression, Aspect_Machine_Radix => Expression,
...@@ -195,8 +205,10 @@ package Aspects is ...@@ -195,8 +205,10 @@ package Aspects is
Aspect_Pre => Expression, Aspect_Pre => Expression,
Aspect_Precondition => Expression, Aspect_Precondition => Expression,
Aspect_Predicate => Expression, Aspect_Predicate => Expression,
Aspect_Priority => Expression,
Aspect_Read => Name, Aspect_Read => Name,
Aspect_Size => Expression, Aspect_Size => Expression,
Aspect_Small => Expression,
Aspect_Static_Predicate => Expression, Aspect_Static_Predicate => Expression,
Aspect_Storage_Pool => Name, Aspect_Storage_Pool => Name,
Aspect_Storage_Size => Expression, Aspect_Storage_Size => Expression,
...@@ -226,8 +238,10 @@ package Aspects is ...@@ -226,8 +238,10 @@ package Aspects is
Aspect_Address => Name_Address, Aspect_Address => Name_Address,
Aspect_Alignment => Name_Alignment, Aspect_Alignment => Name_Alignment,
Aspect_All_Calls_Remote => Name_All_Calls_Remote, Aspect_All_Calls_Remote => Name_All_Calls_Remote,
Aspect_Asynchronous => Name_Asynchronous,
Aspect_Atomic => Name_Atomic, Aspect_Atomic => Name_Atomic,
Aspect_Atomic_Components => Name_Atomic_Components, Aspect_Atomic_Components => Name_Atomic_Components,
Aspect_Attach_Handler => Name_Attach_Handler,
Aspect_Bit_Order => Name_Bit_Order, Aspect_Bit_Order => Name_Bit_Order,
Aspect_Compiler_Unit => Name_Compiler_Unit, Aspect_Compiler_Unit => Name_Compiler_Unit,
Aspect_Component_Size => Name_Component_Size, Aspect_Component_Size => Name_Component_Size,
...@@ -241,9 +255,13 @@ package Aspects is ...@@ -241,9 +255,13 @@ package Aspects is
Aspect_External_Tag => Name_External_Tag, Aspect_External_Tag => Name_External_Tag,
Aspect_Favor_Top_Level => Name_Favor_Top_Level, Aspect_Favor_Top_Level => Name_Favor_Top_Level,
Aspect_Implicit_Dereference => Name_Implicit_Dereference, Aspect_Implicit_Dereference => Name_Implicit_Dereference,
Aspect_Independent => Name_Independent,
Aspect_Independent_Components => Name_Independent_Components,
Aspect_Inline => Name_Inline, Aspect_Inline => Name_Inline,
Aspect_Inline_Always => Name_Inline_Always, Aspect_Inline_Always => Name_Inline_Always,
Aspect_Input => Name_Input, Aspect_Input => Name_Input,
Aspect_Interrupt_Handler => Name_Interrupt_Handler,
Aspect_Interrupt_Priority => Name_Interrupt_Priority,
Aspect_Invariant => Name_Invariant, Aspect_Invariant => Name_Invariant,
Aspect_Iterator_Element => Name_Iterator_Element, Aspect_Iterator_Element => Name_Iterator_Element,
Aspect_Machine_Radix => Name_Machine_Radix, Aspect_Machine_Radix => Name_Machine_Radix,
...@@ -260,6 +278,7 @@ package Aspects is ...@@ -260,6 +278,7 @@ package Aspects is
Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization,
Aspect_Preelaborate => Name_Preelaborate, Aspect_Preelaborate => Name_Preelaborate,
Aspect_Preelaborate_05 => Name_Preelaborate_05, Aspect_Preelaborate_05 => Name_Preelaborate_05,
Aspect_Priority => Name_Priority,
Aspect_Pure => Name_Pure, Aspect_Pure => Name_Pure,
Aspect_Pure_05 => Name_Pure_05, Aspect_Pure_05 => Name_Pure_05,
Aspect_Pure_Function => Name_Pure_Function, Aspect_Pure_Function => Name_Pure_Function,
...@@ -269,6 +288,7 @@ package Aspects is ...@@ -269,6 +288,7 @@ package Aspects is
Aspect_Shared => Name_Shared, Aspect_Shared => Name_Shared,
Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Shared_Passive => Name_Shared_Passive,
Aspect_Size => Name_Size, Aspect_Size => Name_Size,
Aspect_Small => Name_Small,
Aspect_Static_Predicate => Name_Static_Predicate, Aspect_Static_Predicate => Name_Static_Predicate,
Aspect_Storage_Pool => Name_Storage_Pool, Aspect_Storage_Pool => Name_Storage_Pool,
Aspect_Storage_Size => Name_Storage_Size, Aspect_Storage_Size => Name_Storage_Size,
......
gcc/ada/s-atocou-x86.adb
...@@ -54,7 +54,7 @@ package body System.Atomic_Counters is ...@@ -54,7 +54,7 @@ package body System.Atomic_Counters is
& "sete %1", & "sete %1",
Outputs => Outputs =>
(Unsigned_32'Asm_Output ("=m", Item.Value), (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), Inputs => Unsigned_32'Asm_Input ("m", Item.Value),
Volatile => True); Volatile => True);
......
gcc/ada/sem_ch13.adb
...@@ -1026,6 +1026,7 @@ package body Sem_Ch13 is ...@@ -1026,6 +1026,7 @@ package body Sem_Ch13 is
Aspect_Output | Aspect_Output |
Aspect_Read | Aspect_Read |
Aspect_Size | Aspect_Size |
Aspect_Small |
Aspect_Storage_Pool | Aspect_Storage_Pool |
Aspect_Storage_Size | Aspect_Storage_Size |
Aspect_Stream_Size | Aspect_Stream_Size |
...@@ -1135,6 +1136,36 @@ package body Sem_Ch13 is ...@@ -1135,6 +1136,36 @@ package body Sem_Ch13 is
Set_Is_Delayed_Aspect (Aspect); Set_Is_Delayed_Aspect (Aspect);
Set_Has_Default_Aspect (Base_Type (Entity (Ent))); 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 -- Aspects Pre/Post generate Precondition/Postcondition pragmas
-- with a first argument that is the expression, and a second -- with a first argument that is the expression, and a second
-- argument that is an informative message if the test fails. -- argument that is an informative message if the test fails.
...@@ -1433,18 +1464,64 @@ package body Sem_Ch13 is ...@@ -1433,18 +1464,64 @@ package body Sem_Ch13 is
-- Here if not compilation unit case -- Here if not compilation unit case
else else
-- For Pre/Post cases, insert immediately after the entity case A_Id is
-- declaration, since that is the required pragma placement. -- 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 when Pre_Post_Aspects =>
Insert_After (N, Aitem); Insert_After (N, Aitem);
-- For all other cases, insert in sequence -- 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 else
raise Program_Error;
end if;
Prepend (Aitem, To => L);
end;
-- For all other cases, insert in sequence
when others =>
Insert_After (Ins_Node, Aitem); Insert_After (Ins_Node, Aitem);
Ins_Node := Aitem; Ins_Node := Aitem;
end if; end case;
end if; end if;
end if; end if;
end; end;
...@@ -5758,6 +5835,9 @@ package body Sem_Ch13 is ...@@ -5758,6 +5835,9 @@ package body Sem_Ch13 is
when Aspect_Test_Case => when Aspect_Test_Case =>
raise Program_Error; raise Program_Error;
when Aspect_Attach_Handler =>
T := RTE (RE_Interrupt_ID);
-- Default_Value is resolved with the type entity in question -- Default_Value is resolved with the type entity in question
when Aspect_Default_Value => when Aspect_Default_Value =>
...@@ -5779,6 +5859,12 @@ package body Sem_Ch13 is ...@@ -5779,6 +5859,12 @@ package body Sem_Ch13 is
when Aspect_External_Tag => when Aspect_External_Tag =>
T := Standard_String; T := Standard_String;
when Aspect_Priority | Aspect_Interrupt_Priority =>
T := Standard_Integer;
when Aspect_Small =>
T := Universal_Real;
when Aspect_Storage_Pool => when Aspect_Storage_Pool =>
T := Class_Wide_Type (RTE (RE_Root_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