-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
with Atree; use Atree;
with Checks; use Checks;
with Einfo; use Einfo;
+with Errout; use Errout;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
+with Layout; use Layout;
+with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
+with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch13; use Sem_Ch13;
function RJ_Unchecked_Convert_To
(Typ : Entity_Id;
- Expr : Node_Id)
- return Node_Id;
+ Expr : Node_Id) return Node_Id;
-- The packed array code does unchecked conversions which in some cases
-- may involve non-discrete types with differing sizes. The semantics of
-- such conversions is potentially endian dependent, and the effect we
-- directly using Insert_Action.
------------------------------
- -- Compute_Linear_Subcsript --
+ -- Compute_Linear_Subscript --
------------------------------
procedure Compute_Linear_Subscript
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Styp, Loc),
- Attribute_Name => Name_First)))));
+ Prefix => New_Occurrence_Of (Styp, Loc),
+ Attribute_Name => Name_First)))));
end if;
Set_Paren_Count (Newsub, 1);
-- The PAT is always obtained from the actual subtype
- procedure Convert_To_PAT_Type (Aexp : Entity_Id) is
+ procedure Convert_To_PAT_Type (Aexp : Node_Id) is
Act_ST : Entity_Id;
begin
Act_ST := Underlying_Type (Etype (Aexp));
Create_Packed_Array_Type (Act_ST);
- -- Just replace the etype with the packed array type. This works
- -- because the expression will not be further analyzed, and Gigi
- -- considers the two types equivalent in any case.
+ -- Just replace the etype with the packed array type. This works because
+ -- the expression will not be further analyzed, and Gigi considers the
+ -- two types equivalent in any case.
+
+ -- This is not strictly the case ??? If the reference is an actual in
+ -- call, the expansion of the prefix is delayed, and must be reanalyzed,
+ -- see Reset_Packed_Prefix. On the other hand, if the prefix is a simple
+ -- array reference, reanalysis can produce spurious type errors when the
+ -- PAT type is replaced again with the original type of the array. Same
+ -- for the case of a dereference. The following is correct and minimal,
+ -- but the handling of more complex packed expressions in actuals is
+ -- confused. Probably the problem only remains for actuals in calls.
Set_Etype (Aexp, Packed_Array_Type (Act_ST));
+
+ if Is_Entity_Name (Aexp)
+ or else
+ (Nkind (Aexp) = N_Indexed_Component
+ and then Is_Entity_Name (Prefix (Aexp)))
+ or else Nkind (Aexp) = N_Explicit_Dereference
+ then
+ Set_Analyzed (Aexp);
+ end if;
end Convert_To_PAT_Type;
------------------------------
Ancest : Entity_Id;
PB_Type : Entity_Id;
- Esiz : Uint;
+ PASize : Uint;
Decl : Node_Id;
PAT : Entity_Id;
Len_Dim : Node_Id;
end if;
if Scope (Typ) /= Current_Scope then
- New_Scope (Scope (Typ));
+ Push_Scope (Scope (Typ));
Pushed_Scope := True;
end if;
end if;
-- Set Esize and RM_Size to the actual size of the packed object
- -- Do not reset RM_Size if already set, as happens in the case
- -- of a modular type.
+ -- Do not reset RM_Size if already set, as happens in the case of
+ -- a modular type.
- Set_Esize (PAT, Esiz);
+ if Unknown_Esize (PAT) then
+ Set_Esize (PAT, PASize);
+ end if;
if Unknown_RM_Size (PAT) then
- Set_RM_Size (PAT, Esiz);
+ Set_RM_Size (PAT, PASize);
end if;
+ Adjust_Esize_Alignment (PAT);
+
-- Set remaining fields of packed array type
Init_Alignment (PAT);
Set_Has_Delayed_Freeze (PAT, False);
Set_Has_Delayed_Freeze (Etype (PAT), False);
+
+ -- If we did allocate a freeze node, then clear out the reference
+ -- since it is obsolete (should we delete the freeze node???)
+
+ Set_Freeze_Node (PAT, Empty);
+ Set_Freeze_Node (Etype (PAT), Empty);
end Install_PAT;
-----------------
-- If our immediate ancestor subtype is constrained, and it already
-- has a packed array type, then just share the same type, since the
- -- bounds must be the same.
+ -- bounds must be the same. If the ancestor is not an array type but
+ -- a private type, as can happen with multiple instantiations, create
+ -- a new packed type, to avoid privacy issues.
if Ekind (Typ) = E_Array_Subtype then
Ancest := Ancestor_Subtype (Typ);
if Present (Ancest)
+ and then Is_Array_Type (Ancest)
and then Is_Constrained (Ancest)
and then Present (Packed_Array_Type (Ancest))
then
-- type, since this size clearly belongs to the packed array type. The
-- size of the conceptual unpacked type is always set to unknown.
- Esiz := Esize (Typ);
+ PASize := RM_Size (Typ);
-- Case of an array where at least one index is of an enumeration
-- type with a non-standard representation, but the component size
Make_Range (Loc,
Low_Bound =>
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
- Expressions => New_List (
+ Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_First))),
High_Bound =>
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Pos,
- Expressions => New_List (
+ Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of (Indx_Typ, Loc),
Attribute_Name => Name_Last)))))));
-- discriminants, so we treat it as a default/per-object expression.
Set_Parent (Len_Expr, Typ);
- Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
+ Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer);
- -- Use a modular type if possible. We can do this if we are we
- -- have static bounds, and the length is small enough, and the
- -- length is not zero. We exclude the zero length case because the
- -- size of things is always at least one, and the zero length object
- -- would have an anomous size.
+ -- Use a modular type if possible. We can do this if we have
+ -- static bounds, and the length is small enough, and the length
+ -- is not zero. We exclude the zero length case because the size
+ -- of things is always at least one, and the zero length object
+ -- would have an anomalous size.
if Compile_Time_Known_Value (Len_Expr) then
Len_Bits := Expr_Value (Len_Expr) * Csize;
+ -- Check for size known to be too large
+
+ if Len_Bits >
+ Uint_2 ** (Standard_Integer_Size - 1) * System_Storage_Unit
+ then
+ if System_Storage_Unit = 8 then
+ Error_Msg_N
+ ("packed array size cannot exceed " &
+ "Integer''Last bytes", Typ);
+ else
+ Error_Msg_N
+ ("packed array size cannot exceed " &
+ "Integer''Last storage units", Typ);
+ end if;
+
+ -- Reset length to arbitrary not too high value to continue
+
+ Len_Expr := Make_Integer_Literal (Loc, 65535);
+ Analyze_And_Resolve (Len_Expr, Standard_Long_Long_Integer);
+ end if;
+
-- We normally consider small enough to mean no larger than the
-- value of System_Max_Binary_Modulus_Power, checking that in the
-- case of values longer than word size, we have long shifts.
(Len_Bits <= System_Word_Size
or else (Len_Bits <= System_Max_Binary_Modulus_Power
and then Support_Long_Shifts_On_Target))
-
- -- Also test for alignment given. If an alignment is given which
- -- is smaller than the natural modular alignment, force the array
- -- of bytes representation to accommodate the alignment.
-
- and then
- (No (Alignment_Clause (Typ))
- or else
- Alignment (Typ) >= ((Len_Bits + System_Storage_Unit)
- / System_Storage_Unit))
then
-- We can use the modular type, it has the form:
-- subtype tttPn is btyp
- -- range 0 .. 2 ** (Esize (Typ) * Csize) - 1;
+ -- range 0 .. 2 ** ((Typ'Length (1)
+ -- * ... * Typ'Length (n)) * Csize) - 1;
- -- The bounds are statically known, and btyp is one
- -- of the unsigned types, depending on the length. If the
- -- type is its first subtype, i.e. it is a user-defined
- -- type, no object of the type will be larger, and it is
- -- worthwhile to use a small unsigned type.
+ -- The bounds are statically known, and btyp is one of the
+ -- unsigned types, depending on the length.
- if Len_Bits <= Standard_Short_Integer_Size
- and then First_Subtype (Typ) = Typ
- then
+ if Len_Bits <= Standard_Short_Short_Integer_Size then
+ Btyp := RTE (RE_Short_Short_Unsigned);
+
+ elsif Len_Bits <= Standard_Short_Integer_Size then
Btyp := RTE (RE_Short_Unsigned);
elsif Len_Bits <= Standard_Integer_Size then
Make_Integer_Literal (Loc, 0),
High_Bound => Lit))));
- if Esiz = Uint_0 then
- Esiz := Len_Bits;
+ if PASize = Uint_0 then
+ PASize := Len_Bits;
end if;
Install_PAT;
+
+ -- Propagate a given alignment to the modular type. This can
+ -- cause it to be under-aligned, but that's OK.
+
+ if Present (Alignment_Clause (Typ)) then
+ Set_Alignment (PAT, Alignment (Typ));
+ end if;
+
return;
end if;
end if;
-- subtype tttPn is
-- System.Packed_Bytes{1,2,4} (0 .. (Bits + 7) / 8 - 1);
- -- Bits is the length of the array in bits.
+ -- Bits is the length of the array in bits
Set_PB_Type;
Make_Subtype_Indication (Loc,
Subtype_Mark => New_Occurrence_Of (PB_Type, Loc),
Constraint =>
-
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Range (Loc,
Low_Bound =>
Make_Integer_Literal (Loc, 0),
- High_Bound => PAT_High)))));
+ High_Bound =>
+ Convert_To (Standard_Integer, PAT_High))))));
Install_PAT;
+
+ -- Currently the code in this unit requires that packed arrays
+ -- represented by non-modular arrays of bytes be on a byte
+ -- boundary for bit sizes handled by System.Pack_nn units.
+ -- That's because these units assume the array being accessed
+ -- starts on a byte boundary.
+
+ if Get_Id (UI_To_Int (Csize)) /= RE_Null then
+ Set_Must_Be_On_Byte_Boundary (Typ);
+ end if;
end if;
end Create_Packed_Array_Type;
-- conversion is analyzed immediately so that subsequent processing
-- can work with an analyzed Rhs (and e.g. look at its Etype)
+ -- If the right-hand side is a string literal, create a temporary for
+ -- it, constant-folding is not ready to wrap the bit representation
+ -- of a string literal.
+
+ if Nkind (Rhs) = N_String_Literal then
+ declare
+ Decl : Node_Id;
+ begin
+ Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, New_Internal_Name ('T')),
+ Object_Definition => New_Occurrence_Of (Ctyp, Loc),
+ Expression => New_Copy_Tree (Rhs));
+
+ Insert_Actions (N, New_List (Decl));
+ Rhs := New_Occurrence_Of (Defining_Identifier (Decl), Loc);
+ end;
+ end if;
+
Rhs := Convert_To (Ctyp, Rhs);
Set_Parent (Rhs, N);
- Analyze_And_Resolve (Rhs, Ctyp);
+
+ -- If we are building the initialization procedure for a packed array,
+ -- and Initialize_Scalars is enabled, each component assignment is an
+ -- out-of-range value by design. Compile this value without checks,
+ -- because a call to the array init_proc must not raise an exception.
+
+ if Within_Init_Proc
+ and then Initialize_Scalars
+ then
+ Analyze_And_Resolve (Rhs, Ctyp, Suppress => All_Checks);
+ else
+ Analyze_And_Resolve (Rhs, Ctyp);
+ end if;
-- Case of component size 1,2,4 or any component size for the modular
-- case. These are the cases for which we can inline the code.
-- the "or ..." is omitted if rhs is constant and all 0 bits
- -- rhs is converted to the appropriate type.
+ -- rhs is converted to the appropriate type
-- The result is converted back to the array type, since
-- otherwise we lose knowledge of the packed nature.
end if;
end if;
- New_Lhs := Duplicate_Subexpr (Obj, True);
- New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
+ -- Now create copies removing side effects. Note that in some
+ -- complex cases, this may cause the fact that we have already
+ -- set a packed array type on Obj to get lost. So we save the
+ -- type of Obj, and make sure it is reset properly.
+
+ declare
+ T : constant Entity_Id := Etype (Obj);
+ begin
+ New_Lhs := Duplicate_Subexpr (Obj, True);
+ New_Rhs := Duplicate_Subexpr_No_Checks (Obj);
+ Set_Etype (Obj, T);
+ Set_Etype (New_Lhs, T);
+ Set_Etype (New_Rhs, T);
+ end;
-- First we deal with the "and"
else
-- We have to convert the right hand side to Etype (Obj).
- -- A special case case arises if what we have now is a Val
+ -- A special case arises if what we have now is a Val
-- attribute reference whose expression type is Etype (Obj).
-- This happens for assignments of fields from the same
-- array. In this case we get the required right hand side
-- Set_nn (Arr'address, Subscr, Bits_nn!(Rhs))
- -- where Subscr is the computed linear subscript.
+ -- where Subscr is the computed linear subscript
declare
Bits_nn : constant Entity_Id := RTE (Bits_Id (Csiz));
begin
if No (Bits_nn) then
- -- Error, most likely High_Integrity_Mode restriction.
+ -- Error, most likely High_Integrity_Mode restriction
return;
end if;
Name => New_Occurrence_Of (Set_nn, Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => Obj),
+ Prefix => Obj,
+ Attribute_Name => Name_Address),
Subscr,
Unchecked_Convert_To (Bits_nn,
Convert_To (Ctyp, Rhs)))));
Ltyp := Etype (L);
Rtyp := Etype (R);
- -- First an odd and silly test. We explicitly check for the XOR
- -- case where the component type is True .. True, since this will
- -- raise constraint error. A special check is required since CE
- -- will not be required other wise (cf Expand_Packed_Not).
-
- -- No such check is required for AND and OR, since for both these
- -- cases False op False = False, and True op True = True.
+ -- Deal with silly case of XOR where the subcomponent has a range
+ -- True .. True where an exception must be raised.
if Nkind (N) = N_Op_Xor then
- declare
- CT : constant Entity_Id := Component_Type (Rtyp);
- BT : constant Entity_Id := Base_Type (CT);
-
- begin
- Insert_Action (N,
- Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Op_And (Loc,
- Left_Opnd =>
- Make_Op_Eq (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (CT, Loc),
- Attribute_Name => Name_First),
-
- Right_Opnd =>
- Convert_To (BT,
- New_Occurrence_Of (Standard_True, Loc))),
-
- Right_Opnd =>
- Make_Op_Eq (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (CT, Loc),
- Attribute_Name => Name_Last),
-
- Right_Opnd =>
- Convert_To (BT,
- New_Occurrence_Of (Standard_True, Loc)))),
- Reason => CE_Range_Check_Failed));
- end;
+ Silly_Boolean_Array_Xor_Test (N, Rtyp);
end if;
-- Now that that silliness is taken care of, get packed array type
-- convert to the base type, since this would be unconstrained, and
-- hence not have a corresponding packed array type set.
- -- Note that both operands must be modular for this code to be used.
+ -- Note that both operands must be modular for this code to be used
if Is_Modular_Integer_Type (PAT)
and then
P := Make_Op_Xor (Loc, L, R);
end if;
- Rewrite (N, Unchecked_Convert_To (Rtyp, P));
+ Rewrite (N, Unchecked_Convert_To (Ltyp, P));
end;
-- For the array case, we insert the actions
-- Result : Ltype;
- -- System.Bitops.Bit_And/Or/Xor
+ -- System.Bit_Ops.Bit_And/Or/Xor
-- (Left'Address,
-- Ltype'Length * Ltype'Component_Size;
-- Right'Address,
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => L),
+ Prefix => L,
+ Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of
(Etype (First_Index (Ltyp)), Loc),
Attribute_Name => Name_Range_Length),
+
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => R),
+ Prefix => R,
+ Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
+
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
+ Prefix => New_Occurrence_Of (Result_Ent, Loc),
+ Attribute_Name => Name_Address)))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
return;
end if;
- -- Remaining processing is for the bit-packed case.
+ -- Remaining processing is for the bit-packed case
Obj := Relocate_Node (Prefix (N));
Convert_To_Actual_Subtype (Obj);
Left_Opnd => Make_Shift_Right (Obj, Shift),
Right_Opnd => Lit);
- -- We neded to analyze this before we do the unchecked convert
+ -- We needed to analyze this before we do the unchecked convert
-- below, but we need it temporarily attached to the tree for
-- this analysis (hence the temporary Set_Parent call).
-- Component_Type!(Get_nn (Arr'address, Subscr))
- -- where Subscr is the computed linear subscript.
+ -- where Subscr is the computed linear subscript
declare
Get_nn : Entity_Id;
Name => New_Occurrence_Of (Get_nn, Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => Obj),
+ Prefix => Obj,
+ Attribute_Name => Name_Address),
Subscr))));
end;
end if;
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Length,
- Prefix => New_Occurrence_Of (Ltyp, Loc)),
+ Prefix => New_Occurrence_Of (Ltyp, Loc),
+ Attribute_Name => Name_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Ltyp)));
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Length,
- Prefix => New_Occurrence_Of (Rtyp, Loc)),
+ Prefix => New_Occurrence_Of (Rtyp, Loc),
+ Attribute_Name => Name_Length),
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp)));
Name => New_Occurrence_Of (RTE (RE_Bit_Eq), Loc),
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => L),
+ Prefix => L,
+ Attribute_Name => Name_Address),
LLexpr,
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => R),
+ Prefix => R,
+ Attribute_Name => Name_Address),
RLexpr)));
end if;
Convert_To_Actual_Subtype (Opnd);
Rtyp := Etype (Opnd);
- -- First an odd and silly test. We explicitly check for the case
- -- where the 'First of the component type is equal to the 'Last of
- -- this component type, and if this is the case, we make sure that
- -- constraint error is raised. The reason is that the NOT is bound
- -- to cause CE in this case, and we will not otherwise catch it.
+ -- Deal with silly False..False and True..True subtype case
- -- Believe it or not, this was reported as a bug. Note that nearly
- -- always, the test will evaluate statically to False, so the code
- -- will be statically removed, and no extra overhead caused.
+ Silly_Boolean_Array_Not_Test (N, Rtyp);
- declare
- CT : constant Entity_Id := Component_Type (Rtyp);
-
- begin
- Insert_Action (N,
- Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Op_Eq (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (CT, Loc),
- Attribute_Name => Name_First),
-
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (CT, Loc),
- Attribute_Name => Name_Last)),
- Reason => CE_Range_Check_Failed));
- end;
-
- -- Now that that silliness is taken care of, get packed array type
+ -- Now that the silliness is taken care of, get packed array type
Convert_To_PAT_Type (Opnd);
PAT := Etype (Opnd);
-- one bits of length equal to the size of this packed type and
-- rtyp is the actual subtype of the operand
- Lit := Make_Integer_Literal (Loc, 2 ** Esize (PAT) - 1);
+ Lit := Make_Integer_Literal (Loc, 2 ** RM_Size (PAT) - 1);
Set_Print_In_Hex (Lit);
if not Is_Array_Type (PAT) then
-- Result : Typ;
- -- System.Bitops.Bit_Not
+ -- System.Bit_Ops.Bit_Not
-- (Opnd'Address,
-- Typ'Length * Typ'Component_Size;
-- Result'Address);
Parameter_Associations => New_List (
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => Opnd),
+ Prefix => Opnd,
+ Attribute_Name => Name_Address),
Make_Op_Multiply (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
New_Occurrence_Of
(Etype (First_Index (Rtyp)), Loc),
Attribute_Name => Name_Range_Length),
+
Right_Opnd =>
Make_Integer_Literal (Loc, Component_Size (Rtyp))),
Make_Byte_Aligned_Attribute_Reference (Loc,
- Attribute_Name => Name_Address,
- Prefix => New_Occurrence_Of (Result_Ent, Loc))))));
+ Prefix => New_Occurrence_Of (Result_Ent, Loc),
+ Attribute_Name => Name_Address)))));
Rewrite (N,
New_Occurrence_Of (Result_Ent, Loc));
function RJ_Unchecked_Convert_To
(Typ : Entity_Id;
- Expr : Node_Id)
- return Node_Id
+ Expr : Node_Id) return Node_Id
is
Source_Typ : constant Entity_Id := Etype (Expr);
Target_Typ : constant Entity_Id := Typ;
Csiz := Component_Size (Atyp);
Convert_To_PAT_Type (Obj);
- PAT := Etype (Obj);
+ PAT := Etype (Obj);
Cmask := 2 ** Csiz - 1;
OSDN Git Service
