OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Robert Dewar 2005-03-18 12:47:50 +01:00 committed by Arnaud Charlet
parent 5fa28bbb03
commit 5e77b60afd
1 changed files with 104 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

235
gcc/ada/checks.adb
View File

@ -714,10 +714,6 @@ package body Checks is
-- 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
-- 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
@ -726,8 +722,8 @@ package body Checks is
-- 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
-- computed in 64 bits. We assume that's good enough, so we use the
-- size in bits for the test.
-- computed in 64 bits. We assume that's good enough, and we do not
-- bother to generate any front end test.
procedure Apply_Array_Size_Check (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
@ -808,6 +804,14 @@ package body Checks is
-- Start of processing for Apply_Array_Size_Check
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
if not Expander_Active then
@ -843,144 +847,113 @@ package body Checks is
end if;
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
-- end does not know it) because the back end does do overflow
-- checking on the size in bytes if it is compile time known.
-- If any bound raises constraint error, we will never get this
-- far, so there is no need to generate any kind of check.
if Size_Known_At_Compile_Time (Typ) then
return;
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)
begin
-- 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.
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 (Lo) then
Lob := Expr_Value (Lo);
else
Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
Static := False;
end if;
if Is_Static_Expression (Hi) then
Hib := Expr_Value (Hi);
else
Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
Static := False;
end if;
Siz := Siz * UI_Max (Hib - Lob + 1, Uint_0);
Next_Index (Indx);
end loop;
-- Compute the limit against which we want to check. For subprograms,
-- where the array will go on the stack, we use 8*2**24, which (in
-- bits) is the size of a 16 megabyte array.
if Is_Subprogram (Scope (Ent)) then
Check_Siz := Uint_2 ** 27;
else
Check_Siz := Uint_2 ** 31;
end if;
-- If we have all static bounds and Siz is too large, then we know
-- we know we have a storage error right now, so generate message
if Static and then Siz >= Check_Siz then
Insert_Action (N,
Make_Raise_Storage_Error (Loc,
Reason => SE_Object_Too_Large));
Error_Msg_N ("?Storage_Error will be raised at run-time", N);
Uintp.Release (Umark);
return;
end if;
-- Case of component size known at compile time. If the array
-- size is definitely in range, then we do not need a check.
if Known_Esize (Ctyp)
and then Siz * Esize (Ctyp) < Check_Siz
if Raises_Constraint_Error (Lo)
or else
Raises_Constraint_Error (Hi)
then
Uintp.Release (Umark);
return;
end if;
-- Here if a dynamic check is required
-- Otherwise get bounds values
-- What we do is to build an expression for the size of the array,
-- which is computed as the 'Size of the array component, times
-- the size of each dimension.
if Is_Static_Expression (Lo) then
Lob := Expr_Value (Lo);
else
Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
Static := False;
end if;
if Is_Static_Expression (Hi) then
Hib := Expr_Value (Hi);
else
Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
Static := False;
end if;
Siz := Siz * UI_Max (Hib - Lob + 1, Uint_0);
Next_Index (Indx);
end loop;
-- Compute the limit against which we want to check. For subprograms,
-- where the array will go on the stack, we use 8*2**24, which (in
-- bits) is the size of a 16 megabyte array.
if Is_Subprogram (Scope (Ent)) then
Check_Siz := Uint_2 ** 27;
else
Check_Siz := Uint_2 ** 31;
end if;
-- If we have all static bounds and Siz is too large, then we know
-- we know we have a storage error right now, so generate message
if Static and then Siz >= Check_Siz then
Insert_Action (N,
Make_Raise_Storage_Error (Loc,
Reason => SE_Object_Too_Large));
Error_Msg_N ("?Storage_Error will be raised at run-time", N);
Uintp.Release (Umark);
return;
end if;
-- Case of component size known at compile time. If the array
-- size is definitely in range, then we do not need a check.
if Known_Esize (Ctyp)
and then Siz * Esize (Ctyp) < Check_Siz
then
Uintp.Release (Umark);
return;
end if;
-- Here if a dynamic check is required
-- What we do is to build an expression for the size of the array,
-- which is computed as the 'Size of the array component, times
-- the size of each dimension.
Uintp.Release (Umark);
Sizx :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ctyp, Loc),
Attribute_Name => Name_Size);
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 :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ctyp, Loc),
Attribute_Name => Name_Size);
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;
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 :=
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
-- Emit the check
Code :=
Make_Raise_Storage_Error (Loc,
@ -990,7 +963,7 @@ package body Checks is
Right_Opnd =>
Make_Integer_Literal (Loc,
Intval => Check_Siz)),
Reason => SE_Object_Too_Large);
Reason => SE_Object_Too_Large);
Set_Size_Check_Code (Defining_Identifier (N), Code);
Insert_Action (N, Code, Suppress => All_Checks);