+2018-01-11 Patrick Bernardi <bernardi@adacore.com>
+
+ * exp_ch9.adb (Expand_N_Task_Type_Declaration): Simplified
+ Secondary_Stack_Size handling as a pragma is now generated for the
+ corresponding aspect instead of an attribute. Pragma expression is
+ relocated instead of evaluated. Discriminant of the corresponding
+ record type is referenced rather than the type discriminant.
+ (Create_Secondary_Stack_For_Task, Make_Task_Create_Call): Update
+ Secondary_Stack_Size rep item checks to only look for the pragma rep.
+ * sem_ch13.adb (Analyze_One_Aspect): Transform
+ Aspect_Secondary_Stack_Size into a pragma instead of an attribute
+ because the attribute does not have visibility on a task type's
+ discriminants when the type's definition is expanded.
+ (Analyze_Attribute_Definition_Clause): Remove handling of
+ Attribute_Secondary_Stack_Size.
+ * snames.adb-tmpl, snames.ads-tmpl: Remove
+ Attribute_Secondary_Stack_Size, no longer used.
+
2018-01-11 Justin Squirek <squirek@adacore.com>
* sem_ch8.adb: Minor comment fix.
(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;
Set_Analyzed (Task_Size);
else
- Task_Size := Relocate_Node (Expr_N);
+ Task_Size := New_Copy_Tree (Expr_N);
end if;
end;
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 :=
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;
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,
Expression =>
Convert_To (RTE (RE_Time_Span),
- Relocate_Node (
+ New_Copy_Tree (
Expression (First (
Pragma_Argument_Associations (
Get_Relative_Deadline_Pragma (Taskdef))))))));
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,
| Aspect_Output
| Aspect_Read
| Aspect_Scalar_Storage_Order
- | Aspect_Secondary_Stack_Size
| Aspect_Simple_Storage_Pool
| Aspect_Size
| Aspect_Small
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.
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 --
----------
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;
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