Commit 507ed3fd by Arnaud Charlet

Refine previous change.

From-SVN: r146099
parent 8aec446b
...@@ -2936,9 +2936,10 @@ package body Exp_Ch4 is ...@@ -2936,9 +2936,10 @@ package body Exp_Ch4 is
-- and their unrestricted access used instead of the coextension. -- and their unrestricted access used instead of the coextension.
function Size_In_Storage_Elements (E : Entity_Id) return Node_Id; function Size_In_Storage_Elements (E : Entity_Id) return Node_Id;
-- Given a type E, returns a node representing the code to compute the -- Given a constrained array type E, returns a node representing the
-- size in storage elements for the given type. This is not as trivial -- code to compute the size in storage elements for the given type.
-- as one might expect, as explained in the body. -- This is done without using the attribute (which malfunctins for
-- large sizes ???)
--------------------------------------- ---------------------------------------
-- Complete_Coextension_Finalization -- -- Complete_Coextension_Finalization --
...@@ -3180,10 +3181,7 @@ package body Exp_Ch4 is ...@@ -3180,10 +3181,7 @@ package body Exp_Ch4 is
-- 32-bit limit on a 32-bit machine, and precisely the trouble -- 32-bit limit on a 32-bit machine, and precisely the trouble
-- is that we get overflows when sizes are greater than 2**31. -- is that we get overflows when sizes are greater than 2**31.
-- So what we end up doing is using this expression for non-array -- So what we end up doing for array types is to use the expression:
-- types, where it is not quite right, but should be good enough
-- most of the time. But for non-packed arrays, instead we compute
-- the expression:
-- number-of-elements * component_type'Max_Size_In_Storage_Elements -- number-of-elements * component_type'Max_Size_In_Storage_Elements
...@@ -3192,48 +3190,38 @@ package body Exp_Ch4 is ...@@ -3192,48 +3190,38 @@ package body Exp_Ch4 is
-- are too large, and which in the absence of a check results in -- are too large, and which in the absence of a check results in
-- undetected chaos ??? -- undetected chaos ???
if Is_Array_Type (E) and then Is_Constrained (E) then declare
declare Len : Node_Id;
Len : Node_Id; Res : Node_Id;
Res : Node_Id;
begin
for J in 1 .. Number_Dimensions (E) loop
Len :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (E, Loc),
Attribute_Name => Name_Length,
Expressions => New_List (
Make_Integer_Literal (Loc, J)));
if J = 1 then
Res := Len;
else begin
Res := for J in 1 .. Number_Dimensions (E) loop
Make_Op_Multiply (Loc, Len :=
Left_Opnd => Res, Make_Attribute_Reference (Loc,
Right_Opnd => Len); Prefix => New_Occurrence_Of (E, Loc),
end if; Attribute_Name => Name_Length,
end loop; Expressions => New_List (
Make_Integer_Literal (Loc, J)));
return if J = 1 then
Make_Op_Multiply (Loc, Res := Len;
Left_Opnd => Len,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Component_Type (E), Loc),
Attribute_Name => Name_Max_Size_In_Storage_Elements));
end;
-- Here for other than non-bit-packed array else
Res :=
Make_Op_Multiply (Loc,
Left_Opnd => Res,
Right_Opnd => Len);
end if;
end loop;
else
return return
Make_Attribute_Reference (Loc, Make_Op_Multiply (Loc,
Prefix => New_Occurrence_Of (E, Loc), Left_Opnd => Len,
Attribute_Name => Name_Max_Size_In_Storage_Elements); Right_Opnd =>
end if; Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Component_Type (E), Loc),
Attribute_Name => Name_Max_Size_In_Storage_Elements));
end;
end Size_In_Storage_Elements; end Size_In_Storage_Elements;
-- Start of processing for Expand_N_Allocator -- Start of processing for Expand_N_Allocator
...@@ -3363,18 +3351,25 @@ package body Exp_Ch4 is ...@@ -3363,18 +3351,25 @@ package body Exp_Ch4 is
-- raise Storage_Error; -- raise Storage_Error;
-- end if; -- end if;
-- where 3.5 gigabytes is a constant large enough to accomodate -- where 3.5 gigabytes is a constant large enough to accomodate any
-- any reasonable request for -- reasonable request for. But we can't do it this way because at
-- least at the moment we don't compute this attribute right, and
-- can silently give wrong results when the result gets large. Since
-- this is all about large results, that's bad, so instead we only
-- applly the check for constrained arrays, and manually compute the
-- value of the attribute ???
Insert_Action (N, if Is_Array_Type (Etyp) and then Is_Constrained (Etyp) then
Make_Raise_Storage_Error (Loc, Insert_Action (N,
Condition => Make_Raise_Storage_Error (Loc,
Make_Op_Gt (Loc, Condition =>
Left_Opnd => Size_In_Storage_Elements (Etyp), Make_Op_Gt (Loc,
Right_Opnd => Left_Opnd => Size_In_Storage_Elements (Etyp),
Make_Integer_Literal (Loc, Right_Opnd =>
Intval => Uint_7 * (Uint_2 ** 29))), Make_Integer_Literal (Loc,
Reason => SE_Object_Too_Large)); Intval => Uint_7 * (Uint_2 ** 29))),
Reason => SE_Object_Too_Large));
end if;
end if; end if;
-- Handle case of qualified expression (other than optimization above) -- Handle case of qualified expression (other than optimization above)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment