|
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: 5953 (0x1741)
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 Type_Definitions;
use Type_Definitions;
with String_Pkg;
use String_Pkg;
with Text_Io;
use Text_Io;
with Unchecked_Deallocation;
package body Rtm_List_Package is
--| Overview
--| The RTM_List_Package is a subset of the Lists package from Inter-
--| metrics in Cambridge. It is tailored explicitly for the Run_Time_Monitor.
--| The type of the list objects is Program_Unit_Unique_Identifier, which is
--| declared in Type_Definitions.
--| The procedures and functions allow the RTM to create a list, add to a
--| list, delete an item from the list, read and replace an item after
--| incrementing the Task_Type_Activation_Number, and check for an empty
--| list.
-- Mary Koppes Intermetrics Inc, Huntington Beach,Ca 11-June-85
-------------------------------------------------------------------------------
procedure Free is new Unchecked_Deallocation (List_Element, List);
-------------------------------------------------------------------------------
-- Local Declarations for the RTM_ List_Package
Item_Not_Present : exception;
Empty_List : exception;
-------------------------------------------------------------------------------
function Equal (X, Y : in Program_Unit_Unique_Identifier) return Boolean is
begin
if Equal (X.Enclosing_Unit_Identifier, Y.Enclosing_Unit_Identifier) and
X.Program_Unit_Number = Y.Program_Unit_Number and
X.Unit_Type = Y.Unit_Type then
return True;
else
return False;
end if;
end Equal;
-------------------------------------------------------------------------------
function Create --| Creates a null List
return List
is
begin
return null;
end Create;
-------------------------------------------------------------------------------
procedure Add (Element : in Program_Unit_Unique_Identifier;
To_List : in out List) is
--| Algorithm
--| Allocates new storage for Element and links it to To_List.
begin
To_List := new List_Element'(Info => Element, Next_Element => To_List);
end Add;
-------------------------------------------------------------------------------
procedure Delete_Head (The_List : in out List)
is
--| Algorithm
--| Delete_Head first checks The_List and if it is null, Empty_List
--| is raised. If The_List is not null, the first element is freed.
Temporary_List : List;
begin
if The_List = null then
raise Empty_List;
else
Temporary_List := The_List.Next_Element;
Free (The_List);
The_List := Temporary_List;
end if;
end Delete_Head;
-------------------------------------------------------------------------------
procedure Delete (Element : in Program_Unit_Unique_Identifier;
From_List : in out List)
is
--| Algorithm
--| Delete is a recursive procedure which in effect walks through From_List
--| looking for the first occurance of Element. When it is found that
--| element is deleted by a call to Delete_Head, which frees the element.
begin
if Equal (From_List.Info, Element) then
Delete_Head (From_List);
else
Delete (Element, From_List.Next_Element);
end if;
exception
when Constraint_Error =>
raise Item_Not_Present;
end Delete;
-------------------------------------------------------------------------------
procedure Replace_Value
( --| Find element and increments the Task number
New_Element : in out Program_Unit_Unique_Identifier;
New_List : in out List)
is
--| Algorithm
--| Replace value loops through the list until New_Element is found.
--| When it is found, the Task_Type_Activation_Number is incremented
--| and the element is replaced. New_Element is set to this new value
--| and returned via the IN OUT parameter.
Pointer : List;
begin
Pointer := New_List;
while Pointer /= null loop
if Equal (Pointer.Info, New_Element) then
Pointer.Info.Task_Type_Activation_Number :=
Pointer.Info.Task_Type_Activation_Number + 1;
New_Element := Pointer.Info;
exit;
else
Pointer := Pointer.Next_Element;
end if;
end loop;
end Replace_Value;
------------------------------------------------------------------------------
function Is_In_List ( --| Checks for the presence of Element in The_List.
The_List : in List;
Element : in Program_Unit_Unique_Identifier
) return Boolean
is
--| Algorithm
--| Is_In_List loops through the list, searching fot Element. It
--| returns TRUE if it found and FALSE if it is not found.
Pointer : List;
begin
Pointer := The_List;
while Pointer /= null loop
if Equal (Pointer.Info, Element) then
return True;
end if;
Pointer := Pointer.Next_Element;
end loop;
return False;
end Is_In_List;
------------------------------------------------------------------------------
function Is_Empty ( --| Checks for an empty list
The_List : in List) return Boolean
is
--| Algorithm
--| If The_List = NULL then return TRUE, else return FALSE.
begin
return (The_List = null);
end Is_Empty;
end Rtm_List_Package;