diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 30 | ||||
| -rw-r--r-- | gcc/ada/a-exetim-default.ads | 7 | ||||
| -rwxr-xr-x | gcc/ada/a-exetim-mingw.adb | 15 | ||||
| -rwxr-xr-x | gcc/ada/a-exetim-mingw.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/a-exetim-posix.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/a-synbar-posix.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/a-synbar.adb | 2 | ||||
| -rwxr-xr-x | gcc/ada/aspects.adb | 8 | ||||
| -rwxr-xr-x | gcc/ada/aspects.ads | 22 | ||||
| -rw-r--r-- | gcc/ada/s-atocou-x86.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 102 |
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)); |