ada: Simplify [Small_]Integer_Type_For

Make Small_Integer_Type_For call Integer_Type_For,
so they share most of the code.

Remove Standard_Long_Integer from consideration,
because that's different on different machines (32- or 64-bit).
Standard_Integer or Standard_Long_Long_Integer will be
chosen.

gcc/ada/

	* exp_util.adb (Integer_Type_For): Assertion and comment.
	(Small_Integer_Type_For): Remove some code and call
	Integer_Type_For instead.
	* sem_util.ads (Rep_To_Pos_Flag): Improve comments. "Standard_..."
	seems overly pedantic here.
	* exp_attr.adb (Succ, Pred): Clean up: make the code as similar as
	possible.
	* exp_ch4.adb: Minor: named notation.

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b7554e05f7785c1a845b2f7cb766fcd0a05b53bc..50cb307a152b5d21df7277a4bad2b4f00adb4c82 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5638,9 +5638,7 @@ package body Exp_Attr is
                          Make_Integer_Literal (Loc, 1))));
 
             else
-               --  Add Boolean parameter True, to request program error if
-               --  we have a bad representation on our hands. If checks are
-               --  suppressed, then add False instead
+               --  Add Boolean parameter depending on check suppression
 
                Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
                Rewrite (N,
@@ -5650,13 +5648,13 @@ package body Exp_Attr is
                        (Enum_Pos_To_Rep (Etyp), Loc),
                    Expressions => New_List (
                      Make_Op_Subtract (Loc,
-                    Left_Opnd =>
-                      Make_Function_Call (Loc,
-                        Name =>
-                          New_Occurrence_Of
-                            (TSS (Etyp, TSS_Rep_To_Pos), Loc),
-                          Parameter_Associations => Exprs),
-                    Right_Opnd => Make_Integer_Literal (Loc, 1)))));
+                       Left_Opnd =>
+                         Make_Function_Call (Loc,
+                           Name =>
+                             New_Occurrence_Of
+                               (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+                           Parameter_Associations => Exprs),
+                       Right_Opnd => Make_Integer_Literal (Loc, 1)))));
             end if;
 
             --  Suppress checks since they have all been done above
@@ -6771,9 +6769,7 @@ package body Exp_Attr is
                          Make_Integer_Literal (Loc, 1))));
 
             else
