-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
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 Rtsfind; use Rtsfind;
-- 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 a 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. The following is correct and minimal, but the
- -- handling of more complex packed expressions in actuals is confused.
- -- It is likely that the problem only remains for actuals in calls.
+ -- 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));
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 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, PASize);
+ if Unknown_Esize (PAT) then
+ Set_Esize (PAT, PASize);
+ end if;
if Unknown_RM_Size (PAT) then
Set_RM_Size (PAT, PASize);
end if;
+ Adjust_Esize_Alignment (PAT);
+
-- Set remaining fields of packed array type
Init_Alignment (PAT);
-- type, since this size clearly belongs to the packed array type. The
-- size of the conceptual unpacked type is always set to unknown.
- PASize := 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
-- discriminants, so we treat it as a default/per-object expression.
Set_Parent (Len_Expr, Typ);
- Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
+ Analyze_Per_Use_Expression (Len_Expr, Standard_Long_Long_Integer);
-- Use a modular type if possible. We can do this if we have
-- static bounds, and the length is small enough, and the length
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.
-- 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_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;
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
-- 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
Csiz := Component_Size (Atyp);
Convert_To_PAT_Type (Obj);
- PAT := Etype (Obj);
+ PAT := Etype (Obj);
Cmask := 2 ** Csiz - 1;
OSDN Git Service
