diff options
-rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
-rw-r--r-- | gcc/ada/a-cbdlli.adb | 53 | ||||
-rw-r--r-- | gcc/ada/a-cfdlli.adb | 51 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 5 |
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 |