Subversion Repositories openrisc_me

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              E X P _ C H 5                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Checks;   use Checks;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Elists;   use Elists;

with Exp_Atag; use Exp_Atag;

with Exp_Aggr; use Exp_Aggr;

with Exp_Ch6;  use Exp_Ch6;

with Exp_Ch7;  use Exp_Ch7;

with Exp_Ch11; use Exp_Ch11;

with Exp_Dbug; use Exp_Dbug;

with Exp_Pakd; use Exp_Pakd;

with Exp_Tss;  use Exp_Tss;

with Exp_Util; use Exp_Util;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Restrict; use Restrict;

with Rident;   use Rident;

with Rtsfind;  use Rtsfind;

with Sinfo;    use Sinfo;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Ch13; use Sem_Ch13;

with Sem_Eval; use Sem_Eval;

with Sem_Res;  use Sem_Res;

with Sem_Util; use Sem_Util;

with Snames;   use Snames;

with Stand;    use Stand;

with Stringt;  use Stringt;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Ttypes;   use Ttypes;

with Uintp;    use Uintp;

with Validsw;  use Validsw;

package body Exp_Ch5 is

   function Change_Of_Representation (N : Node_Id) return Boolean;

   --  Determine if the right hand side of the assignment N is a type

   --  conversion which requires a change of representation. Called

   --  only for the array and record cases.

   procedure Expand_Assign_Array (N : Node_Id; Rhs : Node_Id);

   --  N is an assignment which assigns an array value. This routine process

   --  the various special cases and checks required for such assignments,

   --  including change of representation. Rhs is normally simply the right

   --  hand side of the assignment, except that if the right hand side is

   --  a type conversion or a qualified expression, then the Rhs is the

   --  actual expression inside any such type conversions or qualifications.

   function Expand_Assign_Array_Loop

     (N      : Node_Id;

      Larray : Entity_Id;

      Rarray : Entity_Id;

      L_Type : Entity_Id;

      R_Type : Entity_Id;

      Ndim   : Pos;

      Rev    : Boolean) return Node_Id;

   --  N is an assignment statement which assigns an array value. This routine

   --  expands the assignment into a loop (or nested loops for the case of a

   --  multi-dimensional array) to do the assignment component by component.

   --  Larray and Rarray are the entities of the actual arrays on the left

   --  hand and right hand sides. L_Type and R_Type are the types of these

   --  arrays (which may not be the same, due to either sliding, or to a

   --  change of representation case). Ndim is the number of dimensions and

   --  the parameter Rev indicates if the loops run normally (Rev = False),

   --  or reversed (Rev = True). The value returned is the constructed

   --  loop statement. Auxiliary declarations are inserted before node N

   --  using the standard Insert_Actions mechanism.

   procedure Expand_Assign_Record (N : Node_Id);

   --  N is an assignment of a non-tagged record value. This routine handles

   --  the case where the assignment must be made component by component,

   --  either because the target is not byte aligned, or there is a change

   --  of representation, or when we have a tagged type with a representation

   --  clause (this last case is required because holes in the tagged type

   --  might be filled with components from child types).

   procedure Expand_Non_Function_Return (N : Node_Id);

   --  Called by Expand_N_Simple_Return_Statement in case we're returning from

   --  a procedure body, entry body, accept statement, or extended return

   --  statement.  Note that all non-function returns are simple return

   --  statements.

   procedure Expand_Simple_Function_Return (N : Node_Id);

   --  Expand simple return from function. In the case where we are returning

   --  from a function body this is called by Expand_N_Simple_Return_Statement.

   function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;

   --  Generate the necessary code for controlled and tagged assignment, that

   --  is to say, finalization of the target before, adjustment of the target

   --  after and save and restore of the tag and finalization pointers which

   --  are not 'part of the value' and must not be changed upon assignment. N

   --  is the original Assignment node.

   ------------------------------

   -- Change_Of_Representation --

   ------------------------------

   function Change_Of_Representation (N : Node_Id) return Boolean is

      Rhs : constant Node_Id := Expression (N);

   begin

      return

        Nkind (Rhs) = N_Type_Conversion

          and then

            not Same_Representation (Etype (Rhs), Etype (Expression (Rhs)));

   end Change_Of_Representation;

   -------------------------

   -- Expand_Assign_Array --

   -------------------------

   --  There are two issues here. First, do we let Gigi do a block move, or

   --  do we expand out into a loop? Second, we need to set the two flags

   --  Forwards_OK and Backwards_OK which show whether the block move (or

   --  corresponding loops) can be legitimately done in a forwards (low to

   --  high) or backwards (high to low) manner.

   procedure Expand_Assign_Array (N : Node_Id; Rhs : Node_Id) is

      Loc : constant Source_Ptr := Sloc (N);

      Lhs : constant Node_Id := Name (N);

      Act_Lhs : constant Node_Id := Get_Referenced_Object (Lhs);

      Act_Rhs : Node_Id          := Get_Referenced_Object (Rhs);

      L_Type : constant Entity_Id :=

                 Underlying_Type (Get_Actual_Subtype (Act_Lhs));

      R_Type : Entity_Id :=

                 Underlying_Type (Get_Actual_Subtype (Act_Rhs));

      L_Slice : constant Boolean := Nkind (Act_Lhs) = N_Slice;

      R_Slice : constant Boolean := Nkind (Act_Rhs) = N_Slice;

      Crep : constant Boolean := Change_Of_Representation (N);

      Larray  : Node_Id;

      Rarray  : Node_Id;

      Ndim : constant Pos := Number_Dimensions (L_Type);

      Loop_Required : Boolean := False;

      --  This switch is set to True if the array move must be done using

      --  an explicit front end generated loop.

      procedure Apply_Dereference (Arg : Node_Id);

      --  If the argument is an access to an array, and the assignment is

      --  converted into a procedure call, apply explicit dereference.

      function Has_Address_Clause (Exp : Node_Id) return Boolean;

      --  Test if Exp is a reference to an array whose declaration has

      --  an address clause, or it is a slice of such an array.

      function Is_Formal_Array (Exp : Node_Id) return Boolean;

      --  Test if Exp is a reference to an array which is either a formal

      --  parameter or a slice of a formal parameter. These are the cases

      --  where hidden aliasing can occur.

      function Is_Non_Local_Array (Exp : Node_Id) return Boolean;

      --  Determine if Exp is a reference to an array variable which is other

      --  than an object defined in the current scope, or a slice of such

      --  an object. Such objects can be aliased to parameters (unlike local

      --  array references).

      -----------------------

      -- Apply_Dereference --

      -----------------------

      procedure Apply_Dereference (Arg : Node_Id) is

         Typ : constant Entity_Id := Etype (Arg);

      begin

         if Is_Access_Type (Typ) then

            Rewrite (Arg, Make_Explicit_Dereference (Loc,

              Prefix => Relocate_Node (Arg)));

            Analyze_And_Resolve (Arg, Designated_Type (Typ));

         end if;

      end Apply_Dereference;

      ------------------------

      -- Has_Address_Clause --

      ------------------------

      function Has_Address_Clause (Exp : Node_Id) return Boolean is

      begin

         return

           (Is_Entity_Name (Exp) and then

                              Present (Address_Clause (Entity (Exp))))

             or else

           (Nkind (Exp) = N_Slice and then Has_Address_Clause (Prefix (Exp)));

      end Has_Address_Clause;

      ---------------------

      -- Is_Formal_Array --

      ---------------------

      function Is_Formal_Array (Exp : Node_Id) return Boolean is

      begin

         return

           (Is_Entity_Name (Exp) and then Is_Formal (Entity (Exp)))

             or else

           (Nkind (Exp) = N_Slice and then Is_Formal_Array (Prefix (Exp)));

      end Is_Formal_Array;

      ------------------------

      -- Is_Non_Local_Array --

      ------------------------

      function Is_Non_Local_Array (Exp : Node_Id) return Boolean is

      begin

         return (Is_Entity_Name (Exp)

                   and then Scope (Entity (Exp)) /= Current_Scope)

            or else (Nkind (Exp) = N_Slice

                       and then Is_Non_Local_Array (Prefix (Exp)));

      end Is_Non_Local_Array;

      --  Determine if Lhs, Rhs are formal arrays or nonlocal arrays

      Lhs_Formal : constant Boolean := Is_Formal_Array (Act_Lhs);

      Rhs_Formal : constant Boolean := Is_Formal_Array (Act_Rhs);

      Lhs_Non_Local_Var : constant Boolean := Is_Non_Local_Array (Act_Lhs);

      Rhs_Non_Local_Var : constant Boolean := Is_Non_Local_Array (Act_Rhs);

   --  Start of processing for Expand_Assign_Array

   begin

      --  Deal with length check. Note that the length check is done with

      --  respect to the right hand side as given, not a possible underlying

      --  renamed object, since this would generate incorrect extra checks.

      Apply_Length_Check (Rhs, L_Type);

      --  We start by assuming that the move can be done in either direction,

      --  i.e. that the two sides are completely disjoint.

      Set_Forwards_OK  (N, True);

      Set_Backwards_OK (N, True);

      --  Normally it is only the slice case that can lead to overlap, and

      --  explicit checks for slices are made below. But there is one case

      --  where the slice can be implicit and invisible to us: when we have a

      --  one dimensional array, and either both operands are parameters, or

      --  one is a parameter (which can be a slice passed by reference) and the

      --  other is a non-local variable. In this case the parameter could be a

      --  slice that overlaps with the other operand.

      --  However, if the array subtype is a constrained first subtype in the

      --  parameter case, then we don't have to worry about overlap, since

      --  slice assignments aren't possible (other than for a slice denoting

      --  the whole array).

      --  Note: No overlap is possible if there is a change of representation,

      --  so we can exclude this case.

      if Ndim = 1

        and then not Crep

        and then

           ((Lhs_Formal and Rhs_Formal)

              or else

            (Lhs_Formal and Rhs_Non_Local_Var)

              or else

            (Rhs_Formal and Lhs_Non_Local_Var))

        and then

           (not Is_Constrained (Etype (Lhs))

             or else not Is_First_Subtype (Etype (Lhs)))

         --  In the case of compiling for the Java or .NET Virtual Machine,

         --  slices are always passed by making a copy, so we don't have to

         --  worry about overlap. We also want to prevent generation of "<"

         --  comparisons for array addresses, since that's a meaningless

         --  operation on the VM.

        and then VM_Target = No_VM

      then

         Set_Forwards_OK  (N, False);

         Set_Backwards_OK (N, False);

         --  Note: the bit-packed case is not worrisome here, since if we have

         --  a slice passed as a parameter, it is always aligned on a byte

         --  boundary, and if there are no explicit slices, the assignment

         --  can be performed directly.

      end if;

      --  If either operand has an address clause clear Backwards_OK and

      --  Forwards_OK, since we cannot tell if the operands overlap. We

      --  exclude this treatment when Rhs is an aggregate, since we know

      --  that overlap can't occur.

      if (Has_Address_Clause (Lhs) and then Nkind (Rhs) /= N_Aggregate)

        or else Has_Address_Clause (Rhs)

      then

         Set_Forwards_OK  (N, False);

         Set_Backwards_OK (N, False);

      end if;

      --  We certainly must use a loop for change of representation and also

      --  we use the operand of the conversion on the right hand side as the

      --  effective right hand side (the component types must match in this

      --  situation).

      if Crep then

         Act_Rhs := Get_Referenced_Object (Rhs);

         R_Type  := Get_Actual_Subtype (Act_Rhs);

         Loop_Required := True;

      --  We require a loop if the left side is possibly bit unaligned

      elsif Possible_Bit_Aligned_Component (Lhs)

              or else

            Possible_Bit_Aligned_Component (Rhs)

      then

         Loop_Required := True;

      --  Arrays with controlled components are expanded into a loop to force

      --  calls to Adjust at the component level.

      elsif Has_Controlled_Component (L_Type) then

         Loop_Required := True;

         --  If object is atomic, we cannot tolerate a loop

      elsif Is_Atomic_Object (Act_Lhs)

              or else

            Is_Atomic_Object (Act_Rhs)

      then

         return;

      --  Loop is required if we have atomic components since we have to

      --  be sure to do any accesses on an element by element basis.

      elsif Has_Atomic_Components (L_Type)

        or else Has_Atomic_Components (R_Type)

        or else Is_Atomic (Component_Type (L_Type))

        or else Is_Atomic (Component_Type (R_Type))

      then

         Loop_Required := True;

      --  Case where no slice is involved

      elsif not L_Slice and not R_Slice then

         --  The following code deals with the case of unconstrained bit packed

         --  arrays. The problem is that the template for such arrays contains

         --  the bounds of the actual source level array, but the copy of an

         --  entire array requires the bounds of the underlying array. It would

         --  be nice if the back end could take care of this, but right now it

         --  does not know how, so if we have such a type, then we expand out

         --  into a loop, which is inefficient but works correctly. If we don't

         --  do this, we get the wrong length computed for the array to be

         --  moved. The two cases we need to worry about are:

         --  Explicit dereference of an unconstrained packed array type as in

         --  the following example:

         --    procedure C52 is

         --       type BITS is array(INTEGER range <>) of BOOLEAN;

         --       pragma PACK(BITS);

         --       type A is access BITS;

         --       P1,P2 : A;

         --    begin

         --       P1 := new BITS (1 .. 65_535);

         --       P2 := new BITS (1 .. 65_535);

         --       P2.ALL := P1.ALL;

         --    end C52;

         --  A formal parameter reference with an unconstrained bit array type

         --  is the other case we need to worry about (here we assume the same

         --  BITS type declared above):

         --    procedure Write_All (File : out BITS; Contents : BITS);

         --    begin

         --       File.Storage := Contents;

         --    end Write_All;

         --  We expand to a loop in either of these two cases

         --  Question for future thought. Another potentially more efficient

         --  approach would be to create the actual subtype, and then do an

         --  unchecked conversion to this actual subtype ???

         Check_Unconstrained_Bit_Packed_Array : declare

            function Is_UBPA_Reference (Opnd : Node_Id) return Boolean;

            --  Function to perform required test for the first case, above

            --  (dereference of an unconstrained bit packed array).

            -----------------------

            -- Is_UBPA_Reference --

            -----------------------

            function Is_UBPA_Reference (Opnd : Node_Id) return Boolean is

               Typ      : constant Entity_Id := Underlying_Type (Etype (Opnd));

               P_Type   : Entity_Id;

               Des_Type : Entity_Id;

            begin

               if Present (Packed_Array_Type (Typ))

                 and then Is_Array_Type (Packed_Array_Type (Typ))

                 and then not Is_Constrained (Packed_Array_Type (Typ))

               then

                  return True;

               elsif Nkind (Opnd) = N_Explicit_Dereference then

                  P_Type := Underlying_Type (Etype (Prefix (Opnd)));

                  if not Is_Access_Type (P_Type) then

                     return False;

                  else

                     Des_Type := Designated_Type (P_Type);

                     return

                       Is_Bit_Packed_Array (Des_Type)

                         and then not Is_Constrained (Des_Type);

                  end if;

               else

                  return False;

               end if;

            end Is_UBPA_Reference;

         --  Start of processing for Check_Unconstrained_Bit_Packed_Array

         begin

            if Is_UBPA_Reference (Lhs)

                 or else

               Is_UBPA_Reference (Rhs)

            then

               Loop_Required := True;

            --  Here if we do not have the case of a reference to a bit packed

            --  unconstrained array case. In this case gigi can most certainly

            --  handle the assignment if a forwards move is allowed.

            --  (could it handle the backwards case also???)

            elsif Forwards_OK (N) then

               return;

            end if;

         end Check_Unconstrained_Bit_Packed_Array;

      --  The back end can always handle the assignment if the right side is a

      --  string literal (note that overlap is definitely impossible in this

      --  case). If the type is packed, a string literal is always converted

      --  into an aggregate, except in the case of a null slice, for which no

      --  aggregate can be written. In that case, rewrite the assignment as a

      --  null statement, a length check has already been emitted to verify

      --  that the range of the left-hand side is empty.

      --  Note that this code is not executed if we have an assignment of a

      --  string literal to a non-bit aligned component of a record, a case

      --  which cannot be handled by the backend.

      elsif Nkind (Rhs) = N_String_Literal then

         if String_Length (Strval (Rhs)) = 0

           and then Is_Bit_Packed_Array (L_Type)

         then

            Rewrite (N, Make_Null_Statement (Loc));

            Analyze (N);

         end if;

         return;

      --  If either operand is bit packed, then we need a loop, since we can't

      --  be sure that the slice is byte aligned. Similarly, if either operand

      --  is a possibly unaligned slice, then we need a loop (since the back

      --  end cannot handle unaligned slices).

      elsif Is_Bit_Packed_Array (L_Type)

        or else Is_Bit_Packed_Array (R_Type)

        or else Is_Possibly_Unaligned_Slice (Lhs)

        or else Is_Possibly_Unaligned_Slice (Rhs)

      then

         Loop_Required := True;

      --  If we are not bit-packed, and we have only one slice, then no overlap

      --  is possible except in the parameter case, so we can let the back end

      --  handle things.

      elsif not (L_Slice and R_Slice) then

         if Forwards_OK (N) then

            return;

         end if;

      end if;

      --  If the right-hand side is a string literal, introduce a temporary for

      --  it, for use in the generated loop that will follow.

      if Nkind (Rhs) = N_String_Literal then

         declare

            Temp : constant Entity_Id :=

                     Make_Defining_Identifier (Loc, New_Internal_Name ('T'));

            Decl : Node_Id;

         begin

            Decl :=

              Make_Object_Declaration (Loc,

                 Defining_Identifier => Temp,

                 Object_Definition => New_Occurrence_Of (L_Type, Loc),

                 Expression => Relocate_Node (Rhs));

            Insert_Action (N, Decl);

            Rewrite (Rhs, New_Occurrence_Of (Temp, Loc));

            R_Type := Etype (Temp);

         end;

      end if;

      --  Come here to complete the analysis

      --    Loop_Required: Set to True if we know that a loop is required

      --                   regardless of overlap considerations.

      --    Forwards_OK:   Set to False if we already know that a forwards

      --                   move is not safe, else set to True.

      --    Backwards_OK:  Set to False if we already know that a backwards

      --                   move is not safe, else set to True

      --  Our task at this stage is to complete the overlap analysis, which can

      --  result in possibly setting Forwards_OK or Backwards_OK to False, and

      --  then generating the final code, either by deciding that it is OK

      --  after all to let Gigi handle it, or by generating appropriate code

      --  in the front end.

      declare

         L_Index_Typ : constant Node_Id := Etype (First_Index (L_Type));

         R_Index_Typ : constant Node_Id := Etype (First_Index (R_Type));

         Left_Lo  : constant Node_Id := Type_Low_Bound  (L_Index_Typ);

         Left_Hi  : constant Node_Id := Type_High_Bound (L_Index_Typ);

         Right_Lo : constant Node_Id := Type_Low_Bound  (R_Index_Typ);

         Right_Hi : constant Node_Id := Type_High_Bound (R_Index_Typ);

         Act_L_Array : Node_Id;

         Act_R_Array : Node_Id;

         Cleft_Lo  : Node_Id;

         Cright_Lo : Node_Id;

         Condition : Node_Id;

         Cresult : Compare_Result;

      begin

         --  Get the expressions for the arrays. If we are dealing with a

         --  private type, then convert to the underlying type. We can do

         --  direct assignments to an array that is a private type, but we

         --  cannot assign to elements of the array without this extra

         --  unchecked conversion.

         if Nkind (Act_Lhs) = N_Slice then

            Larray := Prefix (Act_Lhs);

         else

            Larray := Act_Lhs;

            if Is_Private_Type (Etype (Larray)) then

               Larray :=

                 Unchecked_Convert_To

                   (Underlying_Type (Etype (Larray)), Larray);

            end if;

         end if;

         if Nkind (Act_Rhs) = N_Slice then

            Rarray := Prefix (Act_Rhs);

         else

            Rarray := Act_Rhs;

            if Is_Private_Type (Etype (Rarray)) then

               Rarray :=

                 Unchecked_Convert_To

                   (Underlying_Type (Etype (Rarray)), Rarray);

            end if;

         end if;

         --  If both sides are slices, we must figure out whether it is safe

         --  to do the move in one direction or the other. It is always safe

         --  if there is a change of representation since obviously two arrays

         --  with different representations cannot possibly overlap.

         if (not Crep) and L_Slice and R_Slice then

            Act_L_Array := Get_Referenced_Object (Prefix (Act_Lhs));

            Act_R_Array := Get_Referenced_Object (Prefix (Act_Rhs));

            --  If both left and right hand arrays are entity names, and refer

            --  to different entities, then we know that the move is safe (the

            --  two storage areas are completely disjoint).

            if Is_Entity_Name (Act_L_Array)

              and then Is_Entity_Name (Act_R_Array)

              and then Entity (Act_L_Array) /= Entity (Act_R_Array)

            then

               null;

            --  Otherwise, we assume the worst, which is that the two arrays

            --  are the same array. There is no need to check if we know that

            --  is the case, because if we don't know it, we still have to

            --  assume it!

            --  Generally if the same array is involved, then we have an

            --  overlapping case. We will have to really assume the worst (i.e.

            --  set neither of the OK flags) unless we can determine the lower

            --  or upper bounds at compile time and compare them.

            else

               Cresult :=

                 Compile_Time_Compare

                   (Left_Lo, Right_Lo, Assume_Valid => True);

               if Cresult = Unknown then

                  Cresult :=

                    Compile_Time_Compare

                      (Left_Hi, Right_Hi, Assume_Valid => True);

               end if;

               case Cresult is

                  when LT | LE | EQ => Set_Backwards_OK (N, False);

                  when GT | GE      => Set_Forwards_OK  (N, False);

                  when NE | Unknown => Set_Backwards_OK (N, False);

                                       Set_Forwards_OK  (N, False);

               end case;

            end if;

         end if;

         --  If after that analysis Loop_Required is False, meaning that we

         --  have not discovered some non-overlap reason for requiring a loop,

         --  then the outcome depends on the capabilities of the back end.

         if not Loop_Required then

            --  The GCC back end can deal with all cases of overlap by falling

            --  back to memmove if it cannot use a more efficient approach.

            if VM_Target = No_VM and not AAMP_On_Target then

               return;

            --  Assume other back ends can handle it if Forwards_OK is set

            elsif Forwards_OK (N) then

               return;

            --  If Forwards_OK is not set, the back end will need something

            --  like memmove to handle the move. For now, this processing is

            --  activated using the .s debug flag (-gnatd.s).

            elsif Debug_Flag_Dot_S then

               return;

            end if;

         end if;

         --  At this stage we have to generate an explicit loop, and we have

         --  the following cases:

         --  Forwards_OK = True

         --    Rnn : right_index := right_index'First;

         --    for Lnn in left-index loop

         --       left (Lnn) := right (Rnn);

         --       Rnn := right_index'Succ (Rnn);

         --    end loop;

         --    Note: the above code MUST be analyzed with checks off, because

         --    otherwise the Succ could overflow. But in any case this is more

         --    efficient!

         --  Forwards_OK = False, Backwards_OK = True

         --    Rnn : right_index := right_index'Last;

         --    for Lnn in reverse left-index loop

         --       left (Lnn) := right (Rnn);

         --       Rnn := right_index'Pred (Rnn);

         --    end loop;

         --    Note: the above code MUST be analyzed with checks off, because

         --    otherwise the Pred could overflow. But in any case this is more

         --    efficient!

         --  Forwards_OK = Backwards_OK = False

         --    This only happens if we have the same array on each side. It is

         --    possible to create situations using overlays that violate this,

         --    but we simply do not promise to get this "right" in this case.

         --    There are two possible subcases. If the No_Implicit_Conditionals

         --    restriction is set, then we generate the following code:

         --      declare

         --        T : constant <operand-type> := rhs;

         --      begin

         --        lhs := T;

         --      end;

         --    If implicit conditionals are permitted, then we generate:

         --      if Left_Lo <= Right_Lo then

         --         <code for Forwards_OK = True above>

         --      else

         --         <code for Backwards_OK = True above>

         --      end if;

         --  In order to detect possible aliasing, we examine the renamed

         --  expression when the source or target is a renaming. However,

         --  the renaming may be intended to capture an address that may be

         --  affected by subsequent code, and therefore we must recover

         --  the actual entity for the expansion that follows, not the

         --  object it renames. In particular, if source or target designate

         --  a portion of a dynamically allocated object, the pointer to it

         --  may be reassigned but the renaming preserves the proper location.

         if Is_Entity_Name (Rhs)

           and then

             Nkind (Parent (Entity (Rhs))) = N_Object_Renaming_Declaration

           and then Nkind (Act_Rhs) = N_Slice

         then

            Rarray := Rhs;

         end if;

         if Is_Entity_Name (Lhs)

           and then

             Nkind (Parent (Entity (Lhs))) = N_Object_Renaming_Declaration

           and then Nkind (Act_Lhs) = N_Slice

         then

            Larray := Lhs;

         end if;

         --  Cases where either Forwards_OK or Backwards_OK is true

         if Forwards_OK (N) or else Backwards_OK (N) then

            if Needs_Finalization (Component_Type (L_Type))

              and then Base_Type (L_Type) = Base_Type (R_Type)

              and then Ndim = 1

              and then not No_Ctrl_Actions (N)

            then

               declare

                  Proc    : constant Entity_Id :=

                              TSS (Base_Type (L_Type), TSS_Slice_Assign);

                  Actuals : List_Id;

               begin

                  Apply_Dereference (Larray);

                  Apply_Dereference (Rarray);

                  Actuals := New_List (

                    Duplicate_Subexpr (Larray,   Name_Req => True),

                    Duplicate_Subexpr (Rarray,   Name_Req => True),

                    Duplicate_Subexpr (Left_Lo,  Name_Req => True),

                    Duplicate_Subexpr (Left_Hi,  Name_Req => True),

                    Duplicate_Subexpr (Right_Lo, Name_Req => True),

                    Duplicate_Subexpr (Right_Hi, Name_Req => True));

                  Append_To (Actuals,

                    New_Occurrence_Of (

                      Boolean_Literals (not Forwards_OK (N)), Loc));