-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : generic package LINKED_LIST -- Version : 1.0 -- Author : Richard Conn -- : Texas Instruments -- : PO Box 801, Mail Stop 8007 -- : McKinney, TX 75069 -- DDN Address : RCONN@SIMTEL20 -- Copyright : (c) 1984 Richard Conn -- Date created : OCTOBER 2, 1984 -- Release date : NOVEMBER 29, 1984 -- Last update : CONN NOVEMBER 29, 1984 -- -* --------------------------------------------------------------- -- -* -- Keywords : DOUBLY-LINKED LIST ----------------: LIST MANIPULATION -- -- Abstract : This package provides a number of routines ----------------: which can be used to manipulate a doubly- ----------------: linked list. See the visible section for ----------------: a rather complete set of documentation on ----------------: the routines. ----------------: ----------------: Each element of the list is of the following ----------------: structure: ----------------: RECORD ----------------: contents: element_object; -- data ----------------: next: element_pointer; -- ptr ----------------: previous: element_pointer; -- ptr ----------------: END RECORD; ----------------: -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 11/29/84 1.0 Richard Conn Initial Release -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- -- Generic Package to Handle Doubly-Linked Lists -- by Richard Conn, TI Ada Technology Branch -- -- The purpose of this package is to provide a software component -- which can be generically instantiated to handle any type of -- doubly-linked list. The set of routines provided in this package -- are general-purpose in nature and manipulate the elements of a -- doubly-linked list without regard to their contents. Each element -- of the list is of the following structure: -- -- record -- content : element_object; -- the data in the list element -- next : element_pointer; -- pointer to the next element -- previous : element_pointer; -- pointer to the previous element -- end record; -- generic type element_object is private; package generic_list is -- -- The following type declarations are used throughout is package -- and are needed by the programs which WITH this package. -- type list_element; type element_pointer is access list_element; type list_element is record content : element_object; -- the generic object next : element_pointer; previous : element_pointer; end record; -- -- The following procedures and functions initialize the list and -- return pointers to the three list elements which are continuously -- tracked by the routines in this package. These list elements -- are: -- -- first_element the first element in the list -- last_element the last element in the list -- current_element the current element in the list -- procedure initialize_list; function return_first_element return element_pointer; function return_last_element return element_pointer; function return_current_element return element_pointer; function return_first_element return element_object; function return_last_element return element_object; function return_current_element return element_object; -- -- The following procedures and functions manipulate the current -- element pointer. The following table outlines their functions: -- -- set_first the first element becomes the current element -- set_last the last element becomes the current element -- current_index return the number of the current element -- (ordinal); 0 returned if list is empty -- current_next set current element to next element in the -- list; return TRUE if done or FALSE if -- already at end of list -- current_previous set current element to previous element in the -- list; return TRUE if done or FALSE if -- already at front of list -- set_current_index set the Nth element as the current element; -- return TRUE if done or FALSE if end of list -- encountered, in which case the last element -- becomes the current element -- procedure set_first; procedure set_last; function current_index return natural; function current_next return boolean; function current_previous return boolean; function set_current_index (index : natural) return boolean; -- -- The following functions return the index of the last element in -- the list and indicate if the list is empty or not. -- -- last_index return the number of the last element -- (ordinal); 0 returned if list is empty -- list_empty return TRUE if the list is empty; FALSE if -- the list is not empty -- at_end_of_list return TRUE if the current_element is also -- the last_element; return FALSE if not -- at_front_of_list return TRUE if the current_element is also -- the first_element; return FALSE if not -- function last_index return natural; function list_empty return boolean; function at_end_of_list return boolean; function at_front_of_list return boolean; -- -- The following procedures and functions are used to manipulate -- the elements in the list. -- -- append_element append the indicated element after the -- current_element in the list; the -- current_element is set to the new -- element -- insert_element insert the indicated element before the -- current_element in the list; the -- current_element is unchanged -- delete_element delete the current_element from the list; -- the next element is the new current_element -- unless there is no next element, in which -- case the previous element is the new -- current_element -- procedure append_element (element : element_pointer); procedure append_element (element : element_object); procedure insert_element (element : element_pointer); procedure insert_element (element : element_object); procedure delete_element; -- -- The following function and procedure are used to dynamically -- create new elements and to free the space occupied by unneeded -- elements. -- -- new_element returns a pointer to a new list_element -- free_element frees the indicated list_element -- function new_element return element_pointer; procedure free_element (element : element_pointer); end generic_list; -- -- BODY of generic_list -- package body generic_list is -- -- Definition of the three element pointers -- first_element, last_element, current_element : element_pointer; -- -- Procedure to initialize the list -- All element pointers are initialized to null -- procedure initialize_list is begin first_element := null; last_element := null; current_element := null; end initialize_list; -- -- Functions to return element pointers -- function return_first_element return element_pointer is begin return first_element; end return_first_element; function return_first_element return element_object is begin return first_element.content; end return_first_element; function return_last_element return element_pointer is begin return last_element; end return_last_element; function return_last_element return element_object is begin return last_element.content; end return_last_element; function return_current_element return element_pointer is begin return current_element; end return_current_element; function return_current_element return element_object is begin return current_element.content; end return_current_element; -- -- Current element pointer manipulation -- procedure set_first is begin current_element := first_element; end set_first; procedure set_last is begin current_element := last_element; end set_last; function current_index return natural is local_element : element_pointer; index : natural; begin index := 0; -- initialize counter and set empty list return if current_element /= null then local_element := first_element; -- point to first element index := 1; while local_element /= current_element loop exit when local_element = null; -- error trap local_element := local_element.next; index := index + 1; end loop; end if; return index; end current_index; function current_next return boolean is begin if current_element = last_element then return FALSE; else current_element := current_element.next; return TRUE; end if; end current_next; function current_previous return boolean is begin if current_element = first_element then return FALSE; else current_element := current_element.previous; return TRUE; end if; end current_previous; function set_current_index (index : natural) return boolean is counter : natural; begin current_element := first_element; -- start at first element if index <= 1 then return TRUE; else for counter in 1 .. index - 1 loop if current_element = last_element then return FALSE; exit; -- this exit may not be necessary else current_element := current_element.next; end if; end loop; return TRUE; end if; end set_current_index; -- -- Return the index of the last element in the list -- function last_index return natural is current_save : element_pointer; index : natural; begin current_save := current_element; current_element := last_element; index := current_index; current_element := current_save; return index; end last_index; -- -- Determine if the list is empty; return TRUE if so, FALSE if not -- function list_empty return boolean is begin if first_element = null then return TRUE; -- list is empty else return FALSE; -- list is not empty end if; end list_empty; -- -- Determine if at first element in list; return TRUE if so -- function at_front_of_list return boolean is begin if current_element = first_element then return TRUE; else return FALSE; end if; end at_front_of_list; -- -- Determine if at last element in list; return TRUE if so -- function at_end_of_list return boolean is begin if current_element = last_element then return TRUE; else return FALSE; end if; end at_end_of_list; -- -- Procedures to manipulate elements in list -- These procedures insert elements into the list and -- delete elements from the list -- procedure append_element (element : element_pointer) is begin if list_empty then first_element := element; last_element := element; current_element := element; element.next := null; element.previous := null; else element.next := current_element.next; current_element.next := element; element.previous := current_element; if element.next /= null then element.next.previous := element; else last_element := element; end if; end if; current_element := element; end append_element; procedure append_element (element : element_object) is loc_element : element_pointer; begin loc_element := new_element; loc_element.content := element; append_element (loc_element); end append_element; procedure insert_element (element : element_pointer) is begin if list_empty then first_element := element; last_element := element; current_element := element; element.next := null; element.previous := null; else element.previous := current_element.previous; current_element.previous := element; element.next := current_element; if element.previous /= null then element.previous.next := element; else first_element := element; end if; end if; end insert_element; procedure insert_element (element : element_object) is loc_element : element_pointer; begin loc_element := new_element; loc_element.content := element; insert_element (loc_element); end insert_element; procedure delete_element is temp_element : element_pointer; begin if not list_empty then if current_element = first_element then first_element := current_element.next; else current_element.previous.next := current_element.next; end if; if current_element = last_element then last_element := current_element.previous; temp_element := last_element; else current_element.next.previous := current_element.previous; temp_element := current_element.next; end if; free_element (current_element); current_element := temp_element; end if; end delete_element; -- -- Memory management routines -- Obtain a new list element and free old, unneeded list elements -- function new_element return element_pointer is begin return (new list_element); end new_element; procedure free_element (element : element_pointer) is -- -- This procedure is a dummy for now; the following generic -- instantiation is what it should be, but there is a bug in my -- Ada compiler which prevents this instatiation from working -- -- procedure free_element is new unchecked_deallocation -- (list_element, element_pointer); -- begin null; end free_element; end generic_list;