diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 53 | ||||
| -rw-r--r-- | gcc/ada/aspects.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/aspects.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 77 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/s-secsta.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/s-secsta.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-tarest.adb | 138 | ||||
| -rw-r--r-- | gcc/ada/s-tarest.ads | 46 | ||||
| -rw-r--r-- | gcc/ada/s-taskin.adb | 51 | ||||
| -rw-r--r-- | gcc/ada/s-taskin.ads | 32 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 71 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.ads | 30 | ||||
| -rw-r--r-- | gcc/ada/s-tporft.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 47 | ||||
| -rw-r--r-- | gcc/ada/sem_ch9.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/snames.adb-tmpl | 5 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 17 |
24 files changed, 486 insertions, 249 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 048b975..9a82bfe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,56 @@ +2017-01-12 Arnaud Charlet <charlet@adacore.com> + + * sem_util.adb (Unique_Entity): For concurrent + bodies that are defined with stubs and complete a declaration + of a single concurrent object return the entity of an implicit + concurrent type, not the entity of the anonymous concurrent + object. + * debug.adb: -gnatd.J is no longer used. + * make.adb (Globalize): Removed, no longer used. + * sem_ch9.adb: minor typo in comment for entry index + +2017-01-12 Patrick Bernardi <bernardi@adacore.com> + + * aspect.adb, aspect.ads: Added new aspect Secondary_Stack_Size. + * exp_ch3.adb (Build_Init_Statements): As part of initialising + the value record of a task, set its _Secondary_Stack_Size field + if present. + * exp_ch9.adb (Expand_N_Task_Type_Declaration): Create + a _Secondary_Stack_Size field in the value record of + the task if a Secondary_Stack_Size rep item is present. + (Make_Task_Create_Call): Include secondary stack size + parameter. If No_Secondary_Stack restriction is in place, passes + stack size of 0. + * par-prag.adb, sem_prag.adb, sem_prag.ads: Added new pragma + Secondary_Stack_Size. + * s-secsta.adb, s-secsta.ads (Minimum_Secondary_Stack_Size): New + function to define the overhead of the secondary stack. + * s-tarest.adb (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Functions now include + Secondary_Stack_Size parameter to pass to Initialize_ATCB. + * s-tarest.adb (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Calls to Initialize_ATCB now + include Secondary_Stack_Size parameter. + (Task_Wrapper): Secondary stack now allocated to the size specified by + the Secondary_Stack_Size parameter in the task's ATCB. + * s-taskin.adb, s-taskin.adb (Common_ATCB, Initialize_ATCB): New + Secondary_Stack_Size component. + * s-tassta.adb, s-tassta.ads (Create_Restricted_Task, + Create_Restricted_Task_Sequential): Function now include + Secondary_Stack_Size parameter. + (Task_Wrapper): Secondary stack now allocated to the size + specified by the Secondary_Stack_Size parameter in the task's + ATCB. + * s-tproft.adb (Register_Foreign_Thread): Amended Initialize_ATCB call + to include Secondary_Stack_Size parameter. + * sem_ch13.adb (Analyze_Aspect_Specification): Add support for + Secondary_Stack_Size aspect, turning the aspect into its corresponding + internal attribute. + (Analyze_Attribute_Definition): Process Secondary_Stack_Size attribute. + * snames.adb-tmpl, snames.ads-tmpl: Added names + Name_Secondary_Stack_Size, Name_uSecondary_Stack_Size, + Attribute_Secondary_Stack_Size and Pragma_Secondary_Stack_Size. + 2017-01-12 Yannick Moy <moy@adacore.com> * exp_spark.adb (Expand_SPARK_Potential_Renaming): Fix sloc of copied diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 0da6b81..49eddf4 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -599,6 +599,7 @@ package body Aspects is Aspect_Read => Aspect_Read, Aspect_Relative_Deadline => Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order, + Aspect_Secondary_Stack_Size => Aspect_Secondary_Stack_Size, Aspect_Shared => Aspect_Atomic, Aspect_Shared_Passive => Aspect_Shared_Passive, Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 5de6539..586d35f 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -135,6 +135,7 @@ package Aspects is Aspect_Refined_State, -- GNAT Aspect_Relative_Deadline, Aspect_Scalar_Storage_Order, -- GNAT + Aspect_Secondary_Stack_Size, -- GNAT Aspect_Simple_Storage_Pool, -- GNAT Aspect_Size, Aspect_Small, @@ -255,6 +256,7 @@ package Aspects is Aspect_Pure_Function => True, Aspect_Remote_Access_Type => True, Aspect_Scalar_Storage_Order => True, + Aspect_Secondary_Stack_Size => True, Aspect_Shared => True, Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, @@ -374,6 +376,7 @@ package Aspects is Aspect_Refined_State => Expression, Aspect_Relative_Deadline => Expression, Aspect_Scalar_Storage_Order => Expression, + Aspect_Secondary_Stack_Size => Expression, Aspect_Simple_Storage_Pool => Name, Aspect_Size => Expression, Aspect_Small => Expression, @@ -494,6 +497,7 @@ package Aspects is Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, Aspect_Remote_Types => Name_Remote_Types, Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order, + Aspect_Secondary_Stack_Size => Name_Secondary_Stack_Size, Aspect_Shared => Name_Shared, Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, @@ -692,6 +696,7 @@ package Aspects is Aspect_Remote_Access_Type => Always_Delay, Aspect_Remote_Call_Interface => Always_Delay, Aspect_Remote_Types => Always_Delay, + Aspect_Secondary_Stack_Size => Always_Delay, Aspect_Shared => Always_Delay, Aspect_Shared_Passive => Always_Delay, Aspect_Simple_Storage_Pool => Always_Delay, diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index a045a7b..7befccf 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -127,7 +127,7 @@ package body Debug is -- d.G Ignore calls through generic formal parameters for elaboration -- d.H GNSA mode for ASIS -- d.I Do not ignore enum representation clauses in CodePeer mode - -- d.J Disable parallel SCIL generation mode + -- d.J -- d.K Enable generation of contract-only procedures in CodePeer mode -- d.L Depend on back end for limited types in if and case expressions -- d.M Relaxed RM semantics @@ -642,10 +642,6 @@ package body Debug is -- cases being able to change this default might be useful to remove -- some false positives. - -- d.J Disable parallel SCIL generation. Normally SCIL file generation is - -- done in parallel to speed processing. This switch disables this - -- behavior. - -- d.K Enable generation of contract-only procedures in CodePeer mode and -- report a warning on subprograms for which the contract-only body -- cannot be built. Currently reported on subprograms defined in diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 9002c26..c9e90db 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -2730,15 +2730,17 @@ package body Exp_Ch3 is Actions := Build_Assignment (Id, Expression (Decl)); end if; - -- CPU, Dispatching_Domain, Priority and Size components are - -- filled with the corresponding rep item expression of the - -- concurrent type (if any). + -- CPU, Dispatching_Domain, Priority and + -- Secondary_Stack_Size components are filled with the + -- corresponding rep item expression of the concurrent + -- type (if any). elsif Ekind (Scope (Id)) = E_Record_Type and then Present (Corresponding_Concurrent_Type (Scope (Id))) and then Nam_In (Chars (Id), Name_uCPU, Name_uDispatching_Domain, - Name_uPriority) + Name_uPriority, + Name_uSecondary_Stack_Size) then declare Exp : Node_Id; @@ -2754,6 +2756,9 @@ package body Exp_Ch3 is elsif Chars (Id) = Name_uPriority then Nam := Name_Priority; + + elsif Chars (Id) = Name_uSecondary_Stack_Size then + Nam := Name_Secondary_Stack_Size; end if; -- Get the Rep Item (aspect specification, attribute diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index efffc28..ab128cf 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11553,14 +11553,15 @@ package body Exp_Ch9 is -- values of this task. The general form of this type declaration is -- type taskV (discriminants) is record - -- _Task_Id : Task_Id; - -- entry_family : array (bounds) of Void; - -- _Priority : Integer := priority_expression; - -- _Size : Size_Type := size_expression; - -- _Task_Info : Task_Info_Type := task_info_expression; - -- _CPU : Integer := cpu_range_expression; - -- _Relative_Deadline : Time_Span := time_span_expression; - -- _Domain : Dispatching_Domain := dd_expression; + -- _Task_Id : Task_Id; + -- entry_family : array (bounds) of Void; + -- _Priority : Integer := priority_expression; + -- _Size : Size_Type := size_expression; + -- _Secondary_Stack_Size : Size_Type := size_expression; + -- _Task_Info : Task_Info_Type := task_info_expression; + -- _CPU : Integer := cpu_range_expression; + -- _Relative_Deadline : Time_Span := time_span_expression; + -- _Domain : Dispatching_Domain := dd_expression; -- end record; -- The discriminants are present only if the corresponding task type has @@ -11584,6 +11585,13 @@ package body Exp_Ch9 is -- in the pragma, and is used to override the task stack size otherwise -- associated with the task type. + -- The _Secondary_Stack_Size field is present only the task entity has a + -- Secondary_Stack_Size rep item. It will be filled at the freeze point, + -- when the record init proc is built, to capture the expression of the + -- rep item (see Build_Record_Init_Proc in Exp_Ch3). Note that it cannot + -- be filled here since aspect evaluations are delayed till the freeze + -- point. + -- The _Priority field is present only if the task entity has a Priority or -- Interrupt_Priority rep item (pragma, aspect specification or attribute -- definition clause). It will be filled at the freeze point, when the @@ -11923,6 +11931,24 @@ package body Exp_Ch9 is Get_Rep_Pragma (TaskId, Name_Storage_Size)))))))); end if; + -- Add the _Secondary_Stack_Size component if a + -- Secondary_Stack_Size rep item is present. + + if Has_Rep_Item (TaskId, Name_Secondary_Stack_Size, + Check_Parents => False) + then + Append_To (Cdecls, + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uSecondary_Stack_Size), + + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => + New_Occurrence_Of (RTE (RE_Size_Type), Loc)))); + end if; + -- Add the _Task_Info component if a Task_Info pragma is present if Has_Rep_Pragma (TaskId, Name_Task_Info, Check_Parents => False) then @@ -14114,6 +14140,29 @@ package body Exp_Ch9 is New_Occurrence_Of (Storage_Size_Variable (Ttyp), Loc)); end if; + -- Secondary_Stack_Size parameter. Set Default_Secondary_Stack_Size + -- unless there is a Secondary_Stack_Size rep item, in which case we + -- take the value from the rep item. If the restriction + -- No_Secondary_Stack is active then a size of 0 is passed regardless + -- to prevent the allocation of the unused stack. + + if Restriction_Active (No_Secondary_Stack) then + Append_To (Args, Make_Integer_Literal (Loc, 0)); + + elsif Has_Rep_Item (Ttyp, Name_Secondary_Stack_Size, + Check_Parents => False) + then + Append_To (Args, + Make_Selected_Component (Loc, + Prefix => Make_Identifier (Loc, Name_uInit), + Selector_Name => + Make_Identifier (Loc, Name_uSecondary_Stack_Size))); + + else + Append_To (Args, + New_Occurrence_Of (RTE (RE_Unspecified_Size), Loc)); + end if; + -- Task_Info parameter. Set to Unspecified_Task_Info unless there is a -- Task_Info pragma, in which case we take the value from the pragma. diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 9c8d536..a782958 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -675,9 +675,6 @@ package body Make is Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake"); -- Default compiler, binder, linker programs - Globalizer : constant String := "codepeer_globalizer"; - -- CodePeer globalizer executable name - Saved_Gcc : String_Access := null; Saved_Gnatbind : String_Access := null; Saved_Gnatlink : String_Access := null; @@ -692,10 +689,6 @@ package body Make is -- Path for compiler, binder, linker programs, defaulted now for gnatdist. -- Changed later if overridden on command line. - Globalizer_Path : constant String_Access := - GNAT.OS_Lib.Locate_Exec_On_Path (Globalizer); - -- Path for CodePeer globalizer - Comp_Flag : constant String_Access := new String'("-c"); Output_Flag : constant String_Access := new String'("-o"); Ada_Flag_1 : constant String_Access := new String'("-x"); @@ -1024,10 +1017,6 @@ package body Make is -- during a compilation are also transitively included in the W section -- of the originally compiled file. - procedure Globalize (Success : out Boolean); - -- Call the CodePeer globalizer on all the project's object directories, - -- or on the current directory if no projects. - procedure Initialize (Project_Node_Tree : out Project_Node_Tree_Ref; Env : out Prj.Tree.Environment); @@ -4087,55 +4076,6 @@ package body Make is Obsoleted.Set (F2, True); end Enter_Into_Obsoleted; - --------------- - -- Globalize -- - --------------- - - procedure Globalize (Success : out Boolean) is - Quiet_Str : aliased String := "-quiet"; - Globalizer_Args : constant Argument_List := - (1 => Quiet_Str'Unchecked_Access); - Previous_Dir : String_Access; - - procedure Globalize_Dir (Dir : String); - -- Call CodePeer globalizer on Dir - - ------------------- - -- Globalize_Dir -- - ------------------- - - procedure Globalize_Dir (Dir : String) is - Result : Boolean; - begin - if Previous_Dir = null or else Dir /= Previous_Dir.all then - Free (Previous_Dir); - Previous_Dir := new String'(Dir); - Change_Dir (Dir); - GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Result); - Success := Success and Result; - end if; - end Globalize_Dir; - - procedure Globalize_Dirs is new - Prj.Env.For_All_Object_Dirs (Globalize_Dir); - - -- Start of processing for Globalize - - begin - Success := True; - Display (Globalizer, Globalizer_Args); - - if Globalizer_Path = null then - Make_Failed ("error, unable to locate " & Globalizer); - end if; - - if Main_Project = No_Project then - GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success); - else - Globalize_Dirs (Main_Project, Project_Tree); - end if; - end Globalize; - ------------------- -- Linking_Phase -- ------------------- @@ -6190,23 +6130,6 @@ package body Make is end if; end loop Multiple_Main_Loop; - if CodePeer_Mode then - declare - Success : Boolean := False; - begin - Globalize (Success); - - if not Success then - Set_Standard_Error; - Write_Str ("*** globalize failed."); - - if Commands_To_Stdout then - Set_Standard_Output; - end if; - end if; - end; - end if; - if Failed_Links.Last > 0 then for Index in 1 .. Successful_Links.Last loop Write_Str ("Linking of """); diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 723e07f5..ac829ad 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1452,6 +1452,7 @@ begin Pragma_Ravenscar | Pragma_Rename_Pragma | Pragma_Reviewable | + Pragma_Secondary_Stack_Size | Pragma_Share_Generic | Pragma_Shared | Pragma_Shared_Passive | diff --git a/gcc/ada/s-secsta.adb b/gcc/ada/s-secsta.adb index 30e03de..9a4fc98 100644 --- a/gcc/ada/s-secsta.adb +++ b/gcc/ada/s-secsta.adb @@ -170,6 +170,15 @@ package body System.Secondary_Stack is Ada.Unchecked_Conversion (Address, Fixed_Stack_Ptr); -- Convert from address stored in task data structures + ---------------------------------- + -- Minumum_Secondary_Stack_Size -- + ---------------------------------- + + function Minimum_Secondary_Stack_Size return Natural is + begin + return Dummy_Fixed_Stack.Mem'Position; + end Minimum_Secondary_Stack_Size; + -------------- -- Allocate -- -------------- @@ -366,7 +375,7 @@ package body System.Secondary_Stack is Put_Line ( " Current allocated space : " - & SS_Ptr'Image (Fixed_Stack.Top - 1) + & SS_Ptr'Image (Fixed_Stack.Top) & " bytes"); end; @@ -432,7 +441,7 @@ package body System.Secondary_Stack is Fixed_Stack.Top := 0; Fixed_Stack.Max := 0; - if Size < Dummy_Fixed_Stack.Mem'Position then + if Size <= Dummy_Fixed_Stack.Mem'Position then Fixed_Stack.Last := 0; else Fixed_Stack.Last := diff --git a/gcc/ada/s-secsta.ads b/gcc/ada/s-secsta.ads index c95171a..c5a0ead 100644 --- a/gcc/ada/s-secsta.ads +++ b/gcc/ada/s-secsta.ads @@ -42,6 +42,10 @@ package System.Secondary_Stack is -- which causes the binder to generate an appropriate assignment in the -- binder generated file. + function Minimum_Secondary_Stack_Size return Natural; + -- The minimum size of the secondary stack so that the internal + -- requirements of the stack are met. + procedure SS_Init (Stk : in out Address; Size : Natural := Default_Secondary_Stack_Size); diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index a117da3..6b71c09 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -116,16 +116,17 @@ package body System.Tasking.Restricted.Stages is -- This should only be called by the Task_Wrapper procedure. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Code shared between Create_Restricted_Task (the concurrent version) and -- Create_Restricted_Task_Sequential. See comment of the former in the -- specification of this package. @@ -205,11 +206,39 @@ package body System.Tasking.Restricted.Stages is -- -- DO NOT delete ID. As noted, it is needed on some targets. - use type SSE.Storage_Offset; + function Secondary_Stack_Size return Storage_Elements.Storage_Offset; + -- Returns the size of the secondary stack for the task. For fixed + -- secondary stacks, the function will return the ATCB field + -- Secondary_Stack_Size if it is not set to Unspecified_Size, + -- otherwise a percentage of the stack is reserved using the + -- System.Parameters.Sec_Stack_Percentage property. - Secondary_Stack : aliased SSE.Storage_Array - (1 .. Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * - SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100); + -- Dynamic secondary stacks are allocated in System.Soft_Links. + -- Create_TSD and thus the function returns 0 to suppress the + -- creation of the fixed secondary stack in the primary stack. + + function Secondary_Stack_Size return Storage_Elements.Storage_Offset is + use System.Storage_Elements; + use System.Secondary_Stack; + + begin + if Parameters.Sec_Stack_Dynamic then + return 0; + + elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then + return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size + * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); + else + -- Use the size specified by aspect Secondary_Stack_Size padded + -- by the amount of space used by the stack data structure. + + return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) + + Storage_Offset (Minimum_Secondary_Stack_Size); + end if; + end Secondary_Stack_Size; + + Secondary_Stack : aliased Storage_Elements.Storage_Array + (1 .. Secondary_Stack_Size); for Secondary_Stack'Alignment use Standard'Maximum_Alignment; -- This is the secondary stack data. Note that it is critical that this -- have maximum alignment, since any kind of data can be allocated here. @@ -505,16 +534,17 @@ package body System.Tasking.Restricted.Stages is ---------------------------- procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; @@ -573,7 +603,8 @@ package body System.Tasking.Restricted.Stages is Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, - Base_CPU, null, Task_Info, Size, Created_Task, Success); + Base_CPU, null, Task_Info, Size, Secondary_Stack_Size, + Created_Task, Success); -- If we do our job right then there should never be any failures, which -- was probably said about the Titanic; so just to be safe, let's retain @@ -610,17 +641,18 @@ package body System.Tasking.Restricted.Stages is end Create_Restricted_Task; procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id) + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id) is begin if Partition_Elaboration_Policy = 'S' then @@ -631,13 +663,15 @@ package body System.Tasking.Restricted.Stages is -- sequential, activation must be deferred. Create_Restricted_Task_Sequential - (Priority, Stack_Address, Size, Task_Info, CPU, State, - Discriminants, Elaborated, Task_Image, Created_Task); + (Priority, Stack_Address, Size, Secondary_Stack_Size, + Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); else Create_Restricted_Task - (Priority, Stack_Address, Size, Task_Info, CPU, State, - Discriminants, Elaborated, Task_Image, Created_Task); + (Priority, Stack_Address, Size, Secondary_Stack_Size, + Task_Info, CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); -- Append this task to the activation chain @@ -651,18 +685,20 @@ package body System.Tasking.Restricted.Stages is --------------------------------------- procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id) is + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is begin - Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, + Create_Restricted_Task (Priority, Stack_Address, Size, + Secondary_Stack_Size, Task_Info, CPU, State, Discriminants, Elaborated, Task_Image, Created_Task); diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 37b91a7..6a53289 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -128,17 +128,18 @@ package System.Tasking.Restricted.Stages is -- by the binder generated code, before calling elaboration code. procedure Create_Restricted_Task - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the partition -- elaboration policy is not specified (or is concurrent). @@ -153,6 +154,8 @@ package System.Tasking.Restricted.Stages is -- -- Size is the stack size of the task to create -- + -- Secondary_Stack_Size is the secondary stack size of the task to create + -- -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. -- @@ -182,16 +185,17 @@ package System.Tasking.Restricted.Stages is -- This procedure can raise Storage_Error if the task creation fails procedure Create_Restricted_Task_Sequential - (Priority : Integer; - Stack_Address : System.Address; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Task_Image : String; - Created_Task : Task_Id); + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task, when the sequential partition -- elaboration policy is used. diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 153fe79..bddbe11 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -86,18 +86,19 @@ package body System.Tasking is --------------------- procedure Initialize_ATCB - (Self_ID : Task_Id; - Task_Entry_Point : Task_Procedure_Access; - Task_Arg : System.Address; - Parent : Task_Id; - Elaborated : Access_Boolean; - Base_Priority : System.Any_Priority; - Base_CPU : System.Multiprocessors.CPU_Range; - Domain : Dispatching_Domain_Access; - Task_Info : System.Task_Info.Task_Info_Type; - Stack_Size : System.Parameters.Size_Type; - T : Task_Id; - Success : out Boolean) + (Self_ID : Task_Id; + Task_Entry_Point : Task_Procedure_Access; + Task_Arg : System.Address; + Parent : Task_Id; + Elaborated : Access_Boolean; + Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; + Domain : Dispatching_Domain_Access; + Task_Info : System.Task_Info.Task_Info_Type; + Stack_Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + T : Task_Id; + Success : out Boolean) is begin T.Common.State := Unactivated; @@ -146,6 +147,7 @@ package body System.Tasking is T.Common.Specific_Handler := null; T.Common.Debug_Events := (others => False); T.Common.Task_Image_Len := 0; + T.Common.Secondary_Stack_Size := Secondary_Stack_Size; if T.Common.Parent = null then @@ -232,18 +234,19 @@ package body System.Tasking is T := STPO.New_ATCB (0); Initialize_ATCB - (Self_ID => null, - Task_Entry_Point => null, - Task_Arg => Null_Address, - Parent => Null_Task, - Elaborated => null, - Base_Priority => Base_Priority, - Base_CPU => Base_CPU, - Domain => System_Domain, - Task_Info => Task_Info.Unspecified_Task_Info, - Stack_Size => 0, - T => T, - Success => Success); + (Self_ID => null, + Task_Entry_Point => null, + Task_Arg => Null_Address, + Parent => Null_Task, + Elaborated => null, + Base_Priority => Base_Priority, + Base_CPU => Base_CPU, + Domain => System_Domain, + Task_Info => Task_Info.Unspecified_Task_Info, + Stack_Size => 0, + Secondary_Stack_Size => Parameters.Unspecified_Size, + T => T, + Success => Success); pragma Assert (Success); STPO.Initialize (T); diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index c1fe020..a0b5879 100644 --- a/gcc/ada/s-taskin.ads +++ b/gcc/ada/s-taskin.ads @@ -702,6 +702,13 @@ package System.Tasking is -- need to do different things depending on the situation. -- -- Protection: Self.L + + Secondary_Stack_Size : System.Parameters.Size_Type; + -- Secondary_Stack_Size is the size of the secondary stack for the + -- task. Defined here since it is the responsibility of the task to + -- creates its own secondary stack. + -- + -- Protected: Only accessed by Self end record; --------------------------------------- @@ -1156,18 +1163,19 @@ package System.Tasking is -- System.Tasking.Initialization being present, as was done before. procedure Initialize_ATCB - (Self_ID : Task_Id; - Task_Entry_Point : Task_Procedure_Access; - Task_Arg : System.Address; - Parent : Task_Id; - Elaborated : Access_Boolean; - Base_Priority : System.Any_Priority; - Base_CPU : System.Multiprocessors.CPU_Range; - Domain : Dispatching_Domain_Access; - Task_Info : System.Task_Info.Task_Info_Type; - Stack_Size : System.Parameters.Size_Type; - T : Task_Id; - Success : out Boolean); + (Self_ID : Task_Id; + Task_Entry_Point : Task_Procedure_Access; + Task_Arg : System.Address; + Parent : Task_Id; + Elaborated : Access_Boolean; + Base_Priority : System.Any_Priority; + Base_CPU : System.Multiprocessors.CPU_Range; + Domain : Dispatching_Domain_Access; + Task_Info : System.Task_Info.Task_Info_Type; + Stack_Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + T : Task_Id; + Success : out Boolean); -- Initialize fields of the TCB for task T, and link into global TCB -- structures. Call this only with abort deferred and holding RTS_Lock. -- Self_ID is the calling task (normally the activator of T). Success is diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 7566629..64ec3b1 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -50,11 +50,11 @@ with System.Tasking.Queuing; with System.Tasking.Rendezvous; with System.OS_Primitives; with System.Secondary_Stack; -with System.Storage_Elements; with System.Restrictions; with System.Standard_Library; with System.Traces.Tasking; with System.Stack_Usage; +with System.Storage_Elements; with System.Soft_Links; -- These are procedure pointers to non-tasking routines that use task @@ -472,20 +472,21 @@ package body System.Tasking.Stages is -- called to create a new task. procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - Relative_Deadline : Ada.Real_Time.Time_Span; - Domain : Dispatching_Domain_Access; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id) + (Priority : Integer; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + Relative_Deadline : Ada.Real_Time.Time_Span; + Domain : Dispatching_Domain_Access; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id) is T, P : Task_Id; Self_ID : constant Task_Id := STPO.Self; @@ -611,7 +612,8 @@ package body System.Tasking.Stages is end if; Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated, - Base_Priority, Base_CPU, Domain, Task_Info, Size, T, Success); + Base_Priority, Base_CPU, Domain, Task_Info, Size, + Secondary_Stack_Size, T, Success); if not Success then Free (T); @@ -1037,12 +1039,39 @@ package body System.Tasking.Stages is Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0; -- Whether to use above alternate signal stack for stack overflows - Secondary_Stack_Size : - constant SSE.Storage_Offset := - Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size * - SSE.Storage_Offset (Parameters.Sec_Stack_Percentage) / 100; + function Secondary_Stack_Size return Storage_Elements.Storage_Offset; + -- Returns the size of the secondary stack for the task. For fixed + -- secondary stacks, the function will return the ATCB field + -- Secondary_Stack_Size if it is not set to Unspecified_Size, + -- otherwise a percentage of the stack is reserved using the + -- System.Parameters.Sec_Stack_Percentage property. + + -- Dynamic secondary stacks are allocated in System.Soft_Links. + -- Create_TSD and thus the function returns 0 to suppress the + -- creation of the fixed secondary stack in the primary stack. + + function Secondary_Stack_Size return Storage_Elements.Storage_Offset is + use System.Storage_Elements; + use System.Secondary_Stack; + + begin + if Parameters.Sec_Stack_Dynamic then + return 0; + + elsif Self_ID.Common.Secondary_Stack_Size = Unspecified_Size then + return (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size + * SSE.Storage_Offset (Sec_Stack_Percentage) / 100); + else + -- Use the size specified by aspect Secondary_Stack_Size padded + -- by the amount of space used by the stack data structure. + + return Storage_Offset (Self_ID.Common.Secondary_Stack_Size) + + Storage_Offset (SST.Minimum_Secondary_Stack_Size); + end if; + end Secondary_Stack_Size; - Secondary_Stack : aliased SSE.Storage_Array (1 .. Secondary_Stack_Size); + Secondary_Stack : aliased Storage_Elements.Storage_Array + (1 .. Secondary_Stack_Size); for Secondary_Stack'Alignment use Standard'Maximum_Alignment; -- Actual area allocated for secondary stack. Note that it is critical -- that this have maximum alignment, since any kind of data can be diff --git a/gcc/ada/s-tassta.ads b/gcc/ada/s-tassta.ads index b25f4bf..1717d44 100644 --- a/gcc/ada/s-tassta.ads +++ b/gcc/ada/s-tassta.ads @@ -167,26 +167,28 @@ package System.Tasking.Stages is -- now in order to wake up the activator (the environment task). procedure Create_Task - (Priority : Integer; - Size : System.Parameters.Size_Type; - Task_Info : System.Task_Info.Task_Info_Type; - CPU : Integer; - Relative_Deadline : Ada.Real_Time.Time_Span; - Domain : Dispatching_Domain_Access; - Num_Entries : Task_Entry_Index; - Master : Master_Level; - State : Task_Procedure_Access; - Discriminants : System.Address; - Elaborated : Access_Boolean; - Chain : in out Activation_Chain; - Task_Image : String; - Created_Task : out Task_Id); + (Priority : Integer; + Size : System.Parameters.Size_Type; + Secondary_Stack_Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + Relative_Deadline : Ada.Real_Time.Time_Span; + Domain : Dispatching_Domain_Access; + Num_Entries : Task_Entry_Index; + Master : Master_Level; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : out Task_Id); -- Compiler interface only. Do not call from within the RTS. -- This must be called to create a new task. -- -- Priority is the task's priority (assumed to be in range of type -- System.Any_Priority) -- Size is the stack size of the task to create + -- Secondary_Stack_Size is the secondary stack size of the task to create -- Task_Info is the task info associated with the created task, or -- Unspecified_Task_Info if none. -- CPU is the task affinity. Passed as an Integer because the undefined diff --git a/gcc/ada/s-tporft.adb b/gcc/ada/s-tporft.adb index 32bb1f0..2f22f8a 100644 --- a/gcc/ada/s-tporft.adb +++ b/gcc/ada/s-tporft.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2016, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -66,7 +66,7 @@ begin (Self_Id, null, Null_Address, Null_Task, Foreign_Task_Elaborated'Access, System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, null, - Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded); + Task_Info.Unspecified_Task_Info, 0, 0, Self_Id, Succeeded); Unlock_RTS; pragma Assert (Succeeded); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2627288..2ff1665 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2065,6 +2065,7 @@ package body Sem_Ch13 is Aspect_Scalar_Storage_Order | Aspect_Size | Aspect_Small | + Aspect_Secondary_Stack_Size | Aspect_Simple_Storage_Pool | Aspect_Storage_Pool | Aspect_Stream_Size | @@ -2428,7 +2429,7 @@ package body Sem_Ch13 is end if; end; - -- Handling for these Aspects in subprograms is complete + -- Handling for these aspects in subprograms is complete goto Continue; @@ -5696,6 +5697,47 @@ package body Sem_Ch13 is end if; end Scalar_Storage_Order; + -------------------------- + -- Secondary_Stack_Size -- + -------------------------- + + when Attribute_Secondary_Stack_Size => Secondary_Stack_Size : + begin + -- Secondary_Stack_Size attribute definition clause not allowed + -- except from aspect specification. + + if From_Aspect_Specification (N) then + if not Is_Task_Type (U_Ent) then + Error_Msg_N ("Secondary Stack Size can only be " & + "defined for task", Nam); + + elsif Duplicate_Clause then + null; + + else + Check_Restriction (No_Secondary_Stack, Expr); + + -- The expression must be analyzed in the special manner + -- described in "Handling of Default and Per-Object + -- Expressions" in sem.ads. + + -- The visibility to the discriminants must be restored + + Push_Scope_And_Install_Discriminants (U_Ent); + Preanalyze_Spec_Expression (Expr, Any_Integer); + Uninstall_Discriminants_And_Pop_Scope (U_Ent); + + if not Is_OK_Static_Expression (Expr) then + Check_Restriction (Static_Storage_Size, Expr); + end if; + end if; + + else + Error_Msg_N + ("attribute& cannot be set with definition clause", N); + end if; + end Secondary_Stack_Size; + ---------- -- Size -- ---------- @@ -9149,6 +9191,9 @@ package body Sem_Ch13 is when Aspect_Relative_Deadline => T := RTE (RE_Time_Span); + when Aspect_Secondary_Stack_Size => + T := Standard_Integer; + when Aspect_Small => T := Universal_Real; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index bfd1249..7eae247 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1669,7 +1669,7 @@ package body Sem_Ch9 is -- The Defining_Identifier of the entry index specification is local to the -- entry body, but it must be available in the entry barrier which is -- evaluated outside of the entry body. The index is eventually renamed as - -- a run-time object, so is visibility is strictly a front-end concern. In + -- a run-time object, so its visibility is strictly a front-end concern. In -- order to make it available to the barrier, we create an additional -- scope, as for a loop, whose only declaration is the index name. This -- loop is not attached to the tree and does not appear as an entity local diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d737a93..031e00c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -20553,6 +20553,50 @@ package body Sem_Prag is rv; -------------------------- + -- Secondary_Stack_Size -- + -------------------------- + + -- pragma Secondary_Stack_Size (EXPRESSION); + + when Pragma_Secondary_Stack_Size => Secondary_Stack_Size : declare + P : constant Node_Id := Parent (N); + Arg : Node_Id; + Ent : Entity_Id; + + begin + GNAT_Pragma; + Check_No_Identifiers; + Check_Arg_Count (1); + + if Nkind (P) = N_Task_Definition then + Arg := Get_Pragma_Arg (Arg1); + Ent := Defining_Identifier (Parent (P)); + + -- The expression must be analyzed in the special + -- manner described in "Handling of Default Expressions" + -- in sem.ads. + + Preanalyze_Spec_Expression (Arg, Any_Integer); + + -- The pragma cannot appear if the No_Secondary_Stack + -- restriction is in effect. + + Check_Restriction (No_Secondary_Stack, Arg); + + -- Anything else is incorrect + + else + Pragma_Misplaced; + end if; + + -- Check duplicate pragma before we chain the pragma in the Rep + -- Item chain of Ent. + + Check_Duplicate_Pragma (Ent); + Record_Rep_Item (Ent, N); + end Secondary_Stack_Size; + + -------------------------- -- Short_Circuit_And_Or -- -------------------------- @@ -28625,6 +28669,7 @@ package body Sem_Prag is Pragma_Restriction_Warnings => 0, Pragma_Restrictions => 0, Pragma_Reviewable => -1, + Pragma_Secondary_Stack_Size => -1, Pragma_Short_Circuit_And_Or => 0, Pragma_Share_Generic => 0, Pragma_Shared => 0, diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 1155673..049c5c4 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -100,6 +100,7 @@ package Sem_Prag is Pragma_Remote_Access_Type => True, Pragma_Remote_Call_Interface => True, Pragma_Remote_Types => True, + Pragma_Secondary_Stack_Size => True, Pragma_Shared => True, Pragma_Shared_Passive => True, Pragma_Simple_Storage_Pool_Type => True, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3cba861..b1f80ae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20712,6 +20712,10 @@ package body Sem_Util is and then Present (Corresponding_Spec_Of_Stub (P)) then U := Corresponding_Spec_Of_Stub (P); + + if Is_Single_Protected_Object (U) then + U := Etype (U); + end if; end if; when E_Subprogram_Body => @@ -20749,6 +20753,10 @@ package body Sem_Util is and then Present (Corresponding_Spec_Of_Stub (P)) then U := Corresponding_Spec_Of_Stub (P); + + if Is_Single_Task_Object (U) then + U := Etype (U); + end if; end if; when Type_Kind => diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index fe23998..886a13c 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -134,6 +134,8 @@ package body Snames is return Attribute_Dispatching_Domain; elsif N = Name_Interrupt_Priority then return Attribute_Interrupt_Priority; + elsif N = Name_Secondary_Stack_Size then + return Attribute_Secondary_Stack_Size; else return Attribute_Id'Val (N - First_Attribute_Name); end if; @@ -229,6 +231,8 @@ package body Snames is return Pragma_Lock_Free; when Name_Priority => return Pragma_Priority; + when Name_Secondary_Stack_Size => + return Pragma_Secondary_Stack_Size; when Name_Storage_Size => return Pragma_Storage_Size; when Name_Storage_Unit => @@ -456,6 +460,7 @@ package body Snames is or else N = Name_Interrupt_Priority or else N = Name_Lock_Free or else N = Name_Priority + or else N = Name_Secondary_Stack_Size or else N = Name_Storage_Size or else N = Name_Storage_Unit; end Is_Pragma_Name; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index a45b895..9ed79ff 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -175,6 +175,7 @@ package Snames is Name_uRelative_Deadline : constant Name_Id := N + $; Name_uResult : constant Name_Id := N + $; Name_uSecondary_Stack : constant Name_Id := N + $; + Name_uSecondary_Stack_Size : constant Name_Id := N + $; Name_uService : constant Name_Id := N + $; Name_uSize : constant Name_Id := N + $; Name_uStack : constant Name_Id := N + $; @@ -804,7 +805,6 @@ package Snames is Name_Robustness : constant Name_Id := N + $; Name_Runtime : constant Name_Id := N + $; Name_SB : constant Name_Id := N + $; - Name_Secondary_Stack_Size : constant Name_Id := N + $; Name_Section : constant Name_Id := N + $; Name_Semaphore : constant Name_Id := N + $; Name_Simple_Barriers : constant Name_Id := N + $; @@ -1052,8 +1052,9 @@ package Snames is -- Names of internal attributes. They are not real attributes but special -- names used internally by GNAT in order to deal with delayed aspects - -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that - -- don't have corresponding pragmas or user-referencable attributes. + -- (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority, + -- Aspect_Secondary_Stack_Size) that don't have corresponding pragmas or + -- user-referencable attributes. -- It is convenient to have these internal attributes available for -- processing the aspects, since the normal approach is to convert an @@ -1069,6 +1070,7 @@ package Snames is Name_CPU : constant Name_Id := N + $; Name_Dispatching_Domain : constant Name_Id := N + $; Name_Interrupt_Priority : constant Name_Id := N + $; + Name_Secondary_Stack_Size : constant Name_Id := N + $; -- GNAT Last_Internal_Attribute_Name : constant Name_Id := N + $; -- Names of recognized locking policy identifiers @@ -1682,10 +1684,11 @@ package Snames is Attribute_CPU, Attribute_Dispatching_Domain, - Attribute_Interrupt_Priority); + Attribute_Interrupt_Priority, + Attribute_Secondary_Stack_Size); subtype Internal_Attribute_Id is Attribute_Id range - Attribute_CPU .. Attribute_Interrupt_Priority; + Attribute_CPU .. Attribute_Secondary_Stack_Size; type Attribute_Class_Array is array (Attribute_Id) of Boolean; -- Type used to build attribute classification flag arrays @@ -1993,6 +1996,7 @@ package Snames is Pragma_Interrupt_Priority, Pragma_Lock_Free, Pragma_Priority, + Pragma_Secondary_Stack_Size, Pragma_Storage_Size, Pragma_Storage_Unit, @@ -2035,7 +2039,8 @@ package Snames is function Is_Internal_Attribute_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of an INT attribute (Name_CPU, - -- Name_Dispatching_Domain, Name_Interrupt_Priority). + -- Name_Dispatching_Domain, Name_Interrupt_Priority, + -- Name_Secondary_Stack_Size). function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean; -- Test to see if the name N is the name of a recognized attribute that |