-- Max_Size_In_Storage_Elements --
----------------------------------
- when Attribute_Max_Size_In_Storage_Elements =>
+ when Attribute_Max_Size_In_Storage_Elements => declare
+ Typ : constant Entity_Id := Etype (N);
+ Attr : Node_Id;
+
+ Conversion_Added : Boolean := False;
+ -- A flag which tracks whether the original attribute has been
+ -- wrapped inside a type conversion.
+
+ begin
Apply_Universal_Integer_Attribute_Checks (N);
+ -- The universal integer check may sometimes add a type conversion,
+ -- retrieve the original attribute reference from the expression.
+
+ Attr := N;
+ if Nkind (Attr) = N_Type_Conversion then
+ Attr := Expression (Attr);
+ Conversion_Added := True;
+ end if;
+
-- Heap-allocated controlled objects contain two extra pointers which
-- are not part of the actual type. Transform the attribute reference
-- into a runtime expression to add the size of the hidden header.
-- two pointers are already present in the type.
if VM_Target = No_VM
- and then Nkind (N) = N_Attribute_Reference
+ and then Nkind (Attr) = N_Attribute_Reference
and then Needs_Finalization (Ptyp)
- and then not Header_Size_Added (N)
+ and then not Header_Size_Added (Attr)
then
- Set_Header_Size_Added (N);
+ Set_Header_Size_Added (Attr);
-- Generate:
-- P'Max_Size_In_Storage_Elements +
-- Universal_Integer
-- (Header_Size_With_Padding (Ptyp'Alignment))
- Rewrite (N,
+ Rewrite (Attr,
Make_Op_Add (Loc,
- Left_Opnd => Relocate_Node (N),
+ Left_Opnd => Relocate_Node (Attr),
Right_Opnd =>
Convert_To (Universal_Integer,
Make_Function_Call (Loc,
New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Alignment))))));
- Analyze (N);
+ -- Add a conversion to the target type
+
+ if not Conversion_Added then
+ Rewrite (Attr,
+ Make_Type_Conversion (Loc,
+ Subtype_Mark => New_Reference_To (Typ, Loc),
+ Expression => Relocate_Node (Attr)));
+ end if;
+
+ Analyze (Attr);
return;
end if;
+ end;
--------------------
-- Mechanism_Code --
---------------------------
procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
- Loc : constant Source_Ptr := Sloc (Nod);
Comp_Type : constant Entity_Id := Component_Type (A_Type);
Body_Stmts : List_Id;
Has_Default_Init : Boolean;
Index_List : List_Id;
+ Loc : Source_Ptr;
Proc_Id : Entity_Id;
function Init_Component return List_Id;
-- Start of processing for Build_Array_Init_Proc
begin
+ -- The init proc is created when analyzing the freeze node for the type,
+ -- but it properly belongs with the array type declaration. However, if
+ -- the freeze node is for a subtype of a type declared in another unit
+ -- it seems preferable to use the freeze node as the source location of
+ -- of the init.proc. In any case this is preferable for gcov usage, and
+ -- the Sloc is not otherwise used by the compiler.
+
+ if In_Open_Scopes (Scope (A_Type)) then
+ Loc := Sloc (A_Type);
+ else
+ Loc := Sloc (Nod);
+ end if;
+
-- Nothing to generate in the following cases:
-- 1. Initialization is suppressed for the type
return;
end if;
+ -- Reset Last_Assignment for any parameters of mode out or in out, to
+ -- prevent spurious warnings about overwriting for assignments to the
+ -- formal in the inlined code.
+
+ if Is_Entity_Name (A)
+ and then Ekind (F) /= E_In_Parameter
+ then
+ Set_Last_Assignment (Entity (A), Empty);
+ end if;
+
-- If the argument may be a controlling argument in a call within
-- the inlined body, we must preserve its classwide nature to insure
-- that dynamic dispatching take place subsequently. If the formal
type Mks_Type is new Long_Long_Float
with
Dimension_System => (
- (Meter, 'm'),
- (Kilogram, "kg"),
- (Second, 's'),
- (Ampere, 'A'),
- (Kelvin, 'K'),
- (Mole, "mol"),
- (Candela, "cd"));
+ (Unit_Name => Meter, Unit_Symbol => 'm', Dim_Symbol => 'L'),
+ (Unit_Name => Kilogram, Unit_Symbol => "kg", Dim_Symbol => 'M'),
+ (Unit_Name => Second, Unit_Symbol => 's', Dim_Symbol => 'T'),
+ (Unit_Name => Ampere, Unit_Symbol => 'A', Dim_Symbol => 'I'),
+ (Unit_Name => Kelvin, Unit_Symbol => 'K', Dim_Symbol => "Theta"),
+ (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'),
+ (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J'));
@end smallexample
@noindent
@smallexample @c ada
subtype Length is Mks_Type
with
- Dimension => ('m',
- Meter => 1,
+ Dimension => (Symbol => 'm',
+ Meter => 1,
others => 0);
@end smallexample
@noindent
example:
@smallexample @c ada
- m : constant Length := 1.0;
- kg : constant Mass := 1.0;
- s : constant Time := 1.0;
- A : constant Electric_Current := 1.0;
+ m : constant Length := 1.0;
+ kg : constant Mass := 1.0;
+ s : constant Time := 1.0;
+ A : constant Electric_Current := 1.0;
@end smallexample
@noindent
else
{
_uleb128_t cs_lp, cs_action;
- const unsigned char *p = region->call_site_table;
+ const unsigned char *p;
/* Let the caller know there may be an action to take, but let it
determine the kind. */
passed (to follow the ABI). */
if (!(uw_phase & _UA_FORCE_UNWIND))
{
+ enum action_kind act;
+
/* See if the filter we have is for an exception which
matches the one we are propagating. */
_Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
- action->kind = is_handled_by (choice, gnat_exception);
- if (action->kind != nothing)
+ act = is_handled_by (choice, gnat_exception);
+ if (act != nothing)
{
+ action->kind = act;
action->ttype_filter = ar_filter;
return;
}
projects / gcc.git / commitdiff