From c116143c22e88b7acd0ec5a1e5f9707758875bb9 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 5 Dec 2012 11:20:13 +0000 Subject: aspects.ads, [...]: Add aspect Relative_Deadline. 2012-12-05 Ed Schonberg * aspects.ads, aspects.adb: Add aspect Relative_Deadline. * sem_ch13.adb (Analyze_Aspect_Specifications): Process aspect Relative_Deadline, and introduce the corresponding pragma within the task definition of the task type to which it applies. (Check_Aspect_At_Freeze_Point): Expression in a Relative_Deadline aspect is of type Time_Span. From-SVN: r194214 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 3 +++ gcc/ada/sem_ch13.adb | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 63 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 89030d9..7b4634c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2012-12-05 Ed Schonberg + + * aspects.ads, aspects.adb: Add aspect Relative_Deadline. + * sem_ch13.adb (Analyze_Aspect_Specifications): Process aspect + Relative_Deadline, and introduce the corresponding pragma within + the task definition of the task type to which it applies. + (Check_Aspect_At_Freeze_Point): Expression in a Relative_Deadline + aspect is of type Time_Span. + 2012-12-05 Hristian Kirtchev * sem_prag.adb (Check_Loop_Invariant_Variant_Placement): When pragma diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index e3e7571..dcc7314 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -304,6 +304,7 @@ package body Aspects is Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface, Aspect_Remote_Types => Aspect_Remote_Types, Aspect_Read => Aspect_Read, + Aspect_Relative_Deadline => Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order, Aspect_Shared => Aspect_Atomic, Aspect_Shared_Passive => Aspect_Shared_Passive, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index d896de8..7d64fee 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -109,6 +109,7 @@ package Aspects is Aspect_Predicate, -- GNAT Aspect_Priority, Aspect_Read, + Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order, -- GNAT Aspect_Simple_Storage_Pool, -- GNAT Aspect_Size, @@ -339,6 +340,7 @@ package Aspects is Aspect_Predicate => Expression, Aspect_Priority => Expression, Aspect_Read => Name, + Aspect_Relative_Deadline => Expression, Aspect_Scalar_Storage_Order => Expression, Aspect_Simple_Storage_Pool => Name, Aspect_Size => Expression, @@ -431,6 +433,7 @@ package Aspects is Aspect_Pure_12 => Name_Pure_12, Aspect_Pure_Function => Name_Pure_Function, Aspect_Read => Name_Read, + Aspect_Relative_Deadline => Name_Relative_Deadline, Aspect_Remote_Access_Type => Name_Remote_Access_Type, Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, Aspect_Remote_Types => Name_Remote_Types, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 887b079..eee75d5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1433,6 +1433,48 @@ package body Sem_Ch13 is Delay_Required := False; + -- Case 2d : Aspects that correspond to a pragma with one + -- argument. + + when Aspect_Relative_Deadline => + Aitem := + Make_Pragma (Loc, + Pragma_Argument_Associations => + New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr))), + Pragma_Identifier => + Make_Identifier (Sloc (Id), Name_Relative_Deadline)); + + -- If the aspect applies to a task, the corresponding pragma + -- must appear within its declarations, not after. + + if Nkind (N) = N_Task_Type_Declaration then + declare + Def : Node_Id; + V : List_Id; + + begin + if No (Task_Definition (N)) then + Set_Task_Definition (N, + Make_Task_Definition (Loc, + Visible_Declarations => New_List, + End_Label => Empty)); + end if; + + Def := Task_Definition (N); + V := Visible_Declarations (Def); + if not Is_Empty_List (V) then + Insert_Before (First (V), Aitem); + + else + Set_Visible_Declarations (Def, New_List (Aitem)); + end if; + + goto Continue; + end; + end if; + -- Case 3 : Aspects that don't correspond to pragma/attribute -- definition clause. @@ -5186,7 +5228,11 @@ package body Sem_Ch13 is end if; Exp := New_Copy_Tree (Arg2); - Loc := Sloc (Exp); + + -- Preserve sloc of original pragma Invariant (this is required + -- by Par_SCO). + + Loc := Sloc (Ritem); -- We need to replace any occurrences of the name of the type -- with references to the object, converted to type'Class in @@ -6796,6 +6842,9 @@ package body Sem_Ch13 is when Aspect_Priority | Aspect_Interrupt_Priority => T := Standard_Integer; + when Aspect_Relative_Deadline => + T := RTE (RE_Time_Span); + when Aspect_Small => T := Universal_Real; -- cgit v1.1