|
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: 10200 (0x27d8)
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 Unchecked_Deallocation;
package body List_Double_Iterator_Managed_Unbounded is
type Pointer_To_Item is access Item;
type Node is
record
This_Item_Pointer : Pointer_To_Item := null;
Next : List := null;
Previous : List := null;
end record;
Available_List : List := Null_List;
procedure Free_Item_Node is
new Unchecked_Deallocation (Object => Item, Name => Pointer_To_Item);
-- this will be taken off later.
procedure Free (Unused_List : in out List) is
--=================================================================
-- Returns Unused_List into available list. ==
-- Value of Unused_List is set to NULL upon return. ==
--=================================================================
Tail_Of_Available_List : List := Tail_Of (Available_List);
begin
-- Free
if Available_List = Null_List then
Available_List := Unused_List;
else
Append (This_List => Tail_Of_Available_List,
And_This_List => Unused_List);
end if;
Deallocating_Item_Nodes:
while Unused_List /= Null_List loop
Free_Item_Node (X => Unused_List.This_Item_Pointer);
Unused_List := Unused_List.Next;
end loop Deallocating_Item_Nodes;
end Free;
procedure Clear (The_List : in out List) is
--=================================================================
-- Clear returns The_List into the available list ==
-- if it is not empty. Value of The_List is set ==
-- to NULL_LIST upon return. ==
--=================================================================
begin
-- Clear
if The_List /= Null_List then
Free (Unused_List => The_List);
else
The_List := Null_List;
end if;
end Clear;
procedure Share (The_List : in List; With_The_List : out List) is
--=================================================================
-- Share assigns With_The_List to the same location ==
-- The_List is currently pointing. ==
--=================================================================
begin
-- Share
With_The_List := The_List;
end Share;
function Seek (Origin : in List; Offset : in Integer) return List is
--=================================================================
-- Seek returns the position of nth item to the left/right of ==
-- the current position (depending on Offset); if the nth item ==
-- does not exist, OVERFLOW will be raised. ==
--=================================================================
Repetitions : Natural := abs Offset;
New_Location : List := Origin;
begin
-- Seek
if Offset < 0 then
-- seek backward
while Repetitions > 0 loop
New_Location := New_Location.Previous;
Repetitions := Repetitions - 1;
end loop;
else
-- Offset >= 0
-- seek forward
while Repetitions > 0 loop
New_Location := New_Location.Next;
Repetitions := Repetitions - 1;
end loop;
end if;
return New_Location;
exception
when Constraint_Error =>
raise Overflow;
end Seek;
procedure Get (New_Node : out List) is
--=================================================================
-- Returns a new node either from the Available_List or from the ==
-- allocator (NEW). ==
--=================================================================
Next_Available_Node : List;
begin
-- Get
if Available_List = Null_List then
Next_Available_Node := new Node;
else
-- get next available node from available list
Next_Available_Node := Available_List;
Available_List := Available_List.Next;
Next_Available_Node.Next := null;
Next_Available_Node.Previous := null;
end if;
New_Node := Next_Available_Node;
end Get;
procedure Construct (New_Item : in Item; And_The_List : out List) is
--=================================================================
-- Construct creates a list with one item (New_Item) in it. ==
--=================================================================
New_Node : List;
begin
-- Construct
Get (New_Node => New_Node);
New_Node.This_Item_Pointer := new Item'(New_Item);
And_The_List := New_Node;
end Construct;
procedure Append (This_List : in out List; And_This_List : in out List) is
--=================================================================
-- Append will concatenate This_List with And_This_List. ==
-- If either This_List or And_This_List is a NULL_LIST, ==
-- exception LIST_IS_EMPTY will be raised. ==
--=================================================================
begin
-- Append
if This_List = Null_List or And_This_List = Null_List then
raise List_Is_Empty;
end if;
This_List.Next := And_This_List;
And_This_List.Previous := This_List;
end Append;
procedure Store (This_Item : in Item; In_This_Location : in out List) is
--==================================================================
-- Store will put This_Item In_This_Location (destroying the ==
-- previous content). If In_This_Location is Null_List, exception ==
-- LIST_IS_EMPTY will be raised. ==
--==================================================================
begin
-- Store
if In_This_Location = Null_List then
raise List_Is_Empty;
end if;
Free_Item_Node (X => In_This_Location.This_Item_Pointer);
In_This_Location.This_Item_Pointer := new Item'(This_Item);
end Store;
function Content_Of (This_List : in List) return Item is
--=================================================================
-- Content_Of returns the current item pointed by This_List. ==
-- Exception LIST_IS_EMPTY will be raised if This_List ==
-- is an empty list. ==
--=================================================================
begin
-- Content_Of
if This_List = Null_List then
raise List_Is_Empty;
end if;
return This_List.This_Item_Pointer.all;
end Content_Of;
function Location_Of (This_Item : in Item; In_This : in List) return List is
--=================================================================
-- Location_Of returns the location of a given item in a given ==
-- list. If the item is not found, NULL_LIST will be returned. ==
--=================================================================
Location_Of_Item : List := In_This;
begin
-- Location_Of
while Location_Of_Item /= Null_List and then
Content_Of (Location_Of_Item) /= This_Item loop
Location_Of_Item := Location_Of_Item.Next;
end loop;
return Location_Of_Item;
end Location_Of;
function Tail_Of (This_List : in List) return List is
--=================================================================
-- Tail_Of returns the position of the LAST item in the list. ==
-- NULL_LIST is returned if The_List is a NULL_LIST. ==
--=================================================================
Current_List : List := This_List;
begin
-- Tail_Of
if Current_List = Null_List then
return Null_List;
else
-- find the last item node in the list
while Current_List.Next /= Null_List loop
Current_List := Current_List.Next;
end loop;
return Current_List;
end if;
end Tail_Of;
function Is_Equal (Left : in List; Right : in List) return Boolean is
--=================================================================
-- Is_Equal returns TRUE if Left and Right both point ==
-- to the same location in the list; otherwise FALSE is ==
-- returned. ==
--=================================================================
begin
-- Is_Equal
return Left = Right;
end Is_Equal;
procedure Iterate (Across_The_List : in List) is
--=================================================================
-- Iterate will visit every item in a given list ==
-- (Across_The_List) and invoke Process. If Is_Done ==
-- flag is TRUE upon return, iteration process will ==
-- stop; otherwise iteration will continue until all ==
-- items have been visited once. ==
--=================================================================
Current_Position : List := Across_The_List;
Is_Stopped : Boolean;
begin
-- Iterate
Visit_Items:
while Current_Position /= Null_List loop
Process (This_Position => Current_Position,
Is_Done => Is_Stopped);
exit Visit_Items when Is_Stopped;
Current_Position := Current_Position.Next;
end loop Visit_Items;
end Iterate;
end List_Double_Iterator_Managed_Unbounded;