@@ -5437,7 +5437,7 @@ package body Exp_Ch9 is
(Restriction_Active (No_Implicit_Heap_Allocations)
or else Restriction_Active (No_Implicit_Task_Allocations))
and then not Restriction_Active (No_Secondary_Stack)
- and then Has_Rep_Item
+ and then Has_Rep_Pragma
(T, Name_Secondary_Stack_Size, Check_Parents => False);
end Create_Secondary_Stack_For_Task;
@@ -11933,7 +11933,7 @@ package body Exp_Ch9 is
Set_Analyzed (Task_Size);
else
- Task_Size := Relocate_Node (Expr_N);
+ Task_Size := New_Copy_Tree (Expr_N);
end if;
end;
@@ -11971,29 +11971,35 @@ package body Exp_Ch9 is
if Create_Secondary_Stack_For_Task (TaskId) then
declare
- Ritem : Node_Id;
- Size_Expr : Node_Id;
+ Stack_Size : Node_Id;
- begin
- -- First extract the secondary stack size from the task type's
- -- representation aspect.
+ Size_Expr : constant Node_Id :=
+ Expression (First (
+ Pragma_Argument_Associations (
+ Get_Rep_Pragma (TaskId,
+ Name_Secondary_Stack_Size))));
- Ritem :=
- Get_Rep_Item
- (TaskId, Name_Secondary_Stack_Size, Check_Parents => False);
+ begin
+ -- The secondary stack is defined inside the corresponding
+ -- record. Therefore if the size of the stack is set by means
+ -- of a discriminant, we must reference the discriminant of the
+ -- corresponding record type.
- -- Get Secondary_Stack_Size expression. Can be a pragma or aspect.
+ if Nkind (Size_Expr) in N_Has_Entity
+ and then Present (Discriminal_Link (Entity (Size_Expr)))
+ then
+ Stack_Size :=
+ New_Occurrence_Of
+ (CR_Discriminant (Discriminal_Link (Entity (Size_Expr))),
+ Loc);
+ Set_Parent (Stack_Size, Parent (Size_Expr));
+ Set_Etype (Stack_Size, Etype (Size_Expr));
+ Set_Analyzed (Stack_Size);
- if Nkind (Ritem) = N_Pragma then
- Size_Expr :=
- Expression
- (First (Pragma_Argument_Associations (Ritem)));
else
- Size_Expr := Expression (Ritem);
+ Stack_Size := New_Copy_Tree (Size_Expr);
end if;
- pragma Assert (Compile_Time_Known_Value (Size_Expr));
-
-- Create the secondary stack for the task
Decl_SS :=
@@ -12010,8 +12016,8 @@ package body Exp_Ch9 is
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
- Make_Integer_Literal (Loc,
- Expr_Value (Size_Expr)))))));
+ Convert_To (RTE (RE_Size_Type),
+ Stack_Size))))));
Append_To (Cdecls, Decl_SS);
end;
@@ -12052,16 +12058,16 @@ package body Exp_Ch9 is
Expression =>
Convert_To (RTE (RE_Size_Type),
- Relocate_Node (
+ New_Copy_Tree (
Expression (First (
Pragma_Argument_Associations (
Get_Rep_Pragma (TaskId, Name_Storage_Size))))))));
end if;
-- Add the _Secondary_Stack_Size component if a Secondary_Stack_Size
- -- rep item is present.
+ -- pragma is present.
- if Has_Rep_Item
+ if Has_Rep_Pragma
(TaskId, Name_Secondary_Stack_Size, Check_Parents => False)
then
Append_To (Cdecls,
@@ -12135,7 +12141,7 @@ package body Exp_Ch9 is
Expression =>
Convert_To (RTE (RE_Time_Span),
- Relocate_Node (
+ New_Copy_Tree (
Expression (First (
Pragma_Argument_Associations (
Get_Relative_Deadline_Pragma (Taskdef))))))));
@@ -14246,15 +14252,15 @@ package body Exp_Ch9 is
end if;
-- Secondary_Stack_Size parameter. Set RE_Unspecified_Size unless there
- -- is a Secondary_Stack_Size rep item, in which case take the value from
- -- the rep item. If the restriction No_Secondary_Stack is active then a
+ -- is a Secondary_Stack_Size pragma, in which case take the value from
+ -- the pragma. 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
+ elsif Has_Rep_Pragma
(Ttyp, Name_Secondary_Stack_Size, Check_Parents => False)
then
Append_To (Args,--- gcc/ada/sem_ch13.adb
@@ -2210,7 +2210,6 @@ package body Sem_Ch13 is
| Aspect_Output
| Aspect_Read
| Aspect_Scalar_Storage_Order
- | Aspect_Secondary_Stack_Size
| Aspect_Simple_Storage_Pool
| Aspect_Size
| Aspect_Small
@@ -3205,6 +3204,27 @@ package body Sem_Ch13 is
end;
end if;
+ -- Secondary_Stack_Size
+
+ -- Aspect Secondary_Stack_Size needs to be converted into a
+ -- pragma for two reasons: the attribute is not analyzed until
+ -- after the expansion of the task type declaration and the
+ -- attribute does not have visibility on the discriminant.
+
+ when Aspect_Secondary_Stack_Size =>
+ Make_Aitem_Pragma
+ (Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Relocate_Node (Expr))),
+ Pragma_Name =>
+ Name_Secondary_Stack_Size);
+
+ Decorate (Aspect, Aitem);
+ Insert_Pragma (Aitem);
+ goto Continue;
+
+ -- Volatile_Function
+
-- Aspect Volatile_Function is never delayed because it is
-- equivalent to a source pragma which appears after the
-- related subprogram.
@@ -5851,46 +5871,6 @@ package body Sem_Ch13 is
Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False);
end if;
- --------------------------
- -- Secondary_Stack_Size --
- --------------------------
-
- when Attribute_Secondary_Stack_Size =>
-
- -- 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;
-
----------
-- Size --
------------- gcc/ada/snames.adb-tmpl
@@ -134,8 +134,6 @@ 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;--- gcc/ada/snames.ads-tmpl
@@ -1706,11 +1706,10 @@ package Snames is
Attribute_CPU,
Attribute_Dispatching_Domain,
- Attribute_Interrupt_Priority,
- Attribute_Secondary_Stack_Size);
+ Attribute_Interrupt_Priority);
subtype Internal_Attribute_Id is Attribute_Id range
- Attribute_CPU .. Attribute_Secondary_Stack_Size;
+ Attribute_CPU .. Attribute_Interrupt_Priority;
type Attribute_Class_Array is array (Attribute_Id) of Boolean;
-- Type used to build attribute classification flag arrays