|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 11710 (0x2dbe)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Text_Io;
use Text_Io;
with Unchecked_Deallocation;
package body List_Pkg is
----------------------------------------------------------------------
--| NAME: LIST_PKG
--|
--| OVERVIEW:
--| This package defines the generic list used for all data types
--| and the actions that can be performed on them. In TRACKER, each
--| data type will have its own linked list instantiated in the
--| respective data package. The rec_data field is a pointer to
--| a record of data.
--|
--| For the generic case, the resulting data structure looks like this:
--||
--|| prev_ptr current_ptr
--|| . .
--|| | |
--|| V V
--|| _________ _________ _________ <-- tail
--|| head -->| next +-|--->| next +-|--->| next +-|---> null
--|| |_________| |_________| |_________|
--|| | rec_key | | rec_key | | rec_key |
--|| |_________| |_________| |_________|
--|| | rec_data| | rec_data| | rec_data|
--|| |_________| |_________| |_________|
--||
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
procedure Free is new Unchecked_Deallocation (List_Element, List_Ptr);
procedure Add (List : in out List_Type;
Rec_Key : in Key;
Rec_Ptr : in Data) is
----------------------------------------------------------------------
--|
--| NAME: ADD
--|
--| OVERVIEW:
--| This procedure adds a new list record onto the end of the
--| linked list. This feature provides a simple method by which
--| you could sort the list; DELETE the list elements in the order
--| you want the list to be sorted. Once you have DELETEd it, ADD it
--| back onto the end of the list. Loop until the list is sorted.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
Temp : List_Ptr;
begin
Temp := new List_Element;
Temp.Search_Key := Rec_Key;
Temp.Rec_Data := Rec_Ptr;
Temp.Next := null;
if List.Head = null then
List.Head := Temp;
List.Tail := Temp;
else
List.Tail.Next := Temp;
List.Tail := List.Tail.Next;
List.Tail.Next := null;
end if;
end Add;
function Empty_List (List : in List_Type) return Boolean is
----------------------------------------------------------------------
--|
--| NAME: EMPTY_LIST
--|
--| OVERVIEW:
--| This function determines if the list is empty by checking the
--| pointer to the head of the list. If it is null, true is returned.
--| Otherwise, the list is not empty.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee March 1985
--|
----------------------------------------------------------------------
begin
if List.Head = null then
return True;
else
return False;
end if;
end Empty_List;
procedure Find (List : in out List_Type;
Rec_Key : in Key;
Rec_Ptr : out Data;
Found : in out Boolean) is
----------------------------------------------------------------------
--|
--| NAME: FIND
--|
--| OVERVIEW:
--| This procedure searches the entire list for a record by the
--| rec_key and returns the record. Found = true if the record
--| is found and false otherwise. If the record is found, it
--| is pointed to by list.current_ptr.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
begin
-- list.current_ptr points to the current element
-- If the record is found, it will be referenced by list.current_ptr
Found := False;
List.Prev_Ptr := null; -- points to record before the one we want
List.Current_Ptr := List.Head;
if List.Current_Ptr = null then
-- empty list, exit procedure
Found := False;
elsif List.Current_Ptr.Search_Key = Rec_Key then
-- check list.head of list
Found := True;
Rec_Ptr := List.Current_Ptr.Rec_Data;
else
-- not list.head, search rest of list
List.Prev_Ptr := List.Current_Ptr;
List.Current_Ptr := List.Current_Ptr.Next;
while not Found and List.Current_Ptr /= null loop
if List.Current_Ptr.Search_Key = Rec_Key then
Found := True;
Rec_Ptr := List.Current_Ptr.Rec_Data;
else
List.Prev_Ptr := List.Current_Ptr;
List.Current_Ptr := List.Current_Ptr.Next;
end if;
end loop;
end if;
end Find;
procedure Change_List_Key (List : in out List_Type;
Old_Key : in Key;
New_Key : in Key) is
----------------------------------------------------------------------
--|
--| NAME: CHANGE_LIST_KEY
--|
--| OVERVIEW:
--| This procedure will change the old_key to the new_key for a list_type.
--| Since this is a generic package, the programmer would otherwise
--| not be able to access the key directly from the program.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
Found : Boolean;
Rec_Ptr : Data;
begin
-- find old key
Find (List, Old_Key, Rec_Ptr, Found);
if Found then
-- change the old_key to the new_key
List.Current_Ptr.Search_Key := New_Key;
end if;
end Change_List_Key;
procedure Change_List_Data (List : in out List_Type;
A_Key : in Key;
New_Data : in Data) is
----------------------------------------------------------------------
--|
--| NAME: CHANGE_LIST_DATA
--|
--| OVERVIEW:
--| This procedure will find a record and change the old_data to
--| the new_data for a list type. Since this is a generic package,
--| the programmer would otherwise not be able to access the data
--| directly from the program.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee March 1985
--|
----------------------------------------------------------------------
Found : Boolean;
Old_Data : Data;
begin
-- find the record
Find (List, A_Key, Old_Data, Found);
if Found then
-- change the data
List.Current_Ptr.Rec_Data := New_Data;
end if;
end Change_List_Data;
procedure Delete (List : in out List_Type;
Rec_Key : in Key;
Successful : out Boolean) is
----------------------------------------------------------------------
--|
--| NAME: DELETE
--|
--| OVERVIEW:
--| This procedure deletes a record from the linked list by
--| removing the links to that record. The record is first
--| found by calling FIND. If it is found, the record is
--| pointed to by list.current_ptr. The empty list record is
--| deallocated by calling FREE.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
Found : Boolean := False; -- if record found in list
Rec_Ptr : Data;
begin
Find (List, Rec_Key, Rec_Ptr, Found);
if Found then
if List.Prev_Ptr = null then
-- delete list.head
if List.Head = List.Tail then
-- one element list
-- after deletion, it is a null list
-- list.head and list.tail are null
Free (List.Head);
List.Head := null;
List.Tail := null;
else
List.Head := List.Head.Next;
Free (List.Current_Ptr);
end if;
else
-- not list.head of list, delete from the middle or end of list
List.Prev_Ptr.Next := List.Current_Ptr.Next;
Free (List.Current_Ptr);
if List.Prev_Ptr.Next = null then
-- just deleted the list.tail
List.Tail := List.Prev_Ptr; -- reassign the list.tail
end if;
end if;
Successful := True; -- successfully deleted record
else
Successful := False; -- record not found, so not deleted
end if;
end Delete;
procedure Start_Walk (List : in out List_Type) is
----------------------------------------------------------------------
--|
--| NAME: START_WALK
--|
--| OVERVIEW:
--| Start the pointer at the head of the list.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
begin
List.Current_Ptr := List.Head;
end Start_Walk;
procedure Walk (List : in out List_Type;
Rec_Ptr : out Data;
End_List : out Boolean) is
----------------------------------------------------------------------
--|
--| NAME: WALK
--|
--| OVERVIEW:
--| This procedure walks a linked list one link at a time, returning
--| the contents of that links data in rec_ptr. It can be used to
--| write a linked list to file or to print the contents of the list's
--| data.
--|
--| EXCEPTIONS HANDLED:
--| none
--|
--| HISTORY:
--| written by May Lee February 1985
--|
----------------------------------------------------------------------
begin
if List.Current_Ptr = null then
End_List := True;
else
End_List := False;
Rec_Ptr := List.Current_Ptr.Rec_Data;
List.Current_Ptr := List.Current_Ptr.Next;
end if;
end Walk;
end List_Pkg;