re PR ada/30740 (Improper semantics in gnat's compilation of certain expressions…

re PR ada/30740 (Improper semantics in gnat's compilation of certain expressions involving modular arithmetic)

2008-05-20  Robert Dewar  <dewar@adacore.com>

	PR ada/30740
	* einfo.ads, einfo.adb (Non_Binary_Modulus): Applies to all types and
	subtypes, always False for non-modular types.
	Shared_Var_Assign_Proc (node22) and Shared_Var_Read_Proc (node 15)
	entry nodes have been replaced by Shared_Var_Procs_Instance (node22)
	for Shared_Storage package.
	(Is_RACW_Stub_Type): New entity flag.

	* exp_ch4.adb
	(Expand_N_Op_Expon): Avoid incorrect optimization of a*(2**b) in the
	case where we have a modular type with a non-binary modules.
	Comments reformattings.

	* sem_intr.adb: Simplify code not that Non_Binary_Modulus applies to
	all types.

From-SVN: r135619

gcc/ada/einfo.adb

@@ -126,7 +126,6 @@ package body Einfo is
    --    Scale_Value                     Uint15
    --    Storage_Size_Variable           Node15
    --    String_Literal_Low_Bound        Node15
-   --    Shared_Var_Read_Proc            Node15
 
    --    Access_Disp_Table               Elist16
    --    Cloned_Subtype                  Node16
@@ -193,7 +192,7 @@ package body Einfo is
    --    Private_View                    Node22
    --    Protected_Formal                Node22
    --    Scope_Depth_Value               Uint22
-   --    Shared_Var_Assign_Proc          Node22
+   --    Shared_Var_Procs_Instance       Node22
 
    --    Associated_Final_Chain          Node23
    --    CR_Discriminant                 Node23
@@ -505,8 +504,8 @@ package body Einfo is
    --    Optimize_Alignment_Space        Flag241
    --    Optimize_Alignment_Time         Flag242
    --    Overlays_Constant               Flag243
+   --    Is_RACW_Stub_Type               Flag244
 
-   --    (unused)                        Flag244
    --    (unused)                        Flag245
    --    (unused)                        Flag246
    --    (unused)                        Flag247
@@ -1975,6 +1974,12 @@ package body Einfo is
       return Flag189 (Id);
    end Is_Pure_Unit_Access_Type;
 
+   function Is_RACW_Stub_Type (Id : E) return B is
+   begin
+      pragma Assert (Is_Type (Id));
+      return Flag244 (Id);
+   end Is_RACW_Stub_Type;
+
    function Is_Raised (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Exception);
@@ -2239,7 +2244,7 @@ package body Einfo is
 
    function Non_Binary_Modulus (Id : E) return B is
    begin
-      pragma Assert (Is_Modular_Integer_Type (Id));
+      pragma Assert (Is_Type (Id));
       return Flag58 (Base_Type (Id));
    end Non_Binary_Modulus;
 
@@ -2537,17 +2542,11 @@ package body Einfo is
       return List14 (Id);
    end Shadow_Entities;
 
-   function Shared_Var_Assign_Proc (Id : E) return E is
+   function Shared_Var_Procs_Instance (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
       return Node22 (Id);
-   end Shared_Var_Assign_Proc;
-
-   function Shared_Var_Read_Proc (Id : E) return E is
-   begin
-      pragma Assert (Ekind (Id) = E_Variable);
-      return Node15 (Id);
-   end Shared_Var_Read_Proc;
+   end Shared_Var_Procs_Instance;
 
    function Size_Check_Code (Id : E) return N is
    begin
@@ -4424,6 +4423,12 @@ package body Einfo is
       Set_Flag189 (Id, V);
    end Set_Is_Pure_Unit_Access_Type;
 
+   procedure Set_Is_RACW_Stub_Type (Id : E; V : B := True) is
+   begin
+      pragma Assert (Is_Type (Id));
+      Set_Flag244 (Id, V);
+   end Set_Is_RACW_Stub_Type;
+
    procedure Set_Is_Raised (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Exception);
@@ -4697,7 +4702,7 @@ package body Einfo is
 
    procedure Set_Non_Binary_Modulus (Id : E; V : B := True) is
    begin
-      pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
+      pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
       Set_Flag58 (Id, V);
    end Set_Non_Binary_Modulus;
 
@@ -5000,17 +5005,11 @@ package body Einfo is
       Set_List14 (Id, V);
    end Set_Shadow_Entities;
 
-   procedure Set_Shared_Var_Assign_Proc (Id : E; V : E) is
+   procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
    begin
       pragma Assert (Ekind (Id) = E_Variable);
       Set_Node22 (Id, V);
-   end Set_Shared_Var_Assign_Proc;
-
-   procedure Set_Shared_Var_Read_Proc (Id : E; V : E) is
-   begin
-      pragma Assert (Ekind (Id) = E_Variable);
-      Set_Node15 (Id, V);
-   end Set_Shared_Var_Read_Proc;
+   end Set_Shared_Var_Procs_Instance;
 
    procedure Set_Size_Check_Code (Id : E; V : N) is
    begin
@@ -7621,6 +7620,7 @@ package body Einfo is
       W ("Is_Public",                       Flag10  (Id));
       W ("Is_Pure",                         Flag44  (Id));
       W ("Is_Pure_Unit_Access_Type",        Flag189 (Id));
+      W ("Is_RACW_Stub_Type",               Flag244 (Id));
       W ("Is_Raised",                       Flag224 (Id));
       W ("Is_Remote_Call_Interface",        Flag62  (Id));
       W ("Is_Remote_Types",                 Flag61  (Id));
@@ -8131,9 +8131,6 @@ package body Einfo is
          when E_String_Literal_Subtype                     =>
             Write_Str ("String_Literal_Low_Bound");
 
-         when E_Variable                                   =>
-            Write_Str ("Shared_Var_Read_Proc");
-
          when others                                       =>
             Write_Str ("Field15??");
       end case;
@@ -8506,7 +8503,7 @@ package body Einfo is
             Write_Str ("Private_View");
 
          when E_Variable                                   =>
-            Write_Str ("Shared_Var_Assign_Proc");
+            Write_Str ("Shared_Var_Procs_Instance");
 
          when others                                       =>
             Write_Str ("Field22??");

gcc/ada/einfo.ads

@@ -2581,6 +2581,10 @@ package Einfo is
 --       subtype appears in a pure unit. Used to give an error message at
 --       freeze time if the access type has a storage pool.
 
+--    Is_RACW_Stub_Type (Flag244)
+--       Present in all types, true for the stub types generated for remote
+--       access-to-class-wide types.
+
 --    Is_Raised (Flag224)
 --       Present in exception entities. Set if the entity is referenced by a
 --       a raise statement.
@@ -2595,12 +2599,12 @@ package Einfo is
 --    Is_Remote_Call_Interface (Flag62)
 --       Present in all entities. Set in E_Package and E_Generic_Package
 --       entities to which a pragma Remote_Call_Interace is applied, and
---       also in all entities within such packages.
+--       also on entities declared in the visible part of such a package.
 
 --    Is_Remote_Types (Flag61)
 --       Present in all entities. Set in E_Package and E_Generic_Package
---       entities to which a pragma Remote_Types is applied, and also in
---       all entities within such packages.
+--       entities to which a pragma Remote_Types is applied, and also on
+--       entities declared in the visible part of the spec of such a package.
 
 --    Is_Renaming_Of_Object (Flag112)
 --       Present in all entities, set only for a variable or constant for
@@ -3044,8 +3048,8 @@ package Einfo is
 --       of a record, returns the next _Tag field in this record.
 
 --    Non_Binary_Modulus (Flag58) [base type only]
---       Present in modular integer types. Set if the modulus for the type
---       is other than a power of 2.
+--       Present in all subtype and type entities. Set for modular integer
+--       types if the modulus value is other than a power of 2.
 
 --    Non_Limited_View (Node17)
 --       Present in incomplete types that are the shadow entities created
@@ -3479,15 +3483,10 @@ package Einfo is
 --       standard format list (i.e. First (Shadow_Entities) is the first
 --       entry and subsequent entries are obtained using Next.
 
---    Shared_Var_Assign_Proc (Node22)
---       Present in variables. Set non-Empty only if Is_Shared_Passive is
---       set, in which case this is the entity for the shared memory assign
---       routine. See Exp_Smem for full details.
-
---    Shared_Var_Read_Proc (Node15)
+--    Shared_Var_Procs_Instance (Node22)
 --       Present in variables. Set non-Empty only if Is_Shared_Passive is
---       set, in which case this is the entity for the shared memory read
---       routine. See Exp_Smem for full details.
+--       set, in which case this is the entity for the associated instance of
+--       System.Shared_Storage.Shared_Var_Procs. See Exp_Smem for full details.
 
 --    Size_Check_Code (Node19)
 --       Present in constants and variables. Normally Empty. Set if code is
@@ -4698,6 +4697,7 @@ package Einfo is
    --    Is_Generic_Actual_Type              (Flag94)
    --    Is_Generic_Type                     (Flag13)
    --    Is_Protected_Interface              (Flag198)
+   --    Is_RACW_Stub_Type                   (Flag244)
    --    Is_Synchronized_Interface           (Flag199)
    --    Is_Task_Interface                   (Flag200)
    --    Is_Non_Static_Subtype               (Flag109)
@@ -5490,14 +5490,13 @@ package Einfo is
    --    Esize                               (Uint12)
    --    Extra_Accessibility                 (Node13)
    --    Alignment                           (Uint14)
-   --    Shared_Var_Read_Proc                (Node15)
    --    Unset_Reference                     (Node16)
    --    Actual_Subtype                      (Node17)
    --    Renamed_Object                      (Node18)
    --    Size_Check_Code                     (Node19)
    --    Prival_Link                         (Node20)
    --    Interface_Name                      (Node21)
-   --    Shared_Var_Assign_Proc              (Node22)
+   --    Shared_Var_Procs_Instance           (Node22)
    --    Extra_Constrained                   (Node23)
    --    Debug_Renaming_Link                 (Node25)
    --    Last_Assignment                     (Node26)
@@ -5990,6 +5989,7 @@ package Einfo is
    function Is_Public                           (Id : E) return B;
    function Is_Pure                             (Id : E) return B;
    function Is_Pure_Unit_Access_Type            (Id : E) return B;
+   function Is_RACW_Stub_Type                   (Id : E) return B;
    function Is_Raised                           (Id : E) return B;
    function Is_Remote_Call_Interface            (Id : E) return B;
    function Is_Remote_Types                     (Id : E) return B;
@@ -6085,8 +6085,7 @@ package Einfo is
    function Scope_Depth_Value                   (Id : E) return U;
    function Sec_Stack_Needed_For_Return         (Id : E) return B;
    function Shadow_Entities                     (Id : E) return S;
-   function Shared_Var_Assign_Proc              (Id : E) return E;
-   function Shared_Var_Read_Proc                (Id : E) return E;
+   function Shared_Var_Procs_Instance           (Id : E) return E;
    function Size_Check_Code                     (Id : E) return N;
    function Size_Known_At_Compile_Time          (Id : E) return B;
    function Size_Depends_On_Discriminant        (Id : E) return B;
@@ -6555,6 +6554,7 @@ package Einfo is
    procedure Set_Is_Public                       (Id : E; V : B := True);
    procedure Set_Is_Pure                         (Id : E; V : B := True);
    procedure Set_Is_Pure_Unit_Access_Type        (Id : E; V : B := True);
+   procedure Set_Is_RACW_Stub_Type               (Id : E; V : B := True);
    procedure Set_Is_Raised                       (Id : E; V : B := True);
    procedure Set_Is_Remote_Call_Interface        (Id : E; V : B := True);
    procedure Set_Is_Remote_Types                 (Id : E; V : B := True);
@@ -6650,8 +6650,7 @@ package Einfo is
    procedure Set_Scope_Depth_Value               (Id : E; V : U);
    procedure Set_Sec_Stack_Needed_For_Return     (Id : E; V : B := True);
    procedure Set_Shadow_Entities                 (Id : E; V : S);
-   procedure Set_Shared_Var_Assign_Proc          (Id : E; V : E);
-   procedure Set_Shared_Var_Read_Proc            (Id : E; V : E);
+   procedure Set_Shared_Var_Procs_Instance       (Id : E; V : E);
    procedure Set_Size_Check_Code                 (Id : E; V : N);
    procedure Set_Size_Depends_On_Discriminant    (Id : E; V : B := True);
    procedure Set_Size_Known_At_Compile_Time      (Id : E; V : B := True);
@@ -7236,6 +7235,7 @@ package Einfo is
    pragma Inline (Is_Public);
    pragma Inline (Is_Pure);
    pragma Inline (Is_Pure_Unit_Access_Type);
+   pragma Inline (Is_RACW_Stub_Type);
    pragma Inline (Is_Raised);
    pragma Inline (Is_Real_Type);
    pragma Inline (Is_Record_Type);
@@ -7340,8 +7340,7 @@ package Einfo is
    pragma Inline (Scope_Depth_Value);
    pragma Inline (Sec_Stack_Needed_For_Return);
    pragma Inline (Shadow_Entities);
-   pragma Inline (Shared_Var_Assign_Proc);
-   pragma Inline (Shared_Var_Read_Proc);
+   pragma Inline (Shared_Var_Procs_Instance);
    pragma Inline (Size_Check_Code);
    pragma Inline (Size_Depends_On_Discriminant);
    pragma Inline (Size_Known_At_Compile_Time);
@@ -7628,6 +7627,7 @@ package Einfo is
    pragma Inline (Set_Is_Public);
    pragma Inline (Set_Is_Pure);
    pragma Inline (Set_Is_Pure_Unit_Access_Type);
+   pragma Inline (Set_Is_RACW_Stub_Type);
    pragma Inline (Set_Is_Raised);
    pragma Inline (Set_Is_Remote_Call_Interface);
    pragma Inline (Set_Is_Remote_Types);
@@ -7722,8 +7722,7 @@ package Einfo is
    pragma Inline (Set_Scope_Depth_Value);
    pragma Inline (Set_Sec_Stack_Needed_For_Return);
    pragma Inline (Set_Shadow_Entities);
-   pragma Inline (Set_Shared_Var_Assign_Proc);
-   pragma Inline (Set_Shared_Var_Read_Proc);
+   pragma Inline (Set_Shared_Var_Procs_Instance);
    pragma Inline (Set_Size_Check_Code);
    pragma Inline (Set_Size_Depends_On_Discriminant);
    pragma Inline (Set_Size_Known_At_Compile_Time);

gcc/ada/exp_ch4.adb

@@ -110,20 +110,19 @@ package body Exp_Ch4 is
       Bodies : List_Id;
       Typ    : Entity_Id) return Node_Id;
    --  Expand an array equality into a call to a function implementing this
-   --  equality, and a call to it. Loc is the location for the generated
-   --  nodes. Lhs and Rhs are the array expressions to be compared.
-   --  Bodies is a list on which to attach bodies of local functions that
-   --  are created in the process. It is the responsibility of the
-   --  caller to insert those bodies at the right place. Nod provides
-   --  the Sloc value for the generated code. Normally the types used
-   --  for the generated equality routine are taken from Lhs and Rhs.
-   --  However, in some situations of generated code, the Etype fields
-   --  of Lhs and Rhs are not set yet. In such cases, Typ supplies the
-   --  type to be used for the formal parameters.
+   --  equality, and a call to it. Loc is the location for the generated nodes.
+   --  Lhs and Rhs are the array expressions to be compared. Bodies is a list
+   --  on which to attach bodies of local functions that are created in the
+   --  process. It is the responsibility of the caller to insert those bodies
+   --  at the right place. Nod provides the Sloc value for the generated code.
+   --  Normally the types used for the generated equality routine are taken
+   --  from Lhs and Rhs. However, in some situations of generated code, the
+   --  Etype fields of Lhs and Rhs are not set yet. In such cases, Typ supplies
+   --  the type to be used for the formal parameters.
 
    procedure Expand_Boolean_Operator (N : Node_Id);
-   --  Common expansion processing for Boolean operators (And, Or, Xor)
-   --  for the case of array type arguments.
+   --  Common expansion processing for Boolean operators (And, Or, Xor) for the
+   --  case of array type arguments.
 
    function Expand_Composite_Equality
      (Nod    : Node_Id;
@@ -131,19 +130,19 @@ package body Exp_Ch4 is
       Lhs    : Node_Id;
       Rhs    : Node_Id;
       Bodies : List_Id) return Node_Id;
-   --  Local recursive function used to expand equality for nested
-   --  composite types. Used by Expand_Record/Array_Equality, Bodies
-   --  is a list on which to attach bodies of local functions that are
-   --  created in the process. This is the responsibility of the caller
-   --  to insert those bodies at the right place. Nod provides the Sloc
-   --  value for generated code. Lhs and Rhs are the left and right sides
-   --  for the comparison, and Typ is the type of the arrays to compare.
+   --  Local recursive function used to expand equality for nested composite
+   --  types. Used by Expand_Record/Array_Equality, Bodies is a list on which
+   --  to attach bodies of local functions that are created in the process.
+   --  This is the responsibility of the caller to insert those bodies at the
+   --  right place. Nod provides the Sloc value for generated code. Lhs and Rhs
+   --  are the left and right sides for the comparison, and Typ is the type of
+   --  the arrays to compare.
 
    procedure Expand_Concatenate_Other (Cnode : Node_Id; Opnds : List_Id);
-   --  This routine handles expansion of concatenation operations, where
-   --  N is the N_Op_Concat node being expanded and Operands is the list
-   --  of operands (at least two are present). The caller has dealt with
-   --  converting any singleton operands into singleton aggregates.
+   --  This routine handles expansion of concatenation operations, where N is
+   --  the N_Op_Concat node being expanded and Operands is the list of operands
+   --  (at least two are present). The caller has dealt with converting any
+   --  singleton operands into singleton aggregates.
 
    procedure Expand_Concatenate_String (Cnode : Node_Id; Opnds : List_Id);
    --  Routine to expand concatenation of 2-5 operands (in the list Operands)
@@ -153,18 +152,18 @@ package body Exp_Ch4 is
    --  already converted character operands to strings in this case).
 
    procedure Fixup_Universal_Fixed_Operation (N : Node_Id);
-   --  N is either an N_Op_Divide or N_Op_Multiply node whose result is
-   --  universal fixed. We do not have such a type at runtime, so the
-   --  purpose of this routine is to find the real type by looking up
-   --  the tree. We also determine if the operation must be rounded.
+   --  N is a N_Op_Divide or N_Op_Multiply node whose result is universal
+   --  fixed. We do not have such a type at runtime, so the purpose of this
+   --  routine is to find the real type by looking up the tree. We also
+   --  determine if the operation must be rounded.
 
    function Get_Allocator_Final_List
      (N    : Node_Id;
       T    : Entity_Id;
       PtrT : Entity_Id) return Entity_Id;
-   --  If the designated type is controlled, build final_list expression
-   --  for created object. If context is an access parameter, create a
-   --  local access type to have a usable finalization list.
+   --  If the designated type is controlled, build final_list expression for
+   --  created object. If context is an access parameter, create a local access
+   --  type to have a usable finalization list.
 
    function Has_Inferable_Discriminants (N : Node_Id) return Boolean;
    --  Ada 2005 (AI-216): A view of an Unchecked_Union object has inferable
@@ -185,22 +184,22 @@ package body Exp_Ch4 is
    function Make_Array_Comparison_Op
      (Typ : Entity_Id;
       Nod : Node_Id) return Node_Id;
-   --  Comparisons between arrays are expanded in line. This function
-   --  produces the body of the implementation of (a > b), where a and b
-   --  are one-dimensional arrays of some discrete type. The original
-   --  node is then expanded into the appropriate call to this function.
-   --  Nod provides the Sloc value for the generated code.
+   --  Comparisons between arrays are expanded in line. This function produces
+   --  the body of the implementation of (a > b), where a and b are one-
+   --  dimensional arrays of some discrete type. The original node is then
+   --  expanded into the appropriate call to this function. Nod provides the
+   --  Sloc value for the generated code.
 
    function Make_Boolean_Array_Op
      (Typ : Entity_Id;
       N   : Node_Id) return Node_Id;
-   --  Boolean operations on boolean arrays are expanded in line. This
-   --  function produce the body for the node N, which is (a and b),
-   --  (a or b), or (a xor b). It is used only the normal case and not
-   --  the packed case. The type involved, Typ, is the Boolean array type,
-   --  and the logical operations in the body are simple boolean operations.
-   --  Note that Typ is always a constrained type (the caller has ensured
-   --  this by using Convert_To_Actual_Subtype if necessary).
+   --  Boolean operations on boolean arrays are expanded in line. This function
+   --  produce the body for the node N, which is (a and b), (a or b), or (a xor
+   --  b). It is used only the normal case and not the packed case. The type
+   --  involved, Typ, is the Boolean array type, and the logical operations in
+   --  the body are simple boolean operations. Note that Typ is always a
+   --  constrained type (the caller has ensured this by using
+   --  Convert_To_Actual_Subtype if necessary).
 
    procedure Rewrite_Comparison (N : Node_Id);
    --  If N is the node for a comparison whose outcome can be determined at
@@ -218,9 +217,8 @@ package body Exp_Ch4 is
      (Lhs : Node_Id;
       Op1 : Node_Id;
       Op2 : Node_Id) return Boolean;
-   --  In the context of an assignment, where the right-hand side is a
-   --  boolean operation on arrays, check whether operation can be performed
-   --  in place.
+   --  In the context of an assignment, where the right-hand side is a boolean
+   --  operation on arrays, check whether operation can be performed in place.
 
    procedure Unary_Op_Validity_Checks (N : Node_Id);
    pragma Inline (Unary_Op_Validity_Checks);
@@ -478,28 +476,30 @@ package body Exp_Ch4 is
         (Ref            : Node_Id;
          Built_In_Place : Boolean := False);
       --  Ada 2005 (AI-344): For an allocator with a class-wide designated
-      --  type, generate an accessibility check to verify that the level of
-      --  the type of the created object is not deeper than the level of the
-      --  access type. If the type of the qualified expression is class-
-      --  wide, then always generate the check (except in the case where it
-      --  is known to be unnecessary, see comment below). Otherwise, only
-      --  generate the check if the level of the qualified expression type
-      --  is statically deeper than the access type. Although the static
-      --  accessibility will generally have been performed as a legality
-      --  check, it won't have been done in cases where the allocator
-      --  appears in generic body, so a run-time check is needed in general.
-      --  One special case is when the access type is declared in the same
-      --  scope as the class-wide allocator, in which case the check can
-      --  never fail, so it need not be generated. As an open issue, there
-      --  seem to be cases where the static level associated with the
-      --  class-wide object's underlying type is not sufficient to perform
-      --  the proper accessibility check, such as for allocators in nested
-      --  subprograms or accept statements initialized by class-wide formals
-      --  when the actual originates outside at a deeper static level. The
-      --  nested subprogram case might require passing accessibility levels
-      --  along with class-wide parameters, and the task case seems to be
-      --  an actual gap in the language rules that needs to be fixed by the
-      --  ARG. ???
+      --  type, generate an accessibility check to verify that the level of the
+      --  type of the created object is not deeper than the level of the access
+      --  type. If the type of the qualified expression is class- wide, then
+      --  always generate the check (except in the case where it is known to be
+      --  unnecessary, see comment below). Otherwise, only generate the check
+      --  if the level of the qualified expression type is statically deeper
+      --  than the access type.
+      --
+      --  Although the static accessibility will generally have been performed
+      --  as a legality check, it won't have been done in cases where the
+      --  allocator appears in generic body, so a run-time check is needed in
+      --  general. One special case is when the access type is declared in the
+      --  same scope as the class-wide allocator, in which case the check can
+      --  never fail, so it need not be generated.
+      --
+      --  As an open issue, there seem to be cases where the static level
+      --  associated with the class-wide object's underlying type is not
+      --  sufficient to perform the proper accessibility check, such as for
+      --  allocators in nested subprograms or accept statements initialized by
+      --  class-wide formals when the actual originates outside at a deeper
+      --  static level. The nested subprogram case might require passing
+      --  accessibility levels along with class-wide parameters, and the task
+      --  case seems to be an actual gap in the language rules that needs to
+      --  be fixed by the ARG. ???
 
       -------------------------------
       -- Apply_Accessibility_Check --
@@ -577,12 +577,12 @@ package body Exp_Ch4 is
    begin
       if Is_Tagged_Type (T) or else Controlled_Type (T) then
 
-         --  Ada 2005 (AI-318-02): If the initialization expression is a
-         --  call to a build-in-place function, then access to the allocated
-         --  object must be passed to the function. Currently we limit such
-         --  functions to those with constrained limited result subtypes,
-         --  but eventually we plan to expand the allowed forms of functions
-         --  that are treated as build-in-place.
+         --  Ada 2005 (AI-318-02): If the initialization expression is a call
+         --  to a build-in-place function, then access to the allocated object
+         --  must be passed to the function. Currently we limit such functions
+         --  to those with constrained limited result subtypes, but eventually
+         --  we plan to expand the allowed forms of functions that are treated
+         --  as build-in-place.
 
          if Ada_Version >= Ada_05
            and then Is_Build_In_Place_Function_Call (Exp)
@@ -762,11 +762,10 @@ package body Exp_Ch4 is
 
                --  Generate an additional object containing the address of the
                --  returned object. The type of this second object declaration
-               --  is the correct type required for the common processing
-               --  that is still performed by this subprogram. The displacement
-               --  of this pointer to reference the component associated with
-               --  the interface type will be done at the end of the common
-               --  processing.
+               --  is the correct type required for the common processing that
+               --  is still performed by this subprogram. The displacement of
+               --  this pointer to reference the component associated with the
+               --  interface type will be done at the end of common processing.
 
                New_Decl :=
                  Make_Object_Declaration (Loc,
@@ -845,10 +844,10 @@ package body Exp_Ch4 is
                           Associated_Storage_Pool (PtrT);
 
             begin
-               --  If it is an allocation on the secondary stack
-               --  (i.e. a value returned from a function), the object
-               --  is attached on the caller side as soon as the call
-               --  is completed (see Expand_Ctrl_Function_Call)
+               --  If it is an allocation on the secondary stack (i.e. a value
+               --  returned from a function), the object is attached on the
+               --  caller side as soon as the call is completed (see
+               --  Expand_Ctrl_Function_Call)
 
                if Is_RTE (Apool, RE_SS_Pool) then
                   declare
@@ -899,10 +898,9 @@ package body Exp_Ch4 is
                     Make_Adjust_Call (
                       Ref          =>
 
-                     --  An unchecked conversion is needed in the
-                     --  classwide case because the designated type
-                     --  can be an ancestor of the subtype mark of
-                     --  the allocator.
+                     --  An unchecked conversion is needed in the classwide
+                     --  case because the designated type can be an ancestor of
+                     --  the subtype mark of the allocator.
 
                       Unchecked_Convert_To (T,
                         Make_Explicit_Dereference (Loc,
@@ -919,9 +917,9 @@ package body Exp_Ch4 is
          Rewrite (N, New_Reference_To (Temp, Loc));
          Analyze_And_Resolve (N, PtrT);
 
-         --  Ada 2005 (AI-251): Displace the pointer to reference the
-         --  record component containing the secondary dispatch table
-         --  of the interface type.
+         --  Ada 2005 (AI-251): Displace the pointer to reference the record
+         --  component containing the secondary dispatch table of the interface
+         --  type.
 
          if Is_Interface (Directly_Designated_Type (PtrT)) then
             Displace_Allocator_Pointer (N);
@@ -965,20 +963,18 @@ package body Exp_Ch4 is
       else
          --  First check against the type of the qualified expression
          --
-         --  NOTE: The commented call should be correct, but for
-         --  some reason causes the compiler to bomb (sigsegv) on
-         --  ACVC test c34007g, so for now we just perform the old
-         --  (incorrect) test against the designated subtype with
-         --  no sliding in the else part of the if statement below.
-         --  ???
+         --  NOTE: The commented call should be correct, but for some reason
+         --  causes the compiler to bomb (sigsegv) on ACVC test c34007g, so for
+         --  now we just perform the old (incorrect) test against the
+         --  designated subtype with no sliding in the else part of the if
+         --  statement below. ???
          --
          --  Apply_Constraint_Check (Exp, T, No_Sliding => True);
 
-         --  A check is also needed in cases where the designated
-         --  subtype is constrained and differs from the subtype
-         --  given in the qualified expression. Note that the check
-         --  on the qualified expression does not allow sliding,
-         --  but this check does (a relaxation from Ada 83).
+         --  A check is also needed in cases where the designated subtype is
+         --  constrained and differs from the subtype given in the qualified
+         --  expression. Note that the check on the qualified expression does
+         --  not allow sliding, but this check does (a relaxation from Ada 83).
 
          if Is_Constrained (DesigT)
            and then not Subtypes_Statically_Match
@@ -987,19 +983,18 @@ package body Exp_Ch4 is
             Apply_Constraint_Check
               (Exp, DesigT, No_Sliding => False);
 
-         --  The nonsliding check should really be performed
-         --  (unconditionally) against the subtype of the
-         --  qualified expression, but that causes a problem
-         --  with c34007g (see above), so for now we retain this.
+         --  The nonsliding check should really be performed (unconditionally)
+         --  against the subtype of the qualified expression, but that causes a
+         --  problem with c34007g (see above), so for now we retain this.
 
          else
             Apply_Constraint_Check
               (Exp, DesigT, No_Sliding => True);
          end if;
 
-         --  For an access to unconstrained packed array, GIGI needs
-         --  to see an expression with a constrained subtype in order
-         --  to compute the proper size for the allocator.
+         --  For an access to unconstrained packed array, GIGI needs to see an
+         --  expression with a constrained subtype in order to compute the
+         --  proper size for the allocator.
 
          if Is_Array_Type (T)
            and then not Is_Constrained (T)
@@ -1021,12 +1016,12 @@ package body Exp_Ch4 is
             end;
          end if;
 
-         --  Ada 2005 (AI-318-02): If the initialization expression is a
-         --  call to a build-in-place function, then access to the allocated
-         --  object must be passed to the function. Currently we limit such
-         --  functions to those with constrained limited result subtypes,
-         --  but eventually we plan to expand the allowed forms of functions
-         --  that are treated as build-in-place.
+         --  Ada 2005 (AI-318-02): If the initialization expression is a call
+         --  to a build-in-place function, then access to the allocated object
+         --  must be passed to the function. Currently we limit such functions
+         --  to those with constrained limited result subtypes, but eventually
+         --  we plan to expand the allowed forms of functions that are treated
+         --  as build-in-place.
 
          if Ada_Version >= Ada_05
            and then Is_Build_In_Place_Function_Call (Exp)
@@ -1044,10 +1039,10 @@ package body Exp_Ch4 is
    -- Expand_Array_Comparison --
    -----------------------------
 
-   --  Expansion is only required in the case of array types. For the
-   --  unpacked case, an appropriate runtime routine is called. For
-   --  packed cases, and also in some other cases where a runtime
-   --  routine cannot be called, the form of the expansion is:
+   --  Expansion is only required in the case of array types. For the unpacked
+   --  case, an appropriate runtime routine is called. For packed cases, and
+   --  also in some other cases where a runtime routine cannot be called, the
+   --  form of the expansion is:
 
    --     [body for greater_nn; boolean_expression]
 
@@ -1071,9 +1066,9 @@ package body Exp_Ch4 is
       --  True for byte addressable target
 
       function Length_Less_Than_4 (Opnd : Node_Id) return Boolean;
-      --  Returns True if the length of the given operand is known to be
-      --  less than 4. Returns False if this length is known to be four
-      --  or greater or is not known at compile time.
+      --  Returns True if the length of the given operand is known to be less
+      --  than 4. Returns False if this length is known to be four or greater
+      --  or is not known at compile time.
 
       ------------------------
       -- Length_Less_Than_4 --
@@ -1272,8 +1267,8 @@ package body Exp_Ch4 is
    -- Expand_Array_Equality --
    ---------------------------
 
-   --  Expand an equality function for multi-dimensional arrays. Here is
-   --  an example of such a function for Nb_Dimension = 2
+   --  Expand an equality function for multi-dimensional arrays. Here is an
+   --  example of such a function for Nb_Dimension = 2
 
    --  function Enn (A : atyp; B : btyp) return boolean is
    --  begin
@@ -1320,15 +1315,15 @@ package body Exp_Ch4 is
    --     return true;
    --  end Enn;
 
-   --  Note on the formal types used (atyp and btyp). If either of the
-   --  arrays is of a private type, we use the underlying type, and
-   --  do an unchecked conversion of the actual. If either of the arrays
-   --  has a bound depending on a discriminant, then we use the base type
-   --  since otherwise we have an escaped discriminant in the function.
+   --  Note on the formal types used (atyp and btyp). If either of the arrays
+   --  is of a private type, we use the underlying type, and do an unchecked
+   --  conversion of the actual. If either of the arrays has a bound depending
+   --  on a discriminant, then we use the base type since otherwise we have an
+   --  escaped discriminant in the function.
 
-   --  If both arrays are constrained and have the same bounds, we can
-   --  generate a loop with an explicit iteration scheme using a 'Range
-   --  attribute over the first array.
+   --  If both arrays are constrained and have the same bounds, we can generate
+   --  a loop with an explicit iteration scheme using a 'Range attribute over
+   --  the first array.
 
    function Expand_Array_Equality
      (Nod    : Node_Id;
@@ -1361,12 +1356,12 @@ package body Exp_Ch4 is
       --  This builds the attribute reference Arr'Nam (Expr)
 
       function Component_Equality (Typ : Entity_Id) return Node_Id;
-      --  Create one statement to compare corresponding components,
-      --  designated by a full set of indices.
+      --  Create one statement to compare corresponding components, designated
+      --  by a full set of indices.
 
       function Get_Arg_Type (N : Node_Id) return Entity_Id;
-      --  Given one of the arguments, computes the appropriate type to
-      --  be used for that argument in the corresponding function formal
+      --  Given one of the arguments, computes the appropriate type to be used
+      --  for that argument in the corresponding function formal
 
       function Handle_One_Dimension
         (N     : Int;
@@ -1392,13 +1387,13 @@ package body Exp_Ch4 is
       --      end loop
       --
       --  N is the dimension for which we are generating a loop. Index is the
-      --  N'th index node, whose Etype is Index_Type_n in the above code.
-      --  The xxx statement is either the loop or declare for the next
-      --  dimension or if this is the last dimension the comparison
-      --  of corresponding components of the arrays.
+      --  N'th index node, whose Etype is Index_Type_n in the above code. The
+      --  xxx statement is either the loop or declare for the next dimension
+      --  or if this is the last dimension the comparison of corresponding
+      --  components of the arrays.
       --
-      --  The actual way the code works is to return the comparison
-      --  of corresponding components for the N+1 call. That's neater!
+      --  The actual way the code works is to return the comparison of
+      --  corresponding components for the N+1 call. That's neater!
 
       function Test_Empty_Arrays return Node_Id;
       --  This function constructs the test for both arrays being empty
@@ -1407,8 +1402,8 @@ package body Exp_Ch4 is
       --    (B'length (1) = 0 or else B'length (2) = 0 or else ...)
 
       function Test_Lengths_Correspond return Node_Id;
-      --  This function constructs the test for arrays having different
-      --  lengths in at least one index position, in which case resull
+      --  This function constructs the test for arrays having different lengths
+      --  in at least one index position, in which case the resulting code is:
 
       --     A'length (1) /= B'length (1)
       --       or else
@@ -1463,8 +1458,8 @@ package body Exp_Ch4 is
          if Nkind (Test) = N_Raise_Program_Error then
 
             --  This node is going to be inserted at a location where a
-            --  statement is expected: clear its Etype so analysis will
-            --  set it to the expected Standard_Void_Type.
+            --  statement is expected: clear its Etype so analysis will set
+            --  it to the expected Standard_Void_Type.
 
             Set_Etype (Test, Empty);
             return Test;
@@ -1525,8 +1520,8 @@ package body Exp_Ch4 is
                                    Ltyp /= Rtyp
                                      or else not Is_Constrained (Ltyp);
          --  If the index types are identical, and we are working with
-         --  constrained types, then we can use the same index for both of
-         --  the arrays.
+         --  constrained types, then we can use the same index for both
+         --  of the arrays.
 
          An : constant Entity_Id := Make_Defining_Identifier (Loc,
                                       Chars => New_Internal_Name ('A'));
@@ -1714,9 +1709,9 @@ package body Exp_Ch4 is
       Ltyp := Get_Arg_Type (Lhs);
       Rtyp := Get_Arg_Type (Rhs);
 
-      --  For now, if the argument types are not the same, go to the
-      --  base type, since the code assumes that the formals have the
-      --  same type. This is fixable in future ???
+      --  For now, if the argument types are not the same, go to the base type,
+      --  since the code assumes that the formals have the same type. This is
+      --  fixable in future ???
 
       if Ltyp /= Rtyp then
          Ltyp := Base_Type (Ltyp);
@@ -1775,9 +1770,9 @@ package body Exp_Ch4 is
          Set_Has_Completion (Func_Name, True);
          Set_Is_Inlined (Func_Name);
 
-         --  If the array type is distinct from the type of the arguments,
-         --  it is the full view of a private type. Apply an unchecked
-         --  conversion to insure that analysis of the call succeeds.
+         --  If the array type is distinct from the type of the arguments, it
+         --  is the full view of a private type. Apply an unchecked conversion
+         --  to insure that analysis of the call succeeds.
 
          declare
             L, R : Node_Id;
@@ -1813,16 +1808,16 @@ package body Exp_Ch4 is
    -- Expand_Boolean_Operator --
    -----------------------------
 
-   --  Note that we first get the actual subtypes of the operands,
-   --  since we always want to deal with types that have bounds.
+   --  Note that we first get the actual subtypes of the operands, since we
+   --  always want to deal with types that have bounds.
 
    procedure Expand_Boolean_Operator (N : Node_Id) is
       Typ : constant Entity_Id  := Etype (N);
 
    begin
-      --  Special case of bit packed array where both operands are known
-      --  to be properly aligned. In this case we use an efficient run time
-      --  routine to carry out the operation (see System.Bit_Ops).
+      --  Special case of bit packed array where both operands are known to be
+      --  properly aligned. In this case we use an efficient run time routine
+      --  to carry out the operation (see System.Bit_Ops).
 
       if Is_Bit_Packed_Array (Typ)
         and then not Is_Possibly_Unaligned_Object (Left_Opnd (N))
@@ -1916,8 +1911,8 @@ package body Exp_Ch4 is
          Full_Type := Typ;
       end if;
 
-      --  Defense against malformed private types with no completion
-      --  the error will be diagnosed later by check_completion
+      --  Defense against malformed private types with no completion the error
+      --  will be diagnosed later by check_completion
 
       if No (Full_Type) then
          return New_Reference_To (Standard_False, Loc);
@@ -1937,11 +1932,11 @@ package body Exp_Ch4 is
          then
             return Make_Op_Eq (Loc, Left_Opnd  => Lhs, Right_Opnd => Rhs);
 
-         --  For composite component types, and floating-point types, use
-         --  the expansion. This deals with tagged component types (where
-         --  we use the applicable equality routine) and floating-point,
-         --  (where we need to worry about negative zeroes), and also the
-         --  case of any composite type recursively containing such fields.
+         --  For composite component types, and floating-point types, use the
+         --  expansion. This deals with tagged component types (where we use
+         --  the applicable equality routine) and floating-point, (where we
+         --  need to worry about negative zeroes), and also the case of any
+         --  composite type recursively containing such fields.
 
          else
             return Expand_Array_Equality (Nod, Lhs, Rhs, Bodies, Full_Type);
@@ -1955,11 +1950,10 @@ package body Exp_Ch4 is
             Full_Type := Root_Type (Full_Type);
          end if;
 
-         --  If this is derived from an untagged private type completed
-         --  with a tagged type, it does not have a full view, so we
-         --  use the primitive operations of the private type.
-         --  This check should no longer be necessary when these
-         --  types receive their full views ???
+         --  If this is derived from an untagged private type completed with a
+         --  tagged type, it does not have a full view, so we use the primitive
+         --  operations of the private type. This check should no longer be
+         --  necessary when these types receive their full views ???
 
          if Is_Private_Type (Typ)
            and then not Is_Tagged_Type (Typ)
@@ -1998,8 +1992,8 @@ package body Exp_Ch4 is
          if Present (Eq_Op) then
             if Etype (First_Formal (Eq_Op)) /= Full_Type then
 
-               --  Inherited equality from parent type. Convert the actuals
-               --  to match signature of operation.
+               --  Inherited equality from parent type. Convert the actuals to
+               --  match signature of operation.
 
                declare
                   T : constant Entity_Id := Etype (First_Formal (Eq_Op));
@@ -2040,7 +2034,7 @@ package body Exp_Ch4 is
 
                      if Is_Constrained (Lhs_Type) then
 
-                        --  Since the enclosing record can never be an
+                        --  Since the enclosing record type can never be an
                         --  Unchecked_Union (this code is executed for records
                         --  that do not have variants), we may reference its
                         --  discriminant(s).
@@ -2121,8 +2115,8 @@ package body Exp_Ch4 is
                   end;
                end if;
 
-               --  Shouldn't this be an else, we can't fall through
-               --  the above IF, right???
+               --  Shouldn't this be an else, we can't fall through the above
+               --  IF, right???
 
                return
                  Make_Function_Call (Loc,
@@ -2145,10 +2139,10 @@ package body Exp_Ch4 is
    -- Expand_Concatenate_Other --
    ------------------------------
 
-   --  Let n be the number of array operands to be concatenated, Base_Typ
-   --  their base type, Ind_Typ their index type, and Arr_Typ the original
-   --  array type to which the concatenation operator applies, then the
-   --  following subprogram is constructed:
+   --  Let n be the number of array operands to be concatenated, Base_Typ their
+   --  base type, Ind_Typ their index type, and Arr_Typ the original array type
+   --  to which the concatenation operator applies, then the following
+   --  subprogram is constructed:
 
    --  [function Cnn (S1 : Base_Typ; ...; Sn : Base_Typ) return Base_Typ is
    --      L : Ind_Typ;
@@ -2425,9 +2419,9 @@ package body Exp_Ch4 is
          Target_Type : Entity_Id;
 
       begin
-         --  If the index type is an enumeration type, the computation
-         --  can be done in standard integer. Otherwise, choose a large
-         --  enough integer type.
+         --  If the index type is an enumeration type, the computation can be
+         --  done in standard integer. Otherwise, choose a large enough integer
+         --  type to accomodate the index type computation.
 
          if Is_Enumeration_Type (Ind_Typ)
            or else Root_Type (Ind_Typ) = Standard_Integer
@@ -2937,12 +2931,12 @@ package body Exp_Ch4 is
             --    typ! (coext.all)
 
             if Nkind (Coext) = N_Identifier then
-               Ref := Make_Unchecked_Type_Conversion (Loc,
-                        Subtype_Mark =>
-                          New_Reference_To (Etype (Coext), Loc),
-                        Expression =>
-                          Make_Explicit_Dereference (Loc,
-                            New_Copy_Tree (Coext)));
+               Ref :=
+                 Make_Unchecked_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Etype (Coext), Loc),
+                   Expression   =>
+                     Make_Explicit_Dereference (Loc,
+                       Prefix => New_Copy_Tree (Coext)));
             else
                Ref := New_Copy_Tree (Coext);
             end if;
@@ -3056,9 +3050,9 @@ package body Exp_Ch4 is
          end if;
       end if;
 
-      --  Under certain circumstances we can replace an allocator by an
-      --  access to statically allocated storage. The conditions, as noted
-      --  in AARM 3.10 (10c) are as follows:
+      --  Under certain circumstances we can replace an allocator by an access
+      --  to statically allocated storage. The conditions, as noted in AARM
+      --  3.10 (10c) are as follows:
 
       --    Size and initial value is known at compile time
       --    Access type is access-to-constant
@@ -3083,8 +3077,8 @@ package body Exp_Ch4 is
 
          --    Tnn : aliased x := y;
 
-         --  and replace the allocator by Tnn'Unrestricted_Access.
-         --  Tnn is marked as requiring static allocation.
+         --  and replace the allocator by Tnn'Unrestricted_Access. Tnn is
+         --  marked as requiring static allocation.
 
          Temp :=
            Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
@@ -3114,8 +3108,8 @@ package body Exp_Ch4 is
 
          Analyze_And_Resolve (N, PtrT);
 
-         --  We set the variable as statically allocated, since we don't
-         --  want it going on the stack of the current procedure!
+         --  We set the variable as statically allocated, since we don't want
+         --  it going on the stack of the current procedure!
 
          Set_Is_Statically_Allocated (Temp);
          return;
@@ -3147,9 +3141,8 @@ package body Exp_Ch4 is
 
       --  If the allocator is for a type which requires initialization, and
       --  there is no initial value (i.e. operand is a subtype indication
-      --  rather than a qualified expression), then we must generate a call
-      --  to the initialization routine. This is done using an expression
-      --  actions node:
+      --  rather than a qualified expression), then we must generate a call to
+      --  the initialization routine using an expressions action node:
 
       --     [Pnnn : constant ptr_T := new (T); Init (Pnnn.all,...); Pnnn]
 
@@ -3364,10 +3357,10 @@ package body Exp_Ch4 is
                   if Dis then
 
                      --  If the allocated object will be constrained by the
-                     --  default values for discriminants, then build a
-                     --  subtype with those defaults, and change the allocated
-                     --  subtype to that. Note that this happens in fewer
-                     --  cases in Ada 2005 (AI-363).
+                     --  default values for discriminants, then build a subtype
+                     --  with those defaults, and change the allocated subtype
+                     --  to that. Note that this happens in fewer cases in Ada
+                     --  2005 (AI-363).
 
                      if not Is_Constrained (Typ)
                        and then Present (Discriminant_Default_Value
@@ -3600,15 +3593,15 @@ package body Exp_Ch4 is
 
       if Nkind (Right) = N_Identifier then
 
-         --  Change (Left and then True) to Left. Note that we know there
-         --  are no actions associated with the True operand, since we
-         --  just checked for this case above.
+         --  Change (Left and then True) to Left. Note that we know there are
+         --  no actions associated with the True operand, since we just checked
+         --  for this case above.
 
          if Entity (Right) = Standard_True then
             Rewrite (N, Left);
 
-         --  Change (Left and then False) to False, making sure to preserve
-         --  any side effects associated with the Left operand.
+         --  Change (Left and then False) to False, making sure to preserve any
+         --  side effects associated with the Left operand.
 
          elsif Entity (Right) = Standard_False then
             Remove_Side_Effects (Left);
@@ -3851,8 +3844,8 @@ package body Exp_Ch4 is
 
                return;
 
-            --  If both checks are known to succeed, replace result
-            --  by True, since we know we are in range.
+            --  If both checks are known to succeed, replace result by True,
+            --  since we know we are in range.
 
             elsif Lcheck in Compare_GE and then Ucheck in Compare_LE then
                if Warn1 then
@@ -3989,9 +3982,9 @@ package body Exp_Ch4 is
                  New_Reference_To (Standard_True, Loc));
                Analyze_And_Resolve (N, Rtyp);
 
-            --  For the constrained array case, we have to check the
-            --  subscripts for an exact match if the lengths are
-            --  non-zero (the lengths must match in any case).
+            --  For the constrained array case, we have to check the subscripts
+            --  for an exact match if the lengths are non-zero (the lengths
+            --  must match in any case).
 
             elsif Is_Array_Type (Typ) then
 
@@ -4059,13 +4052,13 @@ package body Exp_Ch4 is
                   Analyze_And_Resolve (N, Rtyp);
                end Check_Subscripts;
 
-            --  These are the cases where constraint checks may be
-            --  required, e.g. records with possible discriminants
+            --  These are the cases where constraint checks may be required,
+            --  e.g. records with possible discriminants
 
             else
                --  Expand the test into a series of discriminant comparisons.
-               --  The expression that is built is the negation of the one
-               --  that is used for checking discriminant constraints.
+               --  The expression that is built is the negation of the one that
+               --  is used for checking discriminant constraints.
 
                Obj := Relocate_Node (Left_Opnd (N));
 
@@ -4104,18 +4097,18 @@ package body Exp_Ch4 is
       T   : constant Entity_Id  := Etype (P);
 
    begin
-      --  A special optimization, if we have an indexed component that
-      --  is selecting from a slice, then we can eliminate the slice,
-      --  since, for example, x (i .. j)(k) is identical to x(k). The
-      --  only difference is the range check required by the slice. The
-      --  range check for the slice itself has already been generated.
-      --  The range check for the subscripting operation is ensured
-      --  by converting the subject to the subtype of the slice.
-
-      --  This optimization not only generates better code, avoiding
-      --  slice messing especially in the packed case, but more importantly
-      --  bypasses some problems in handling this peculiar case, for
-      --  example, the issue of dealing specially with object renamings.
+      --  A special optimization, if we have an indexed component that is
+      --  selecting from a slice, then we can eliminate the slice, since, for
+      --  example, x (i .. j)(k) is identical to x(k). The only difference is
+      --  the range check required by the slice. The range check for the slice
+      --  itself has already been generated. The range check for the
+      --  subscripting operation is ensured by converting the subject to
+      --  the subtype of the slice.
+
+      --  This optimization not only generates better code, avoiding slice
+      --  messing especially in the packed case, but more importantly bypasses
+      --  some problems in handling this peculiar case, for example, the issue
+      --  of dealing specially with object renamings.
 
       if Nkind (P) = N_Slice then
          Rewrite (N,
@@ -4138,11 +4131,11 @@ package body Exp_Ch4 is
          Make_Build_In_Place_Call_In_Anonymous_Context (P);
       end if;
 
-      --  If the prefix is an access type, then we unconditionally rewrite
-      --  if as an explicit deference. This simplifies processing for several
-      --  cases, including packed array cases and certain cases in which
-      --  checks must be generated. We used to try to do this only when it
-      --  was necessary, but it cleans up the code to do it all the time.
+      --  If the prefix is an access type, then we unconditionally rewrite if
+      --  as an explicit deference. This simplifies processing for several
+      --  cases, including packed array cases and certain cases in which checks
+      --  must be generated. We used to try to do this only when it was
+      --  necessary, but it cleans up the code to do it all the time.
 
       if Is_Access_Type (T) then
          Insert_Explicit_Dereference (P);
@@ -4176,8 +4169,8 @@ package body Exp_Ch4 is
       --  convert it to a reference to the corresponding Packed_Array_Type.
       --  We only want to do this for simple references, and not for:
 
-      --    Left side of assignment, or prefix of left side of assignment,
-      --    or prefix of the prefix, to handle packed arrays of packed arrays,
+      --    Left side of assignment, or prefix of left side of assignment, or
+      --    prefix of the prefix, to handle packed arrays of packed arrays,
       --      This case is handled in Exp_Ch5.Expand_N_Assignment_Statement
 
       --    Renaming objects in renaming associations
@@ -4222,8 +4215,8 @@ package body Exp_Ch4 is
             then
                return;
 
-            --  If the expression is an index of an indexed component,
-            --  it must be expanded regardless of context.
+            --  If the expression is an index of an indexed component, it must
+            --  be expanded regardless of context.
 
             elsif Nkind (Parnt) = N_Indexed_Component
               and then Child /= Prefix (Parnt)
@@ -4252,8 +4245,8 @@ package body Exp_Ch4 is
                return;
             end if;
 
-            --  Keep looking up tree for unchecked expression, or if we are
-            --  the prefix of a possible assignment left side.
+            --  Keep looking up tree for unchecked expression, or if we are the
+            --  prefix of a possible assignment left side.
 
             Child := Parnt;
             Parnt := Parent (Child);
@@ -4296,11 +4289,11 @@ package body Exp_Ch4 is
    -- Expand_N_Null --
    -------------------
 
-   --  The only replacement required is for the case of a null of type
-   --  that is an access to protected subprogram. We represent such
-   --  access values as a record, and so we must replace the occurrence
-   --  of null by the equivalent record (with a null address and a null
-   --  pointer in it), so that the backend creates the proper value.
+   --  The only replacement required is for the case of a null of type that is
+   --  an access to protected subprogram. We represent such access values as a
+   --  record, and so we must replace the occurrence of null by the equivalent
+   --  record (with a null address and a null pointer in it), so that the
+   --  backend creates the proper value.
 
    procedure Expand_N_Null (N : Node_Id) is
       Loc : constant Source_Ptr := Sloc (N);
@@ -4318,9 +4311,9 @@ package body Exp_Ch4 is
          Rewrite (N, Agg);
          Analyze_And_Resolve (N, Equivalent_Type (Typ));
 
-         --  For subsequent semantic analysis, the node must retain its
-         --  type. Gigi in any case replaces this type by the corresponding
-         --  record type before processing the node.
+         --  For subsequent semantic analysis, the node must retain its type.
+         --  Gigi in any case replaces this type by the corresponding record
+         --  type before processing the node.
 
          Set_Etype (N, Typ);
       end if;
@@ -4347,9 +4340,8 @@ package body Exp_Ch4 is
          and then Is_Signed_Integer_Type (Etype (N))
          and then Do_Overflow_Check (N)
       then
-         --  The only case to worry about is when the argument is
-         --  equal to the largest negative number, so what we do is
-         --  to insert the check:
+         --  The only case to worry about is when the argument is equal to the
+         --  largest negative number, so what we do is to insert the check:
 
          --     [constraint_error when Expr = typ'Base'First]
 
@@ -4465,8 +4457,8 @@ package body Exp_Ch4 is
       --  Single operand for concatenation
 
       Cnode : Node_Id;
-      --  Node which is to be replaced by the result of concatenating
-      --  the nodes in the list Opnds.
+      --  Node which is to be replaced by the result of concatenating the nodes
+      --  in the list Opnds.
 
       Atyp : Entity_Id;
       --  Array type of concatenation result type
@@ -4510,9 +4502,9 @@ package body Exp_Ch4 is
 
       Binary_Op_Validity_Checks (N);
 
-      --  If we are the left operand of a concatenation higher up the
-      --  tree, then do nothing for now, since we want to deal with a
-      --  series of concatenations as a unit.
+      --  If we are the left operand of a concatenation higher up the tree,
+      --  then do nothing for now, since we want to deal with a series of
+      --  concatenations as a unit.
 
       if Nkind (Parent (N)) = N_Op_Concat
         and then N = Left_Opnd (Parent (N))
@@ -4564,10 +4556,10 @@ package body Exp_Ch4 is
             Append (Right_Opnd (Cnode), Opnds);
          end loop Inner;
 
-         --  Here we process the collected operands. First we convert
-         --  singleton operands to singleton aggregates. This is skipped
-         --  however for the case of two operands of type String, since
-         --  we have special routines for these cases.
+         --  Here we process the collected operands. First we convert singleton
+         --  operands to singleton aggregates. This is skipped however for the
+         --  case of two operands of type String since we have special routines
+         --  for these cases.
 
          Atyp := Base_Type (Etype (Cnode));
          Ctyp := Base_Type (Component_Type (Etype (Cnode)));
@@ -4668,9 +4660,9 @@ package body Exp_Ch4 is
 
       if Is_Fixed_Point_Type (Typ) then
 
-         --  No special processing if Treat_Fixed_As_Integer is set,
-         --  since from a semantic point of view such operations are
-         --  simply integer operations and will be treated that way.
+         --  No special processing if Treat_Fixed_As_Integer is set, since
+         --  from a semantic point of view such operations are simply integer
+         --  operations and will be treated that way.
 
          if not Treat_Fixed_As_Integer (N) then
             if Is_Integer_Type (Rtyp) then
@@ -4680,8 +4672,8 @@ package body Exp_Ch4 is
             end if;
          end if;
 
-      --  Other cases of division of fixed-point operands. Again we
-      --  exclude the case where Treat_Fixed_As_Integer is set.
+      --  Other cases of division of fixed-point operands. Again we exclude the
+      --  case where Treat_Fixed_As_Integer is set.
 
       elsif (Is_Fixed_Point_Type (Ltyp) or else
              Is_Fixed_Point_Type (Rtyp))
@@ -4694,9 +4686,8 @@ package body Exp_Ch4 is
             Expand_Divide_Fixed_By_Fixed_Giving_Float (N);
          end if;
 
-      --  Mixed-mode operations can appear in a non-static universal
-      --  context, in  which case the integer argument must be converted
-      --  explicitly.
+      --  Mixed-mode operations can appear in a non-static universal context,
+      --  in which case the integer argument must be converted explicitly.
 
       elsif Typ = Universal_Real
         and then Is_Integer_Type (Rtyp)
@@ -5178,9 +5169,9 @@ package body Exp_Ch4 is
          then
             null;
 
-         --  For composite and floating-point cases, expand equality loop
-         --  to make sure of using proper comparisons for tagged types,
-         --  and correctly handling the floating-point case.
+         --  For composite and floating-point cases, expand equality loop to
+         --  make sure of using proper comparisons for tagged types, and
+         --  correctly handling the floating-point case.
 
          else
             Rewrite (N,
@@ -5210,20 +5201,19 @@ package body Exp_Ch4 is
                return;
             end if;
 
-            --  If this is derived from an untagged private type completed
-            --  with a tagged type, it does not have a full view, so we
-            --  use the primitive operations of the private type.
-            --  This check should no longer be necessary when these
-            --  types receive their full views ???
+            --  If this is derived from an untagged private type completed with
+            --  a tagged type, it does not have a full view, so we use the
+            --  primitive operations of the private type. This check should no
+            --  longer be necessary when these types get their full views???
 
             if Is_Private_Type (A_Typ)
               and then not Is_Tagged_Type (A_Typ)
               and then Is_Derived_Type (A_Typ)
               and then No (Full_View (A_Typ))
             then
-               --  Search for equality operation, checking that the
-               --  operands have the same type. Note that we must find
-               --  a matching entry, or something is very wrong!
+               --  Search for equality operation, checking that the operands
+               --  have the same type. Note that we must find a matching entry,
+               --  or something is very wrong!
 
                Prim := First_Elmt (Collect_Primitive_Operations (A_Typ));
 
@@ -5241,11 +5231,11 @@ package body Exp_Ch4 is
                Op_Name := Node (Prim);
 
             --  Find the type's predefined equality or an overriding
-            --  user-defined equality. The reason for not simply calling
+            --  user- defined equality. The reason for not simply calling
             --  Find_Prim_Op here is that there may be a user-defined
-            --  overloaded equality op that precedes the equality that
-            --  we want, so we have to explicitly search (e.g., there
-            --  could be an equality with two different parameter types).
+            --  overloaded equality op that precedes the equality that we want,
+            --  so we have to explicitly search (e.g., there could be an
+            --  equality with two different parameter types).
 
             else
                if Is_Class_Wide_Type (Typl) then
@@ -5370,12 +5360,12 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
-      --  If either operand is of a private type, then we have the use of
-      --  an intrinsic operator, and we get rid of the privateness, by using
-      --  root types of underlying types for the actual operation. Otherwise
-      --  the private types will cause trouble if we expand multiplications
-      --  or shifts etc. We also do this transformation if the result type
-      --  is different from the base type.
+      --  If either operand is of a private type, then we have the use of an
+      --  intrinsic operator, and we get rid of the privateness, by using root
+      --  types of underlying types for the actual operation. Otherwise the
+      --  private types will cause trouble if we expand multiplications or
+      --  shifts etc. We also do this transformation if the result type is
+      --  different from the base type.
 
       if Is_Private_Type (Etype (Base))
            or else
@@ -5483,6 +5473,10 @@ package body Exp_Ch4 is
       --  the flag Is_Natural_Power_Of_2_for_Shift set, then the expansion
       --  of the higher level node converts it into a shift.
 
+      --  Note: this transformation is not applicable for a modular type with
+      --  a non-binary modulus in the multiplication case, since we get a wrong
+      --  result if the shift causes an overflow before the modular reduction.
+
       if Nkind (Base) = N_Integer_Literal
         and then Intval (Base) = 2
         and then Is_Integer_Type (Root_Type (Exptyp))
@@ -5498,6 +5492,7 @@ package body Exp_Ch4 is
 
          begin
             if (Nkind (P) = N_Op_Multiply
+                 and then not Non_Binary_Modulus (Typ)
                  and then
                    ((Is_Integer_Type (Etype (L)) and then R = N)
                        or else
@@ -5538,9 +5533,9 @@ package body Exp_Ch4 is
                     Make_Integer_Literal (Loc, Modulus (Rtyp)),
                     Exp))));
 
-         --  Binary case, in this case, we call one of two routines, either
-         --  the unsigned integer case, or the unsigned long long integer
-         --  case, with a final "and" operation to do the required mod.
+         --  Binary case, in this case, we call one of two routines, either the
+         --  unsigned integer case, or the unsigned long long integer case,
+         --  with a final "and" operation to do the required mod.
 
          else
             if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
@@ -5859,9 +5854,9 @@ package body Exp_Ch4 is
              Left_Opnd  => Left_Opnd (N),
              Right_Opnd => Right_Opnd (N)));
 
-         --  Instead of reanalyzing the node we do the analysis manually.
-         --  This avoids anomalies when the replacement is done in an
-         --  instance and is epsilon more efficient.
+         --  Instead of reanalyzing the node we do the analysis manually. This
+         --  avoids anomalies when the replacement is done in an instance and
+         --  is epsilon more efficient.
 
          Set_Entity            (N, Standard_Entity (S_Op_Rem));
          Set_Etype             (N, Typ);
@@ -5894,13 +5889,13 @@ package body Exp_Ch4 is
          --  minus one. Gigi does not handle this case correctly, because
          --  it generates a divide instruction which may trap in this case.
 
-         --  In fact the check is quite easy, if the right operand is -1,
-         --  then the mod value is always 0, and we can just ignore the
-         --  left operand completely in this case.
+         --  In fact the check is quite easy, if the right operand is -1, then
+         --  the mod value is always 0, and we can just ignore the left operand
+         --  completely in this case.
 
-         --  The operand type may be private (e.g. in the expansion of an
-         --  an intrinsic operation) so we must use the underlying type to
-         --  get the bounds, and convert the literals explicitly.
+         --  The operand type may be private (e.g. in the expansion of an an
+         --  intrinsic operation) so we must use the underlying type to get the
+         --  bounds, and convert the literals explicitly.
 
          LLB :=
            Expr_Value
@@ -6042,9 +6037,9 @@ package body Exp_Ch4 is
 
       if Is_Fixed_Point_Type (Typ) then
 
-         --  No special processing if Treat_Fixed_As_Integer is set,
-         --  since from a semantic point of view such operations are
-         --  simply integer operations and will be treated that way.
+         --  No special processing if Treat_Fixed_As_Integer is set, since from
+         --  a semantic point of view such operations are simply integer
+         --  operations and will be treated that way.
 
          if not Treat_Fixed_As_Integer (N) then
 
@@ -6065,8 +6060,8 @@ package body Exp_Ch4 is
             end if;
          end if;
 
-      --  Other cases of multiplication of fixed-point operands. Again
-      --  we exclude the cases where Treat_Fixed_As_Integer flag is set.
+      --  Other cases of multiplication of fixed-point operands. Again we
+      --  exclude the cases where Treat_Fixed_As_Integer flag is set.
 
       elsif (Is_Fixed_Point_Type (Ltyp) or else Is_Fixed_Point_Type (Rtyp))
         and then not Treat_Fixed_As_Integer (N)
@@ -6078,9 +6073,8 @@ package body Exp_Ch4 is
             Expand_Multiply_Fixed_By_Fixed_Giving_Float (N);
          end if;
 
-      --  Mixed-mode operations can appear in a non-static universal
-      --  context, in  which case the integer argument must be converted
-      --  explicitly.
+      --  Mixed-mode operations can appear in a non-static universal context,
+      --  in which case the integer argument must be converted explicitly.
 
       elsif Typ = Universal_Real
         and then Is_Integer_Type (Rtyp)
@@ -6187,18 +6181,18 @@ package body Exp_Ch4 is
    -- Expand_N_Op_Not --
    ---------------------
 
-   --  If the argument is other than a Boolean array type, there is no
-   --  special expansion required.
+   --  If the argument is other than a Boolean array type, there is no special
+   --  expansion required.
 
    --  For the packed case, we call the special routine in Exp_Pakd, except
    --  that if the component size is greater than one, we use the standard
    --  routine generating a gruesome loop (it is so peculiar to have packed
-   --  arrays with non-standard Boolean representations anyway, so it does
-   --  not matter that we do not handle this case efficiently).
+   --  arrays with non-standard Boolean representations anyway, so it does not
+   --  matter that we do not handle this case efficiently).
 
-   --  For the unpacked case (and for the special packed case where we have
-   --  non standard Booleans, as discussed above), we generate and insert
-   --  into the tree the following function definition:
+   --  For the unpacked case (and for the special packed case where we have non
+   --  standard Booleans, as discussed above), we generate and insert into the
+   --  tree the following function definition:
 
    --     function Nnnn (A : arr) is
    --       B : arr;
@@ -6435,9 +6429,9 @@ package body Exp_Ch4 is
          Apply_Divide_Check (N);
       end if;
 
-      --  Apply optimization x rem 1 = 0. We don't really need that with
-      --  gcc, but it is useful with other back ends (e.g. AAMP), and is
-      --  certainly harmless.
+      --  Apply optimization x rem 1 = 0. We don't really need that with gcc,
+      --  but it is useful with other back ends (e.g. AAMP), and is certainly
+      --  harmless.
 
       if Is_Integer_Type (Etype (N))
         and then Compile_Time_Known_Value (Right)
@@ -6448,20 +6442,20 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      --  Deal with annoying case of largest negative number remainder
-      --  minus one. Gigi does not handle this case correctly, because
-      --  it generates a divide instruction which may trap in this case.
+      --  Deal with annoying case of largest negative number remainder minus
+      --  one. Gigi does not handle this case correctly, because it generates
+      --  a divide instruction which may trap in this case.
 
-      --  In fact the check is quite easy, if the right operand is -1,
-      --  then the remainder is always 0, and we can just ignore the
-      --  left operand completely in this case.
+      --  In fact the check is quite easy, if the right operand is -1, then
+      --  the remainder is always 0, and we can just ignore the left operand
+      --  completely in this case.
 
       Determine_Range (Right, ROK, Rlo, Rhi);
       Determine_Range (Left, LOK, Llo, Lhi);
 
-      --  The operand type may be private (e.g. in the expansion of an
-      --  an intrinsic operation) so we must use the underlying type to
-      --  get the bounds, and convert the literals explicitly.
+      --  The operand type may be private (e.g. in the expansion of an an
+      --  intrinsic operation) so we must use the underlying type to get the
+      --  bounds, and convert the literals explicitly.
 
       LLB :=
         Expr_Value
@@ -6632,9 +6626,9 @@ package body Exp_Ch4 is
             Adjust_Result_Type (N, Typ);
             return;
 
-         --  If left argument is True, change (True and then Right) to
-         --  True. In this case we can forget the actions associated with
-         --  Right, since they will never be executed.
+         --  If left argument is True, change (True and then Right) to True. In
+         --  this case we can forget the actions associated with Right, since
+         --  they will never be executed.
 
          elsif Entity (Left) = Standard_True then
             Kill_Dead_Code (Right);
@@ -6676,15 +6670,15 @@ package body Exp_Ch4 is
 
       if Nkind (Right) = N_Identifier then
 
-         --  Change (Left or else False) to Left. Note that we know there
-         --  are no actions associated with the True operand, since we
-         --  just checked for this case above.
+         --  Change (Left or else False) to Left. Note that we know there are
+         --  no actions associated with the True operand, since we just checked
+         --  for this case above.
 
          if Entity (Right) = Standard_False then
             Rewrite (N, Left);
 
-         --  Change (Left or else True) to True, making sure to preserve
-         --  any side effects associated with the Left operand.
+         --  Change (Left or else True) to True, making sure to preserve any
+         --  side effects associated with the Left operand.
 
          elsif Entity (Right) = Standard_True then
             Remove_Side_Effects (Left);
@@ -6774,8 +6768,8 @@ package body Exp_Ch4 is
 
       if Do_Discriminant_Check (N) then
 
-         --  Present the discriminant checking function to the backend,
-         --  so that it can inline the call to the function.
+         --  Present the discriminant checking function to the backend, so that
+         --  it can inline the call to the function.
 
          Add_Inlined_Body
            (Discriminant_Checking_Func
@@ -6837,9 +6831,9 @@ package body Exp_Ch4 is
             then
                null;
 
-            --  Don't do this optimization for the prefix of an attribute
-            --  or the operand of an object renaming declaration since these
-            --  are contexts where we do not want the value anyway.
+            --  Don't do this optimization for the prefix of an attribute or
+            --  the operand of an object renaming declaration since these are
+            --  contexts where we do not want the value anyway.
 
             elsif (Nkind (Par) = N_Attribute_Reference
                      and then Prefix (Par) = N)
@@ -6855,12 +6849,12 @@ package body Exp_Ch4 is
                null;
 
             --  Green light to see if we can do the optimization. There is
-            --  still one condition that inhibits the optimization below
-            --  but now is the time to check the particular discriminant.
+            --  still one condition that inhibits the optimization below but
+            --  now is the time to check the particular discriminant.
 
             else
-               --  Loop through discriminants to find the matching
-               --  discriminant constraint to see if we can copy it.
+               --  Loop through discriminants to find the matching discriminant
+               --  constraint to see if we can copy it.
 
                Disc := First_Discriminant (Ptyp);
                Dcon := First_Elmt (Discriminant_Constraint (Ptyp));
@@ -6881,10 +6875,10 @@ package body Exp_Ch4 is
                      then
                         exit Discr_Loop;
 
-                     --  In the context of a case statement, the expression
-                     --  may have the base type of the discriminant, and we
-                     --  need to preserve the constraint to avoid spurious
-                     --  errors on missing cases.
+                     --  In the context of a case statement, the expression may
+                     --  have the base type of the discriminant, and we need to
+                     --  preserve the constraint to avoid spurious errors on
+                     --  missing cases.
 
                      elsif Nkind (Parent (N)) = N_Case_Statement
                        and then Etype (Node (Dcon)) /= Etype (Disc)
@@ -6924,8 +6918,8 @@ package body Exp_Ch4 is
 
                --  Note: the above loop should always find a matching
                --  discriminant, but if it does not, we just missed an
-               --  optimization due to some glitch (perhaps a previous
-               --  error), so ignore.
+               --  optimization due to some glitch (perhaps a previous error),
+               --  so ignore.
 
             end if;
          end if;
@@ -6971,21 +6965,21 @@ package body Exp_Ch4 is
       Ptp  : Entity_Id           := Etype (Pfx);
 
       function Is_Procedure_Actual (N : Node_Id) return Boolean;
-      --  Check whether the argument is an actual for a procedure call,
-      --  in which case the expansion of a bit-packed slice is deferred
-      --  until the call itself is expanded. The reason this is required
-      --  is that we might have an IN OUT or OUT parameter, and the copy out
-      --  is essential, and that copy out would be missed if we created a
-      --  temporary here in Expand_N_Slice. Note that we don't bother
-      --  to test specifically for an IN OUT or OUT mode parameter, since it
-      --  is a bit tricky to do, and it is harmless to defer expansion
-      --  in the IN case, since the call processing will still generate the
-      --  appropriate copy in operation, which will take care of the slice.
+      --  Check whether the argument is an actual for a procedure call, in
+      --  which case the expansion of a bit-packed slice is deferred until the
+      --  call itself is expanded. The reason this is required is that we might
+      --  have an IN OUT or OUT parameter, and the copy out is essential, and
+      --  that copy out would be missed if we created a temporary here in
+      --  Expand_N_Slice. Note that we don't bother to test specifically for an
+      --  IN OUT or OUT mode parameter, since it is a bit tricky to do, and it
+      --  is harmless to defer expansion in the IN case, since the call
+      --  processing will still generate the appropriate copy in operation,
+      --  which will take care of the slice.
 
       procedure Make_Temporary;
-      --  Create a named variable for the value of the slice, in
-      --  cases where the back-end cannot handle it properly, e.g.
-      --  when packed types or unaligned slices are involved.
+      --  Create a named variable for the value of the slice, in cases where
+      --  the back-end cannot handle it properly, e.g. when packed types or
+      --  unaligned slices are involved.
 
       -------------------------
       -- Is_Procedure_Actual --
@@ -7001,11 +6995,11 @@ package body Exp_Ch4 is
             if Nkind (Par) = N_Procedure_Call_Statement then
                return True;
 
-            --  If our parent is a type conversion, keep climbing the
-            --  tree, since a type conversion can be a procedure actual.
-            --  Also keep climbing if parameter association or a qualified
-            --  expression, since these are additional cases that do can
-            --  appear on procedure actuals.
+            --  If our parent is a type conversion, keep climbing the tree,
+            --  since a type conversion can be a procedure actual. Also keep
+            --  climbing if parameter association or a qualified expression,
+            --  since these are additional cases that do can appear on
+            --  procedure actuals.
 
             elsif Nkind_In (Par, N_Type_Conversion,
                                  N_Parameter_Association,
@@ -7072,9 +7066,9 @@ package body Exp_Ch4 is
          Make_Build_In_Place_Call_In_Anonymous_Context (Pfx);
       end if;
 
-      --  Range checks are potentially also needed for cases involving
-      --  a slice indexed by a subtype indication, but Do_Range_Check
-      --  can currently only be set for expressions ???
+      --  Range checks are potentially also needed for cases involving a slice
+      --  indexed by a subtype indication, but Do_Range_Check can currently
+      --  only be set for expressions ???
 
       if not Index_Checks_Suppressed (Ptp)
         and then (not Is_Entity_Name (Pfx)
@@ -7104,24 +7098,24 @@ package body Exp_Ch4 is
       --    1. Right or left side of an assignment (we can handle this
       --       situation correctly in the assignment statement expansion).
 
-      --    2. Prefix of indexed component (the slide is optimized away
-      --       in this case, see the start of Expand_N_Slice.)
+      --    2. Prefix of indexed component (the slide is optimized away in this
+      --       case, see the start of Expand_N_Slice.)
 
-      --    3. Object renaming declaration, since we want the name of
-      --       the slice, not the value.
+      --    3. Object renaming declaration, since we want the name of the
+      --       slice, not the value.
 
-      --    4. Argument to procedure call, since copy-in/copy-out handling
-      --       may be required, and this is handled in the expansion of
-      --       call itself.
+      --    4. Argument to procedure call, since copy-in/copy-out handling may
+      --       be required, and this is handled in the expansion of call
+      --       itself.
 
-      --    5. Prefix of an address attribute (this is an error which
-      --       is caught elsewhere, and the expansion would interfere
-      --       with generating the error message).
+      --    5. Prefix of an address attribute (this is an error which is caught
+      --       elsewhere, and the expansion would interfere with generating the
+      --       error message).
 
       if not Is_Packed (Typ) then
 
-         --  Apply transformation for actuals of a function call,
-         --  where Expand_Actuals is not used.
+         --  Apply transformation for actuals of a function call, where
+         --  Expand_Actuals is not used.
 
          if Nkind (Parent (N)) = N_Function_Call
            and then Is_Possibly_Unaligned_Slice (N)
@@ -7162,12 +7156,12 @@ package body Exp_Ch4 is
       Operand_Type : Entity_Id           := Etype (Operand);
 
       procedure Handle_Changed_Representation;
-      --  This is called in the case of record and array type conversions
-      --  to see if there is a change of representation to be handled.
-      --  Change of representation is actually handled at the assignment
-      --  statement level, and what this procedure does is rewrite node N
-      --  conversion as an assignment to temporary. If there is no change
-      --  of representation, then the conversion node is unchanged.
+      --  This is called in the case of record and array type conversions to
+      --  see if there is a change of representation to be handled. Change of
+      --  representation is actually handled at the assignment statement level,
+      --  and what this procedure does is rewrite node N conversion as an
+      --  assignment to temporary. If there is no change of representation,
+      --  then the conversion node is unchanged.
 
       procedure Real_Range_Check;
       --  Handles generation of range check for real target value
@@ -7205,8 +7199,8 @@ package body Exp_Ch4 is
          else
             Cons := No_List;
 
-            --  If type is unconstrained we have to add a constraint,
-            --  copied from the actual value of the left hand side.
+            --  If type is unconstrained we have to add a constraint, copied
+            --  from the actual value of the left hand side.
 
             if not Is_Constrained (Target_Type) then
                if Has_Discriminants (Operand_Type) then
@@ -7302,9 +7296,8 @@ package body Exp_Ch4 is
       -- Real_Range_Check --
       ----------------------
 
-      --  Case of conversions to floating-point or fixed-point. If range
-      --  checks are enabled and the target type has a range constraint,
-      --  we convert:
+      --  Case of conversions to floating-point or fixed-point. If range checks
+      --  are enabled and the target type has a range constraint, we convert:
 
       --     typ (x)
 
@@ -7314,10 +7307,10 @@ package body Exp_Ch4 is
       --     [constraint_error when Tnn < typ'First or else Tnn > typ'Last]
       --     Tnn
 
-      --  This is necessary when there is a conversion of integer to float
-      --  or to fixed-point to ensure that the correct checks are made. It
-      --  is not necessary for float to float where it is enough to simply
-      --  set the Do_Range_Check flag.
+      --  This is necessary when there is a conversion of integer to float or
+      --  to fixed-point to ensure that the correct checks are made. It is not
+      --  necessary for float to float where it is enough to simply set the
+      --  Do_Range_Check flag.
 
       procedure Real_Range_Check is
          Btyp : constant Entity_Id := Base_Type (Target_Type);
@@ -7334,8 +7327,8 @@ package body Exp_Ch4 is
             return;
          end if;
 
-         --  Nothing to do if range checks suppressed, or target has the
-         --  same range as the base type (or is the base type).
+         --  Nothing to do if range checks suppressed, or target has the same
+         --  range as the base type (or is the base type).
 
          if Range_Checks_Suppressed (Target_Type)
            or else (Lo = Type_Low_Bound (Btyp)
@@ -7345,8 +7338,8 @@ package body Exp_Ch4 is
             return;
          end if;
 
-         --  Nothing to do if expression is an entity on which checks
-         --  have been suppressed.
+         --  Nothing to do if expression is an entity on which checks have been
+         --  suppressed.
 
          if Is_Entity_Name (Operand)
            and then Range_Checks_Suppressed (Entity (Operand))
@@ -7354,10 +7347,10 @@ package body Exp_Ch4 is
             return;
          end if;
 
-         --  Nothing to do if bounds are all static and we can tell that
-         --  the expression is within the bounds of the target. Note that
-         --  if the operand is of an unconstrained floating-point type,
-         --  then we do not trust it to be in range (might be infinite)
+         --  Nothing to do if bounds are all static and we can tell that the
+         --  expression is within the bounds of the target. Note that if the
+         --  operand is of an unconstrained floating-point type, then we do
+         --  not trust it to be in range (might be infinite)
 
          declare
             S_Lo : constant Node_Id := Type_Low_Bound (Xtyp);
@@ -7460,17 +7453,17 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_N_Type_Conversion
 
    begin
-      --  Nothing at all to do if conversion is to the identical type
-      --  so remove the conversion completely, it is useless.
+      --  Nothing at all to do if conversion is to the identical type so remove
+      --  the conversion completely, it is useless.
 
       if Operand_Type = Target_Type then
          Rewrite (N, Relocate_Node (Operand));
          return;
       end if;
 
-      --  Nothing to do if this is the second argument of read. This
-      --  is a "backwards" conversion that will be handled by the
-      --  specialized code in attribute processing.
+      --  Nothing to do if this is the second argument of read. This is a
+      --  "backwards" conversion that will be handled by the specialized code
+      --  in attribute processing.
 
       if Nkind (Parent (N)) = N_Attribute_Reference
         and then Attribute_Name (Parent (N)) = Name_Read
@@ -7523,13 +7516,12 @@ package body Exp_Ch4 is
          then
             Apply_Accessibility_Check (Operand, Target_Type);
 
-         --  If the level of the operand type is statically deeper
-         --  then the level of the target type, then force Program_Error.
-         --  Note that this can only occur for cases where the attribute
-         --  is within the body of an instantiation (otherwise the
-         --  conversion will already have been rejected as illegal).
-         --  Note: warnings are issued by the analyzer for the instance
-         --  cases.
+         --  If the level of the operand type is statically deeper then the
+         --  level of the target type, then force Program_Error. Note that this
+         --  can only occur for cases where the attribute is within the body of
+         --  an instantiation (otherwise the conversion will already have been
+         --  rejected as illegal). Note: warnings are issued by the analyzer
+         --  for the instance cases.
 
          elsif In_Instance_Body
            and then Type_Access_Level (Operand_Type) >
@@ -7540,12 +7532,11 @@ package body Exp_Ch4 is
                 Reason => PE_Accessibility_Check_Failed));
             Set_Etype (N, Target_Type);
 
-         --  When the operand is a selected access discriminant
-         --  the check needs to be made against the level of the
-         --  object denoted by the prefix of the selected name.
-         --  Force Program_Error for this case as well (this
-         --  accessibility violation can only happen if within
-         --  the body of an instantiation).
+         --  When the operand is a selected access discriminant the check needs
+         --  to be made against the level of the object denoted by the prefix
+         --  of the selected name. Force Program_Error for this case as well
+         --  (this accessibility violation can only happen if within the body
+         --  of an instantiation).
 
          elsif In_Instance_Body
            and then Ekind (Operand_Type) = E_Anonymous_Access_Type
@@ -7562,9 +7553,9 @@ package body Exp_Ch4 is
 
       --  Case of conversions of tagged types and access to tagged types
 
-      --  When needed, that is to say when the expression is class-wide,
-      --  Add runtime a tag check for (strict) downward conversion by using
-      --  the membership test, generating:
+      --  When needed, that is to say when the expression is class-wide, Add
+      --  runtime a tag check for (strict) downward conversion by using the
+      --  membership test, generating:
 
       --      [constraint_error when Operand not in Target_Type'Class]
 
@@ -7579,10 +7570,9 @@ package body Exp_Ch4 is
            and then Is_Tagged_Type (Designated_Type (Target_Type)))
         or else Is_Tagged_Type (Target_Type)
       then
-         --  Do not do any expansion in the access type case if the
-         --  parent is a renaming, since this is an error situation
-         --  which will be caught by Sem_Ch8, and the expansion can
-         --  interfere with this error check.
+         --  Do not do any expansion in the access type case if the parent is a
+         --  renaming, since this is an error situation which will be caught by
+         --  Sem_Ch8, and the expansion can interfere with this error check.
 
          if Is_Access_Type (Target_Type)
            and then Is_Renamed_Object (N)
@@ -7622,8 +7612,7 @@ package body Exp_Ch4 is
                           Actual_Target_Type)
               and then not Tag_Checks_Suppressed (Actual_Target_Type)
             then
-               --  The conversion is valid for any descendant of the
-               --  target type
+               --  Conversion is valid for any descendant of the target type
 
                Actual_Target_Type := Class_Wide_Type (Actual_Target_Type);
 
@@ -7677,9 +7666,9 @@ package body Exp_Ch4 is
 
       --  Case of conversions from a fixed-point type
 
-      --  These conversions require special expansion and processing, found
-      --  in the Exp_Fixd package. We ignore cases where Conversion_OK is
-      --  set, since from a semantic point of view, these are simple integer
+      --  These conversions require special expansion and processing, found in
+      --  the Exp_Fixd package. We ignore cases where Conversion_OK is set,
+      --  since from a semantic point of view, these are simple integer
       --  conversions, which do not need further processing.
 
       elsif Is_Fixed_Point_Type (Operand_Type)
@@ -7691,11 +7680,10 @@ package body Exp_Ch4 is
 
          pragma Assert (Operand_Type /= Universal_Fixed);
 
-         --  Check for special case of the conversion to universal real
-         --  that occurs as a result of the use of a round attribute.
-         --  In this case, the real type for the conversion is taken
-         --  from the target type of the Round attribute and the
-         --  result must be marked as rounded.
+         --  Check for special case of the conversion to universal real that
+         --  occurs as a result of the use of a round attribute. In this case,
+         --  the real type for the conversion is taken from the target type of
+         --  the Round attribute and the result must be marked as rounded.
 
          if Target_Type = Universal_Real
            and then Nkind (Parent (N)) = N_Attribute_Reference
@@ -7727,10 +7715,10 @@ package body Exp_Ch4 is
 
       --  Case of conversions to a fixed-point type
 
-      --  These conversions require special expansion and processing, found
-      --  in the Exp_Fixd package. Again, ignore cases where Conversion_OK
-      --  is set, since from a semantic point of view, these are simple
-      --  integer conversions, which do not need further processing.
+      --  These conversions require special expansion and processing, found in
+      --  the Exp_Fixd package. Again, ignore cases where Conversion_OK is set,
+      --  since from a semantic point of view, these are simple integer
+      --  conversions, which do not need further processing.
 
       elsif Is_Fixed_Point_Type (Target_Type)
         and then not Conversion_OK (N)
@@ -7782,9 +7770,9 @@ package body Exp_Ch4 is
 
       --  Case of array conversions
 
-      --  Expansion of array conversions, add required length/range checks
-      --  but only do this if there is no change of representation. For
-      --  handling of this case, see Handle_Changed_Representation.
+      --  Expansion of array conversions, add required length/range checks but
+      --  only do this if there is no change of representation. For handling of
+      --  this case, see Handle_Changed_Representation.
 
       elsif Is_Array_Type (Target_Type) then
 
@@ -7798,8 +7786,8 @@ package body Exp_Ch4 is
 
       --  Case of conversions of discriminated types
 
-      --  Add required discriminant checks if target is constrained. Again
-      --  this change is skipped if we have a change of representation.
+      --  Add required discriminant checks if target is constrained. Again this
+      --  change is skipped if we have a change of representation.
 
       elsif Has_Discriminants (Target_Type)
         and then Is_Constrained (Target_Type)
@@ -7814,8 +7802,8 @@ package body Exp_Ch4 is
       elsif Is_Record_Type (Target_Type) then
 
          --  Ada 2005 (AI-216): Program_Error is raised when converting from
-         --  a derived Unchecked_Union type to an unconstrained non-Unchecked_
-         --  Union type if the operand lacks inferable discriminants.
+         --  a derived Unchecked_Union type to an unconstrained type that is
+         --  not Unchecked_Union if the operand lacks inferable discriminants.
 
          if Is_Derived_Type (Operand_Type)
            and then Is_Unchecked_Union (Base_Type (Operand_Type))
@@ -7823,7 +7811,7 @@ package body Exp_Ch4 is
            and then not Is_Unchecked_Union (Base_Type (Target_Type))
            and then not Has_Inferable_Discriminants (Operand)
          then
-            --  To prevent Gigi from generating illegal code, we make a
+            --  To prevent Gigi from generating illegal code, we generate a
             --  Program_Error node, but we give it the target type of the
             --  conversion.
 
@@ -7870,25 +7858,24 @@ package body Exp_Ch4 is
          Real_Range_Check;
       end if;
 
-      --  At this stage, either the conversion node has been transformed
-      --  into some other equivalent expression, or left as a conversion
-      --  that can be handled by Gigi. The conversions that Gigi can handle
-      --  are the following:
+      --  At this stage, either the conversion node has been transformed into
+      --  some other equivalent expression, or left as a conversion that can
+      --  be handled by Gigi. The conversions that Gigi can handle are the
+      --  following:
 
       --    Conversions with no change of representation or type
 
-      --    Numeric conversions involving integer values, floating-point
-      --    values, and fixed-point values. Fixed-point values are allowed
-      --    only if Conversion_OK is set, i.e. if the fixed-point values
-      --    are to be treated as integers.
+      --    Numeric conversions involving integer, floating- and fixed-point
+      --    values. Fixed-point values are allowed only if Conversion_OK is
+      --    set, i.e. if the fixed-point values are to be treated as integers.
 
       --  No other conversions should be passed to Gigi
 
       --  Check: are these rules stated in sinfo??? if so, why restate here???
 
-      --  The only remaining step is to generate a range check if we still
-      --  have a type conversion at this stage and Do_Range_Check is set.
-      --  For now we do this only for conversions of discrete types.
+      --  The only remaining step is to generate a range check if we still have
+      --  a type conversion at this stage and Do_Range_Check is set. For now we
+      --  do this only for conversions of discrete types.
 
       if Nkind (N) = N_Type_Conversion
         and then Is_Discrete_Type (Etype (N))
@@ -7904,9 +7891,9 @@ package body Exp_Ch4 is
             then
                Set_Do_Range_Check (Expr, False);
 
-               --  Before we do a range check, we have to deal with treating
-               --  a fixed-point operand as an integer. The way we do this
-               --  is simply to do an unchecked conversion to an appropriate
+               --  Before we do a range check, we have to deal with treating a
+               --  fixed-point operand as an integer. The way we do this is
+               --  simply to do an unchecked conversion to an appropriate
                --  integer type large enough to hold the result.
 
                --  This code is not active yet, because we are only dealing
@@ -7927,8 +7914,8 @@ package body Exp_Ch4 is
                end if;
 
                --  Reset overflow flag, since the range check will include
-               --  dealing with possible overflow, and generate the check
-               --  If Address is either source or target type, suppress
+               --  dealing with possible overflow, and generate the check If
+               --  Address is either a source type or target type, suppress
                --  range check to avoid typing anomalies when it is a visible
                --  integer type.
 
@@ -7975,8 +7962,8 @@ package body Exp_Ch4 is
    -- Expand_N_Unchecked_Type_Conversion --
    ----------------------------------------
 
-   --  If this cannot be handled by Gigi and we haven't already made
-   --  a temporary for it, do it now.
+   --  If this cannot be handled by Gigi and we haven't already made a
+   --  temporary for it, do it now.
 
    procedure Expand_N_Unchecked_Type_Conversion (N : Node_Id) is
       Target_Type  : constant Entity_Id := Etype (N);
@@ -8019,9 +8006,9 @@ package body Exp_Ch4 is
             then
                Rewrite (N, Make_Integer_Literal (Sloc (N), Val));
 
-               --  If Address is the target type, just set the type
-               --  to avoid a spurious type error on the literal when
-               --  Address is a visible integer type.
+               --  If Address is the target type, just set the type to avoid a
+               --  spurious type error on the literal when Address is a visible
+               --  integer type.
 
                if Is_Descendent_Of_Address (Target_Type) then
                   Set_Etype (N, Target_Type);
@@ -8425,11 +8412,11 @@ package body Exp_Ch4 is
 
              New_Reference_To (Pool, Loc),
 
-            --  Storage_Address. We use the attribute Pool_Address,
-            --  which uses the pointer itself to find the address of
-            --  the object, and which handles unconstrained arrays
-            --  properly by computing the address of the template.
-            --  i.e. the correct address of the corresponding allocation.
+            --  Storage_Address. We use the attribute Pool_Address, which uses
+            --  the pointer itself to find the address of the object, and which
+            --  handles unconstrained arrays properly by computing the address
+            --  of the template. i.e. the correct address of the corresponding
+            --  allocation.
 
              Make_Attribute_Reference (Loc,
                Prefix         => Duplicate_Subexpr_Move_Checks (N),
@@ -8722,8 +8709,8 @@ package body Exp_Ch4 is
    -- Make_Boolean_Array_Op --
    ---------------------------
 
-   --  For logical operations on boolean arrays, expand in line the
-   --  following, replacing 'and' with 'or' or 'xor' where needed:
+   --  For logical operations on boolean arrays, expand in line the following,
+   --  replacing 'and' with 'or' or 'xor' where needed:
 
    --    function Annn (A : typ; B: typ) return typ is
    --       C : typ;
@@ -9002,9 +8989,8 @@ package body Exp_Ch4 is
       --  Start of processing for Is_Safe_In_Place_Array_Op
 
    begin
-      --  We skip this processing if the component size is not the
-      --  same as a system storage unit (since at least for NOT
-      --  this would cause problems).
+      --  Skip this processing if the component size is different from system
+      --  storage unit (since at least for NOT this would cause problems).
 
       if Component_Size (Etype (Lhs)) /= System_Storage_Unit then
          return False;
@@ -9034,15 +9020,15 @@ package body Exp_Ch4 is
    -- Tagged_Membership --
    -----------------------
 
-   --  There are two different cases to consider depending on whether
-   --  the right operand is a class-wide type or not. If not we just
-   --  compare the actual tag of the left expr to the target type tag:
+   --  There are two different cases to consider depending on whether the right
+   --  operand is a class-wide type or not. If not we just compare the actual
+   --  tag of the left expr to the target type tag:
    --
    --     Left_Expr.Tag = Right_Type'Tag;
    --
-   --  If it is a class-wide type we use the RT function CW_Membership which
-   --  is usually implemented by looking in the ancestor tables contained in
-   --  the dispatch table pointed by Left_Expr.Tag for Typ'Tag
+   --  If it is a class-wide type we use the RT function CW_Membership which is
+   --  usually implemented by looking in the ancestor tables contained in the
+   --  dispatch table pointed by Left_Expr.Tag for Typ'Tag
 
    --  Ada 2005 (AI-251): If it is a class-wide interface type we use the RT
    --  function IW_Membership which is usually implemented by looking in the

gcc/ada/sem_intr.adb

@@ -418,9 +418,7 @@ package body Sem_Intr is
              Ptyp1, N);
          return;
 
-      elsif Is_Modular_Integer_Type (Typ1)
-        and then Non_Binary_Modulus (Typ1)
-      then
+      elsif Non_Binary_Modulus (Typ1) then
          Errint
            ("shifts not allowed for non-binary modular types",
             Ptyp1, N);