with Unchecked_Deallocation; package body Linked_list is procedure Free_Space is new Unchecked_Deallocation (Member, Link); -- **************************************************************************** -- Functional Description : The procedure add member will add a member to -- the list provided. -- **************************************************************************** procedure Add_Member (X : in out list; A_Member : Element) is Y : Link; begin Y := new Member; -- allocate the new list element Y.Bod := A_Member; if X.Tail /= null then X.Tail.Chain := Y; -- list the tail pointer to the new element X.Tail := Y; else -- if tail was null, list this the tail to this -- element X.Head := Y; X.Tail := Y; X.Current_Position := Y; end if; X.Size := X.Size + 1; end Add_Member; -- **************************************************************************** -- Functional Description : This procedure takes a list and a member as input -- and returns a true if the member is present in the list and false otherwise. -- Current_position will be the member if it is present and null if not. -- **************************************************************************** procedure Is_Member (X : in out list; A_Member : Element; Answer : out Boolean) is begin X.Current_Position := X.Head; for I in 1 .. X.Size loop if X.Current_Position.Bod = A_Member then Answer := True; return; else X.Current_Position := X.Current_Position.Chain; end if; end loop; Answer := False; end Is_Member; -- **************************************************************************** -- Functional Description : This function returns the number of members in the -- list. -- **************************************************************************** function list_Size (X : in list) return Integer is begin return X.Size; end list_Size; -- **************************************************************************** -- Functional Description : This procedure will list the current position to -- the first member in the list. -- **************************************************************************** procedure Rewind (X : in out list) is begin X.Current_Position := X.Head; end Rewind; -- **************************************************************************** -- Functional Description : This procedure will move the current position -- pointer to the next member of the list and return the member it is -- pointing to. If the next member is null, then an 'empty member' is -- returned and current position is list to null. -- **************************************************************************** procedure Next_Member (X : in out list; A_Member : out Element; end_of_list : in out boolean) is begin end_of_list := false; if X.Current_Position /= null then X.Current_Position := X.Current_Position.Chain; if X.Current_Position /= null then A_Member := X.Current_Position.Bod; else end_of_list := true; end if; else end_of_list := true; end if; end Next_Member; -- **************************************************************************** -- Functional Description : Function to test whether or not the entire list has -- been iterated over or not. The function returns true if it has, and false -- otherwise. -- **************************************************************************** function Done (X : in list) return Boolean is begin if X.Tail = null or else X.Current_Position = X.Tail.Chain then return True; else return False; end if; end Done; -- **************************************************************************** -- Functional Description : This procedure will remove all members from the -- specified list. Note that memory is not reclaimed. -- **************************************************************************** procedure Make_Empty (X : in out list) is begin X.Size := 0; X.Current_Position := null; X.Head := null; X.Tail := null; end Make_Empty; -- **************************************************************************** -- Functional Description : This procedure returns the member currently pointed -- to by the current position pointer..if current position = null then this -- procedure returns null_member = true. -- **************************************************************************** procedure Current_Member (X : in list; A_Member : out Element; null_member : in out boolean) is begin null_member := false; if X.Current_Position /= null then A_Member := X.Current_Position.Bod; else null_member := true; end if; end Current_Member; -- **************************************************************************** -- Functional Description : The following procedure will release all memory -- held by each list member. The procedure iterates through the list and -- executes 'unchecked_deallocation' for each member. -- **************************************************************************** procedure Release (X : in out list) is Previous : Link; begin Rewind (X); Previous := X.Head; while X.Current_Position /= null loop X.Current_Position := X.Current_Position.Chain; -- move pointer to -- next member Free_Space (Previous); -- free the previous member Previous := X.Current_Position; end loop; end Release; end Linked_list;