Commit 5e77b60a by Robert Dewar Committed by Arnaud Charlet

checks.adb (Apply_Array_Size_Check): Completely remove this for GCC 3, since we…

checks.adb (Apply_Array_Size_Check): Completely remove this for GCC 3, since we now expect GCC 3 to do all the work.

2005-03-17  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Array_Size_Check): Completely remove this for GCC
	3, since we now expect GCC 3 to do all the work.

From-SVN: r96663
parent 5fa28bbb
...@@ -714,10 +714,6 @@ package body Checks is ...@@ -714,10 +714,6 @@ package body Checks is
-- Apply_Array_Size_Check -- -- Apply_Array_Size_Check --
---------------------------- ----------------------------
-- Note: Really of course this entre check should be in the backend,
-- and perhaps this is not quite the right value, but it is good
-- enough to catch the normal cases (and the relevant ACVC tests!)
-- The situation is as follows. In GNAT 3 (GCC 2.x), the size in bits -- The situation is as follows. In GNAT 3 (GCC 2.x), the size in bits
-- is computed in 32 bits without an overflow check. That's a real -- is computed in 32 bits without an overflow check. That's a real
-- problem for Ada. So what we do in GNAT 3 is to approximate the -- problem for Ada. So what we do in GNAT 3 is to approximate the
...@@ -726,8 +722,8 @@ package body Checks is ...@@ -726,8 +722,8 @@ package body Checks is
-- In GNAT 5, the size in byte is still computed in 32 bits without -- In GNAT 5, the size in byte is still computed in 32 bits without
-- an overflow check in the dynamic case, but the size in bits is -- an overflow check in the dynamic case, but the size in bits is
-- computed in 64 bits. We assume that's good enough, so we use the -- computed in 64 bits. We assume that's good enough, and we do not
-- size in bits for the test. -- bother to generate any front end test.
procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id) is procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
...@@ -808,6 +804,14 @@ package body Checks is ...@@ -808,6 +804,14 @@ package body Checks is
-- Start of processing for Apply_Array_Size_Check -- Start of processing for Apply_Array_Size_Check
begin begin
-- Do size check on local arrays. We only need this in the GCC 2
-- case, since in GCC 3, we expect the back end to properly handle
-- things. This routine can be removed when we baseline GNAT 3.
if Opt.GCC_Version >= 3 then
return;
end if;
-- No need for a check if not expanding -- No need for a check if not expanding
if not Expander_Active then if not Expander_Active then
...@@ -843,144 +847,113 @@ package body Checks is ...@@ -843,144 +847,113 @@ package body Checks is
end if; end if;
end loop; end loop;
-- GCC 3 case -- First step is to calculate the maximum number of elements. For
-- this calculation, we use the actual size of the subtype if it is
-- static, and if a bound of a subtype is non-static, we go to the
-- bound of the base type.
if Opt.GCC_Version = 3 then Siz := Uint_1;
Indx := First_Index (Typ);
while Present (Indx) loop
Xtyp := Etype (Indx);
Lo := Type_Low_Bound (Xtyp);
Hi := Type_High_Bound (Xtyp);
-- No problem if size is known at compile time (even if the front -- If any bound raises constraint error, we will never get this
-- end does not know it) because the back end does do overflow -- far, so there is no need to generate any kind of check.
-- checking on the size in bytes if it is compile time known.
if Size_Known_At_Compile_Time (Typ) then if Raises_Constraint_Error (Lo)
or else
Raises_Constraint_Error (Hi)
then
Uintp.Release (Umark);
return; return;
end if; end if;
end if;
-- Following code is temporarily deleted, since GCC 3 is returning
-- zero for size in bits of large dynamic arrays. ???
-- -- Otherwise we check for the size in bits exceeding 2**31-1 * 8.
-- -- This is the case in which we could end up with problems from
-- -- an unnoticed overflow in computing the size in bytes
--
-- Check_Siz := (Uint_2 ** 31 - Uint_1) * Uint_8;
--
-- Sizx :=
-- Make_Attribute_Reference (Loc,
-- Prefix => New_Occurrence_Of (Typ, Loc),
-- Attribute_Name => Name_Size);
-- GCC 2 case (for now this is for GCC 3 dynamic case as well) -- Otherwise get bounds values
begin if Is_Static_Expression (Lo) then
-- First step is to calculate the maximum number of elements. For Lob := Expr_Value (Lo);
-- this calculation, we use the actual size of the subtype if it is else
-- static, and if a bound of a subtype is non-static, we go to the Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
-- bound of the base type. Static := False;
end if;
Siz := Uint_1;
Indx := First_Index (Typ);
while Present (Indx) loop
Xtyp := Etype (Indx);
Lo := Type_Low_Bound (Xtyp);
Hi := Type_High_Bound (Xtyp);
-- If any bound raises constraint error, we will never get this
-- far, so there is no need to generate any kind of check.
if Raises_Constraint_Error (Lo)
or else
Raises_Constraint_Error (Hi)
then
Uintp.Release (Umark);
return;
end if;
-- Otherwise get bounds values if Is_Static_Expression (Hi) then
Hib := Expr_Value (Hi);
else
Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
Static := False;
end if;
if Is_Static_Expression (Lo) then Siz := Siz * UI_Max (Hib - Lob + 1, Uint_0);
Lob := Expr_Value (Lo); Next_Index (Indx);
else end loop;
Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
Static := False;
end if;
if Is_Static_Expression (Hi) then -- Compute the limit against which we want to check. For subprograms,
Hib := Expr_Value (Hi); -- where the array will go on the stack, we use 8*2**24, which (in
else -- bits) is the size of a 16 megabyte array.
Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
Static := False;
end if;
Siz := Siz * UI_Max (Hib - Lob + 1, Uint_0); if Is_Subprogram (Scope (Ent)) then
Next_Index (Indx); Check_Siz := Uint_2 ** 27;
end loop; else
Check_Siz := Uint_2 ** 31;
end if;
-- Compute the limit against which we want to check. For subprograms, -- If we have all static bounds and Siz is too large, then we know
-- where the array will go on the stack, we use 8*2**24, which (in -- we know we have a storage error right now, so generate message
-- bits) is the size of a 16 megabyte array.
if Is_Subprogram (Scope (Ent)) then if Static and then Siz >= Check_Siz then
Check_Siz := Uint_2 ** 27; Insert_Action (N,
else Make_Raise_Storage_Error (Loc,
Check_Siz := Uint_2 ** 31; Reason => SE_Object_Too_Large));
end if; Error_Msg_N ("?Storage_Error will be raised at run-time", N);
Uintp.Release (Umark);
return;
end if;
-- If we have all static bounds and Siz is too large, then we know -- Case of component size known at compile time. If the array
-- we know we have a storage error right now, so generate message -- size is definitely in range, then we do not need a check.
if Static and then Siz >= Check_Siz then if Known_Esize (Ctyp)
Insert_Action (N, and then Siz * Esize (Ctyp) < Check_Siz
Make_Raise_Storage_Error (Loc, then
Reason => SE_Object_Too_Large)); Uintp.Release (Umark);
Error_Msg_N ("?Storage_Error will be raised at run-time", N); return;
Uintp.Release (Umark); end if;
return;
end if;
-- Case of component size known at compile time. If the array -- Here if a dynamic check is required
-- size is definitely in range, then we do not need a check.
if Known_Esize (Ctyp) -- What we do is to build an expression for the size of the array,
and then Siz * Esize (Ctyp) < Check_Siz -- which is computed as the 'Size of the array component, times
then -- the size of each dimension.
Uintp.Release (Umark);
return;
end if;
-- Here if a dynamic check is required Uintp.Release (Umark);
-- What we do is to build an expression for the size of the array, Sizx :=
-- which is computed as the 'Size of the array component, times Make_Attribute_Reference (Loc,
-- the size of each dimension. Prefix => New_Occurrence_Of (Ctyp, Loc),
Attribute_Name => Name_Size);
Uintp.Release (Umark); Indx := First_Index (Typ);
for J in 1 .. Number_Dimensions (Typ) loop
if Sloc (Etype (Indx)) = Sloc (N) then
Ensure_Defined (Etype (Indx), N);
end if;
Sizx := Sizx :=
Make_Attribute_Reference (Loc, Make_Op_Multiply (Loc,
Prefix => New_Occurrence_Of (Ctyp, Loc), Left_Opnd => Sizx,
Attribute_Name => Name_Size); Right_Opnd =>
Make_Attribute_Reference (Loc,
Indx := First_Index (Typ); Prefix => New_Occurrence_Of (Typ, Loc),
for J in 1 .. Number_Dimensions (Typ) loop Attribute_Name => Name_Length,
if Sloc (Etype (Indx)) = Sloc (N) then Expressions => New_List (
Ensure_Defined (Etype (Indx), N); Make_Integer_Literal (Loc, J))));
end if; Next_Index (Indx);
end loop;
Sizx := -- Emit the check
Make_Op_Multiply (Loc,
Left_Opnd => Sizx,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Length,
Expressions => New_List (
Make_Integer_Literal (Loc, J))));
Next_Index (Indx);
end loop;
end;
-- Common code to actually emit the check
Code := Code :=
Make_Raise_Storage_Error (Loc, Make_Raise_Storage_Error (Loc,
...@@ -990,7 +963,7 @@ package body Checks is ...@@ -990,7 +963,7 @@ package body Checks is
Right_Opnd => Right_Opnd =>
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Intval => Check_Siz)), Intval => Check_Siz)),
Reason => SE_Object_Too_Large); Reason => SE_Object_Too_Large);
Set_Size_Check_Code (Defining_Identifier (N), Code); Set_Size_Check_Code (Defining_Identifier (N), Code);
Insert_Action (N, Code, Suppress => All_Checks); Insert_Action (N, Code, Suppress => All_Checks);
......
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