From 7882673f4c6036951fbaea9bb23975f250587c01 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 5 Aug 2011 14:09:33 +0000 Subject: [PATCH] a-fihema.ads, [...] (Finalization_Collection): Avoid heap allocation for Objects component. 2011-08-05 Bob Duff * a-fihema.ads, a-fihema.adb (Finalization_Collection): Avoid heap allocation for Objects component. This simplifies the code somewhat. It is also a little more efficient in the not-so-unusual case where there are no controlled objects allocated. Make Finalization_Started flag atomic. (Finalize): Avoid unnecessary detachment of items from the list. (pcol): Minor cleanup. From-SVN: r177439 --- gcc/ada/ChangeLog | 10 ++++ gcc/ada/a-fihema.adb | 114 +++++++++---------------------------------- gcc/ada/a-fihema.ads | 15 ++++-- 3 files changed, 43 insertions(+), 96 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index da95e8c5a48..162a81135d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-05 Bob Duff + + * a-fihema.ads, a-fihema.adb (Finalization_Collection): Avoid heap + allocation for Objects component. This simplifies the code somewhat. It + is also a little more efficient in the not-so-unusual case where there + are no controlled objects allocated. + Make Finalization_Started flag atomic. + (Finalize): Avoid unnecessary detachment of items from the list. + (pcol): Minor cleanup. + 2011-08-05 Ed Schonberg * sem_ch12.adb (Analyze_Formal_Package_Declaration): reject a formal diff --git a/gcc/ada/a-fihema.adb b/gcc/ada/a-fihema.adb index 9faa9a1b831..0b1fc7a695d 100644 --- a/gcc/ada/a-fihema.adb +++ b/gcc/ada/a-fihema.adb @@ -31,7 +31,6 @@ with Ada.Exceptions; use Ada.Exceptions; with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; with System; use System; with System.Address_Image; @@ -60,8 +59,6 @@ package body Ada.Finalization.Heap_Management is procedure Detach (N : Node_Ptr); -- Unhook a node from an arbitrary list - procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Ptr); - --------------------------- -- Add_Offset_To_Address -- --------------------------- @@ -117,7 +114,7 @@ package body Ada.Finalization.Heap_Management is -- top of the allocated bits into a list header. N_Ptr := Address_To_Node_Ptr (N_Addr); - Attach (N_Ptr, Collection.Objects); + Attach (N_Ptr, Collection.Objects'Unchecked_Access); -- Move the address from Prev to the start of the object. This -- operation effectively hides the list header. @@ -251,54 +248,10 @@ package body Ada.Finalization.Heap_Management is overriding procedure Finalize (Collection : in out Finalization_Collection) is - function Head (L : Node_Ptr) return Node_Ptr; - -- Return the node that comes after the dummy head - - function Is_Dummy_Head (N : Node_Ptr) return Boolean; - -- Determine whether a node acts as a dummy head. Such nodes do not - -- have an actual "object" attached to them and point to themselves. - - function Is_Empty_List (L : Node_Ptr) return Boolean; - -- Determine whether a list is empty - function Node_Ptr_To_Address (N : Node_Ptr) return Address; -- Not the reverse of Address_To_Node_Ptr. Return the address of the -- object following the list header. - ---------- - -- Head -- - ---------- - - function Head (L : Node_Ptr) return Node_Ptr is - begin - return L.Next; - end Head; - - ------------------- - -- Is_Dummy_Head -- - ------------------- - - function Is_Dummy_Head (N : Node_Ptr) return Boolean is - begin - -- To be a dummy head, the node must point to itself in both - -- directions. - - return - N.Next /= null - and then N.Next = N - and then N.Prev /= null - and then N.Prev = N; - end Is_Dummy_Head; - - ------------------- - -- Is_Empty_List -- - ------------------- - - function Is_Empty_List (L : Node_Ptr) return Boolean is - begin - return L = null or else Is_Dummy_Head (L); - end Is_Empty_List; - ------------------------- -- Node_Ptr_To_Address -- ------------------------- @@ -308,9 +261,8 @@ package body Ada.Finalization.Heap_Management is return N.all'Address + Header_Offset; end Node_Ptr_To_Address; - Curr_Ptr : Node_Ptr; + Curr_Ptr : Node_Ptr := Collection.Objects.Next; -- skip dummy head Ex_Occur : Exception_Occurrence; - Next_Ptr : Node_Ptr; Raised : Boolean := False; -- Start of processing for Finalize @@ -323,28 +275,11 @@ package body Ada.Finalization.Heap_Management is Collection.Finalization_Started := True; - while not Is_Empty_List (Collection.Objects) loop - - -- Find the real head of the collection, skipping the dummy head - - Curr_Ptr := Head (Collection.Objects); - - -- If the dummy head is the only remaining node, all real objects - -- have already been detached and finalized. - - if Is_Dummy_Head (Curr_Ptr) then - exit; - end if; - - -- Store the next node now since the detachment will destroy the - -- reference to it. - - Next_Ptr := Curr_Ptr.Next; - - -- Remove the current node from the list - - Detach (Curr_Ptr); + -- Go through the Objects list, and finalize each one. There is no need + -- to detach items from the list, because the whole collection is about + -- to go away. + while Curr_Ptr /= Collection.Objects'Unchecked_Access loop -- ??? Kludge: Don't do anything until the proper place to set -- primitive Finalize_Address has been determined. @@ -361,13 +296,9 @@ package body Ada.Finalization.Heap_Management is end; end if; - Curr_Ptr := Next_Ptr; + Curr_Ptr := Curr_Ptr.Next; end loop; - -- Deallocate the dummy head - - Free (Collection.Objects); - -- If the finalization of a particular node raised an exception, reraise -- it after the remainder of the list has been finalized. @@ -384,12 +315,10 @@ package body Ada.Finalization.Heap_Management is (Collection : in out Finalization_Collection) is begin - Collection.Objects := new Node; - -- The dummy head must point to itself in both directions - Collection.Objects.Next := Collection.Objects; - Collection.Objects.Prev := Collection.Objects; + Collection.Objects.Next := Collection.Objects'Unchecked_Access; + Collection.Objects.Prev := Collection.Objects'Unchecked_Access; end Initialize; ---------- @@ -397,6 +326,10 @@ package body Ada.Finalization.Heap_Management is ---------- procedure pcol (Collection : Finalization_Collection) is + Head : constant Node_Ptr := Collection.Objects'Unrestricted_Access; + -- "Unrestricted", because we're evilly getting access-to-variable of a + -- constant! OK for debugging code. + Head_Seen : Boolean := False; N_Ptr : Node_Ptr; @@ -447,21 +380,18 @@ package body Ada.Finalization.Heap_Management is -- - points to -- (dummy head) - present if dummy head - N_Ptr := Collection.Objects; + N_Ptr := Head; - while N_Ptr /= null loop + while N_Ptr /= null loop -- Should never be null; we being defensive Put_Line ("V"); - -- The current node is the head. If we have already traversed the - -- chain, the head will be encountered again since the chain is - -- circular. + -- We see the head initially; we want to exit when we see the head a + -- SECOND time. + + if N_Ptr = Head then + exit when Head_Seen; - if N_Ptr = Collection.Objects then - if Head_Seen then - exit; - else - Head_Seen := True; - end if; + Head_Seen := True; end if; -- The current element is null. This should never happen since the @@ -488,7 +418,7 @@ package body Ada.Finalization.Heap_Management is -- Detect the dummy head - if N_Ptr = Collection.Objects then + if N_Ptr = Head then Put_Line (" (dummy head)"); else Put_Line (""); diff --git a/gcc/ada/a-fihema.ads b/gcc/ada/a-fihema.ads index c5273c35b64..7e492ad8007 100644 --- a/gcc/ada/a-fihema.ads +++ b/gcc/ada/a-fihema.ads @@ -93,11 +93,11 @@ package Ada.Finalization.Heap_Management is overriding procedure Finalize (Collection : in out Finalization_Collection); -- Traverse the objects of Collection, invoking Finalize_Address on each of - -- them. In the end, the routine destroys its dummy head and tail. + -- them. overriding procedure Initialize (Collection : in out Finalization_Collection); - -- Create a new Collection by allocating a dummy head and tail + -- Initialize the finalization list to empty procedure Set_Finalize_Address_Ptr (Collection : in out Finalization_Collection; @@ -117,6 +117,11 @@ private pragma No_Strict_Aliasing (Node_Ptr); type Node is record + -- This should really be limited, but we can see the full view of + -- Limited_Controlled, which NOT limited. If it were limited, we could + -- default initialize here, and get rid of Initialize for + -- Finalization_Collection. + Prev : Node_Ptr; Next : Node_Ptr; end record; @@ -128,8 +133,10 @@ private -- All objects and node headers are allocated on this underlying pool; -- the collection is simply a wrapper around it. - Objects : Node_Ptr; - -- The head of a doubly linked list + Objects : aliased Node; + -- The head of a doubly linked list containing all allocated objects + -- with controlled parts that still exist (Unchecked_Deallocation has + -- not been done on them). Finalize_Address : Finalize_Address_Ptr; -- A reference to a routine that finalizes an object denoted by its -- 2.30.2