-               --  Add Boolean parameter True, to request program error if
-               --  we have a bad representation on our hands. Add False if
-               --  checks are suppressed.
+               --  Add Boolean parameter depending on check suppression
 
                Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
                Rewrite (N,
@@ -6797,7 +6793,8 @@ package body Exp_Attr is
             Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
 
          --  For floating-point, we transform 'Succ into a call to the Succ
-         --  floating-point attribute function in Fat_xxx (xxx is root type)
+         --  floating-point attribute function in Fat_xxx (xxx is root type).
+         --  Note that this function takes care of the overflow case.
 
          elsif Is_Floating_Point_Type (Ptyp) then
             Expand_Fpt_Attribute_R (N);

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a8980a63d465a3335d8aad9b6454093a811fec8a..148b160b792e5197808db726a2c81123f9b46b55 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11836,7 +11836,7 @@ package body Exp_Ch4 is
 
          if Is_Fixed_Point_Type (Etype (Expr)) then
             Ityp := Small_Integer_Type_For
-                      (Esize (Base_Type (Etype (Expr))), False);
+                      (Esize (Base_Type (Etype (Expr))), Uns => False);
 
             --  Generate a temporary with the integer type to facilitate in the
             --  C backend the code generation for the unchecked conversion.
@@ -12206,7 +12206,7 @@ package body Exp_Ch4 is
             declare
                Expr_Id : constant Entity_Id := Make_Temporary (Loc, 'T', Conv);
                Int_Typ : constant Entity_Id :=
-                           Small_Integer_Type_For (RM_Size (Btyp), False);
+                 Small_Integer_Type_For (RM_Size (Btyp), Uns => False);
 
             begin
                --  Generate a temporary with the integer value. Required in the

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 84b0c0e29412b0c1f3d5b78441b11e54f9beeff9..5ab0d3039ca9d195b20e8b9617ed8d6ab23cf6f4 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8122,6 +8122,10 @@ package body Exp_Util is
 
    function Integer_Type_For (S : Uint; Uns : Boolean) return Entity_Id is
    begin
+      pragma Assert
+        (Standard_Long_Integer_Size in
+         Standard_Integer_Size | Standard_Long_Long_Integer_Size);
+      --  So we don't need to check for Standard_Long_Integer_Size below
       pragma Assert (S <= System_Max_Integer_Size);
 
       --  This is the canonical 32-bit type
@@ -14023,7 +14027,8 @@ package body Exp_Util is
    function Small_Integer_Type_For (S : Uint; Uns : Boolean) return Entity_Id
    is
    begin
-      pragma Assert (S <= System_Max_Integer_Size);
+      --  The only difference between this and Integer_Type_For is that this
+      --  can return small (8- or 16-bit) types.
 
       if S <= Standard_Short_Short_Integer_Size then
          if Uns then
@@ -14039,36 +14044,8 @@ package body Exp_Util is
             return Standard_Short_Integer;
          end if;
 
-      elsif S <= Standard_Integer_Size then
-         if Uns then
-            return Standard_Unsigned;
-         else
-            return Standard_Integer;
-         end if;
-
-      elsif S <= Standard_Long_Integer_Size then
-         if Uns then
-            return Standard_Long_Unsigned;
-         else
-            return Standard_Long_Integer;
-         end if;
-
-      elsif S <= Standard_Long_Long_Integer_Size then
-         if Uns then
-            return Standard_Long_Long_Unsigned;
-         else
-            return Standard_Long_Long_Integer;
-         end if;
-
-      elsif S <= Standard_Long_Long_Long_Integer_Size then
-         if Uns then
-            return Standard_Long_Long_Long_Unsigned;
-         else
-            return Standard_Long_Long_Long_Integer;
-         end if;
-
       else
-         raise Program_Error;
+         return Integer_Type_For (S, Uns);
       end if;
    end Small_Integer_Type_For;
 

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b647e68ff7fa02a1de55ec5814df70e2d877430e..b61695ea72985a39d45c1c2eca054cde6cab0f3c 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2976,16 +2976,16 @@ package Sem_Util is
 
    function Rep_To_Pos_Flag (E : Entity_Id; Loc : Source_Ptr) return Node_Id;
    --  This is used to construct the second argument in a call to Rep_To_Pos
-   --  which is Standard_True if range checks are enabled (E is an entity to
-   --  which the Range_Checks_Suppressed test is applied), and Standard_False
-   --  if range checks are suppressed. Loc is the location for the node that
-   --  is returned (which is a New_Occurrence of the appropriate entity).
+   --  which is True if range checks are enabled (E is an entity to which the
+   --  Range_Checks_Suppressed test is applied), and False if range checks are
+   --  suppressed. Loc is the location for the node that is returned (which is
+   --  a New_Occurrence of the appropriate entity).
    --
-   --  Note: one might think that it would be fine to always use True and
-   --  to ignore the suppress in this case, but it is generally better to
-   --  believe a request to suppress exceptions if possible, and further
-   --  more there is at least one case in the generated code (the code for
-   --  array assignment in a loop) that depends on this suppression.
+   --  Note: one might think that it would be fine to always use True and to
+   --  ignore the suppress in this case, but there is at least one case in the
+   --  generated code (the code for array assignment in a loop) that depends on
+   --  this suppression. Anyway, it is generally better to believe a request to
+   --  suppress exceptions if possible.
 
    procedure Require_Entity (N : Node_Id);
    --  N is a node which should have an entity value if it is an entity name.