2011-11-20 Robert Dewar <dewar@adacore.com>

	* exp_ch6.adb, exp_util.adb: Minor reformatting

2011-11-20  Eric Botcazou  <ebotcazou@adacore.com>

	* sinfo.ads (Reference): Document that it is OK to set
	Is_Known_Non_Null on a temporary initialized to a N_Reference
	node.

2011-11-20  Matthew Heaney  <heaney@adacore.com>

	* a-cbdlli.adb, a-cfdlli.adb (Move): Set Last component to 0
	for Source list.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181530 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 129 insertions, 5 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 35a2096ca37..22f5712ceee 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2011-11-20  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch6.adb, exp_util.adb: Minor reformatting
+
+2011-11-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sinfo.ads (Reference): Document that it is OK to set
+	Is_Known_Non_Null on a temporary initialized to a N_Reference
+	node.
+
+2011-11-20  Matthew Heaney  <heaney@adacore.com>
+
+	* a-cbdlli.adb, a-cfdlli.adb (Move): Set Last component to 0
+	for Source list.
+
 2011-11-20  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* exp_ch6.adb (Make_Build_In_Place_Call_In_Assignment):
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index e1f7725d5cd..9e400715940 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -1164,18 +1164,67 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
            "attempt to tamper with cursors of Source (list is busy)";
       end if;
 
-      Clear (Target);
+      Clear (Target);  -- checks busy bit of Target
+
+      while Source.Length > 1 loop
+
+         pragma Assert (Source.First in 1 .. Source.Capacity);
+         pragma Assert (Source.Last /= Source.First);
+         pragma Assert (N (Source.First).Prev = 0);
+         pragma Assert (N (Source.Last).Next = 0);
+
+         --  Copy first element from Source to Target
 
-      while Source.Length > 0 loop
          X := Source.First;
          Append (Target, N (X).Element);
 
+         --  Unlink first node of Source
+
          Source.First := N (X).Next;
          N (Source.First).Prev := 0;
 
          Source.Length := Source.Length - 1;
+
+         --  The representation invariants for Source have been restored. It is
+         --  now safe to free the unlinked node, without fear of corrupting the
+         --  active links of Source.
+
+         --  Note that the algorithm we use here models similar algorithms used
+         --  in the unbounded form of the doubly-linked list container. In that
+         --  case, Free is an instantation of Unchecked_Deallocation, which can
+         --  fail (because PE will be raised if controlled Finalize fails), so
+         --  we must defer the call until the very last step. Here in the
+         --  bounded form, Free merely links the node we have just
+         --  "deallocated" onto a list of inactive nodes, so technically Free
+         --  cannot fail. However, for consistency, we handle Free the same way
+         --  here as we do for the unbounded form, with the pessimistic
+         --  assumption that it can fail.
+
          Free (Source, X);
       end loop;
+
+      if Source.Length = 1 then
+
+         pragma Assert (Source.First in 1 .. Source.Capacity);
+         pragma Assert (Source.Last = Source.First);
+         pragma Assert (N (Source.First).Prev = 0);
+         pragma Assert (N (Source.Last).Next = 0);
+
+         --  Copy element from Source to Target
+
+         X := Source.First;
+         Append (Target, N (X).Element);
+
+         --  Unlink node of Source
+
+         Source.First := 0;
+         Source.Last := 0;
+         Source.Length := 0;
+
+         --  Return the unlinked node to the free store
+
+         Free (Source, X);
+      end if;
    end Move;
 
    ----------
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index 93a88a725d6..d1bd218972d 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -1007,16 +1007,65 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is
 
       Clear (Target);
 
-      while Source.Length > 0 loop
+      while Source.Length > 1 loop
+
+         pragma Assert (Source.First in 1 .. Source.Capacity);
+         pragma Assert (Source.Last /= Source.First);
+         pragma Assert (N (Source.First).Prev = 0);
+         pragma Assert (N (Source.Last).Next = 0);
+
+         --  Copy first element from Source to Target
+
          X := Source.First;
          Append (Target, N (X).Element);  -- optimize away???
 
+         --  Unlink first node of Source
+
          Source.First := N (X).Next;
          N (Source.First).Prev := 0;
 
          Source.Length := Source.Length - 1;
+
+         --  The representation invariants for Source have been restored. It is
+         --  now safe to free the unlinked node, without fear of corrupting the
+         --  active links of Source.
+
+         --  Note that the algorithm we use here models similar algorithms used
+         --  in the unbounded form of the doubly-linked list container. In that
+         --  case, Free is an instantation of Unchecked_Deallocation, which can
+         --  fail (because PE will be raised if controlled Finalize fails), so
+         --  we must defer the call until the very last step. Here in the
+         --  bounded form, Free merely links the node we have just
+         --  "deallocated" onto a list of inactive nodes, so technically Free
+         --  cannot fail. However, for consistency, we handle Free the same way
+         --  here as we do for the unbounded form, with the pessimistic
+         --  assumption that it can fail.
+
          Free (Source, X);
       end loop;
+
+      if Source.Length = 1 then
+
+         pragma Assert (Source.First in 1 .. Source.Capacity);
+         pragma Assert (Source.Last = Source.First);
+         pragma Assert (N (Source.First).Prev = 0);
+         pragma Assert (N (Source.Last).Next = 0);
+
+         --  Copy element from Source to Target
+
+         X := Source.First;
+         Append (Target, N (X).Element);
+
+         --  Unlink node of Source
+
+         Source.First := 0;
+         Source.Last := 0;
+         Source.Length := 0;
+
+         --  Return the unlinked node to the free store
+
+         Free (Source, X);
+      end if;
    end Move;
 
    ----------
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f3d915de74a..227f72921be 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -8034,7 +8034,8 @@ package body Exp_Ch6 is
       Insert_After_And_Analyze (Assign, Ptr_Typ_Decl);
 
       --  Finally, create an access object initialized to a reference to the
-      --  function call.
+      --  function call. We know this access value is non-null, so mark the
+      --  entity accordingly to suppress junk access checks.
 
       New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
 
@@ -8299,7 +8300,8 @@ package body Exp_Ch6 is
       end if;
 
       --  Finally, create an access object initialized to a reference to the
-      --  function call.
+      --  function call. We know this access value cannot be null, so mark the
+      --  entity accordingly to suppress the access check.
 
       New_Expr := Make_Reference (Loc, Relocate_Node (Func_Call));
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 56a6f20ed19..37a1be0e478 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6710,6 +6710,10 @@ package body Exp_Util is
 
             if Alfa_Mode then
                New_Exp := E;
+
+            --  Otherwise generate reference, marking the value as non-null
+            --  since we know it cannot be null and we don't want a check.
+
             else
                New_Exp := Make_Reference (Loc, E);
                Set_Is_Known_Non_Null (Def_Id);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 35a73f9ad94..3379faef038 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -7310,6 +7310,11 @@ package Sinfo is
       --  more sense to call it an Expression field, but then we would have to
       --  special case the treatment of the N_Reference node.
 
+      --  Note: evaluating a N_Reference node is guaranteed to yield a non-null
+      --  value at run time. Therefore, it is valid to set Is_Known_Non_Null on
+      --  a temporary initialized to a N_Reference node in order to eliminate
+      --  superfluous access checks.
+
       --  Sprint syntax: prefix'reference
 
       --  N_Reference