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

1 files changed, 95 insertions, 122 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 1f66e3c..5255e21 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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
+         if Raises_Constraint_Error (Lo)
+           or else
+             Raises_Constraint_Error (Hi)
+         then
+            Uintp.Release (Umark);
             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)
+         --  Otherwise get bounds values
 
-      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;
+         if Is_Static_Expression (Lo) then
+            Lob := Expr_Value (Lo);
+         else
+            Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
+            Static := False;
+         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
-               Lob := Expr_Value (Lo);
-            else
-               Lob := Expr_Value (Type_Low_Bound (Base_Type (Xtyp)));
-               Static := False;
-            end if;
+         Siz := Siz *  UI_Max (Hib - Lob + 1, Uint_0);
+         Next_Index (Indx);
+      end loop;
 
-            if Is_Static_Expression (Hi) then
-               Hib := Expr_Value (Hi);
-            else
-               Hib := Expr_Value (Type_High_Bound (Base_Type (Xtyp)));
-               Static := False;
-            end if;
+      --  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.
 
-            Siz := Siz *  UI_Max (Hib - Lob + 1, Uint_0);
-            Next_Index (Indx);
-         end loop;
+      if Is_Subprogram (Scope (Ent)) then
+         Check_Siz := Uint_2 ** 27;
+      else
+         Check_Siz := Uint_2 ** 31;
+      end if;
 
-         --  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 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 Is_Subprogram (Scope (Ent)) then
-            Check_Siz := Uint_2 ** 27;
-         else
-            Check_Siz := Uint_2 ** 31;
-         end if;
+      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;
 
-         --  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
+      --  Case of component size known at compile time. If the array
+      --  size is definitely in range, then we do not need a check.
 
-         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;
+      if Known_Esize (Ctyp)
+        and then Siz * Esize (Ctyp) < Check_Siz
+      then
+         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.
+      --  Here if a dynamic check is required
 
-         if Known_Esize (Ctyp)
-           and then Siz * Esize (Ctyp) < Check_Siz
-         then
-            Uintp.Release (Umark);
-            return;
-         end if;
+      --  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.
 
-         --  Here if a dynamic check is required
+      Uintp.Release (Umark);
 
-         --  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.
+      Sizx :=
+        Make_Attribute_Reference (Loc,
+          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 :=
-           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;
+           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;
 
-            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);