|
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: 39426 (0x9a02)
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 Diana, Action, System, Object_Set, Job_Segment,
Object_Editor, Time_Utilities, Dependency_Data_Base,
Switch_Implementation, Activity_Implementation;
package body Objects is
package Dir renames Directory;
type Node is
record
The_Object : Directory.Object;
The_Version : Directory.Version;
The_Class : Directory.Class;
The_Data : Directory.Statistics.Data;
end record;
Root : Directory.Object;
Class_Ada : constant Directory.Class := Directory.Class_Value ("ada");
Class_File : constant Directory.Class := Directory.Class_Value ("file");
Class_Session : constant Directory.Class :=
Directory.Class_Value ("session");
Class_User : constant Directory.Class := Directory.Class_Value ("user");
Class_Tape : constant Directory.Class := Directory.Class_Value ("tape");
Class_Terminal : constant Directory.Class :=
Directory.Class_Value ("terminal");
Class_Pipe : constant Directory.Class := Directory.Class_Value ("pipe");
procedure Set_Object (The_Object : in out Kind; The_Name : in String) is
The_Status : Directory.Naming.Name_Status;
Temporary_Object : Directory.Object;
function "=" (X, Y : in Directory.Naming.Name_Status) return Boolean
renames Directory.Naming."=";
begin
if Directory.Naming.Is_Well_Formed (The_Name) then
Directory.Naming.Resolve (The_Name, Temporary_Object, The_Status);
if "=" (The_Status, Directory.Naming.Successful) then
The_Object := Kind_Of (Temporary_Object);
else
raise Name_Error;
end if;
else
raise Name_Error;
end if;
end Set_Object;
procedure Set_Object (The_Object : in out Kind;
The_Declaration : in Directory.Object) is
begin
The_Object := Kind_Of (The_Declaration);
end Set_Object;
procedure Visit (The_Object : in Kind) is
begin
null;
Object_Editor.Display (The_Object.The_Version);
exception
when Constraint_Error =>
raise Object_Is_Null;
end Visit;
function Kind_Of (The_Declaration : in Directory.Object) return Kind is
Temporary_Node : Node;
Directory_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
Temporary_Node.The_Object := The_Declaration;
Directory.Traversal.Get_Version
(Temporary_Node.The_Object,
Temporary_Node.The_Version, Directory_Status);
if "=" (Directory_Status, Directory.Successful) then
Temporary_Node.The_Class := Directory.Get_Class
(Temporary_Node.The_Object);
Directory.Statistics.Get_Data
(Temporary_Node.The_Version,
Temporary_Node.The_Data, Directory_Status);
if "=" (Directory_Status, Directory.Successful) then
return new Node'(Temporary_Node);
else
raise Directory_Error;
end if;
else
raise Directory_Error;
end if;
end Kind_Of;
function Declaration_Of (The_Object : in Kind) return Directory.Object is
begin
return The_Object.The_Object;
exception
when Constraint_Error =>
raise Object_Is_Null;
end Declaration_Of;
function Class_Of (The_Object : in Kind) return Class is
function "=" (X, Y : in Directory.Class) return Boolean
renames Directory."=";
begin
if The_Object.The_Class = Class_Ada then
return Ada_Unit;
elsif Directory.Control_Point.Is_Control_Point
(Directory.Ada.Get_Unit (The_Object.The_Object)) then
return A_Structure;
elsif The_Object.The_Class = Class_File then
return A_File;
else
return An_Other;
end if;
exception
when Constraint_Error =>
raise Object_Is_Null;
end Class_Of;
function Enclosing_Object_Of (The_Object : in Kind) return Kind is
Temporary_Version : Directory.Version;
Temporary_Object : Directory.Object;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Object) return Boolean
renames Directory."=";
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if The_Object.The_Object = Root then
raise At_Root_Of_Universe;
elsif (Class_Of (The_Object) = Ada_Unit) or
(Class_Of (The_Object) = A_Structure) then
Directory.Ada.Get_Parent (The_Object.The_Version,
Temporary_Version, The_Status);
if "=" (The_Status, Directory.Successful) then
Directory.Traversal.Get_Object
(Temporary_Version, Temporary_Object, The_Status);
if "=" (The_Status, Directory.Successful) then
return Kind_Of (Temporary_Object);
else
raise Directory_Error;
end if;
else
raise Directory_Error;
end if;
else
return Kind_Of (Directory.Control_Point.Associated_Control_Point
(The_Object.The_Object));
end if;
exception
when Constraint_Error =>
raise Object_Is_Null;
end Enclosing_Object_Of;
function Unique_Name_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Unique_Full_Name (The_Object.The_Version);
exception
when Constraint_Error =>
raise Object_Is_Null;
end Unique_Name_Of;
function Qualified_Name_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Get_Full_Name (The_Object.The_Version);
exception
when Constraint_Error =>
raise Object_Is_Null;
end Qualified_Name_Of;
function Simple_Name_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Get_Simple_Name (The_Object.The_Version);
exception
when Constraint_Error =>
raise Object_Is_Null;
end Simple_Name_Of;
function Version_Of (The_Object : in Kind) return String is
begin
return Directory.Version_Name_Image
(Directory.Get_Version_Name (The_Object.The_Version));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Version_Of;
function Creator_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Get_Simple_Name
((Directory.Statistics.Creator (The_Object.The_Data)));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Creator_Of;
function Updater_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Get_Simple_Name
((Directory.Statistics.Last_Updater (The_Object.The_Data)));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Updater_Of;
function Reader_Of (The_Object : in Kind) return String is
begin
return Directory.Naming.Get_Simple_Name
((Directory.Statistics.Last_Reader (The_Object.The_Data)));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Reader_Of;
function Creation_Time_Of (The_Object : in Kind) return String is
begin
return Time_Utilities.Image (Time_Utilities.Convert_Time
((Directory.Statistics.Time_Of_Creation
(The_Object.The_Data))));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Creation_Time_Of;
function Update_Time_Of (The_Object : in Kind) return String is
begin
return Time_Utilities.Image
(Time_Utilities.Convert_Time
((Directory.Statistics.Time_Of_Last_Update
(The_Object.The_Data))));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Update_Time_Of;
function Read_Time_Of (The_Object : in Kind) return String is
begin
return "";
return Time_Utilities.Image (Time_Utilities.Convert_Time
((Directory.Statistics.Time_Of_Last_Read
(The_Object.The_Data))));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Read_Time_Of;
function Size_Of (The_Object : in Kind) return String is
begin
return Long_Integer'Image
(Directory.Statistics.Total_Size (The_Object.The_Data));
exception
when Constraint_Error =>
raise Object_Is_Null;
end Size_Of;
function Is_Frozen (The_Object : in Kind) return String is
The_Result : Boolean;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
Directory.Object_Operations.Is_Frozen
(The_Object.The_Object, The_Result, The_Status);
if "=" (The_Status, Directory.Successful) then
return Boolean'Image (The_Result);
else
raise Directory_Error;
end if;
exception
when Constraint_Error =>
raise Object_Is_Null;
end Is_Frozen;
package body Ada is
function Ada_Class_Of (The_Object : in Kind) return Ada_Class is
begin
case Ada_Unit_Kind_Of (The_Object) is
when Function_Spec | Function_Body |
Procedure_Spec | Procedure_Body |
Function_Instantiation | Procedure_Instantiation |
Generic_Function_Spec | Generic_Function_Body |
Generic_Procedure_Spec | Generic_Procedure_Body =>
return A_Subprogram;
when Package_Spec | Package_Body | Package_Instantiation |
Generic_Package_Spec | Generic_Package_Body =>
return A_Package;
when Task_Spec | Task_Body =>
return A_Task;
when Undecided =>
return Undecided;
end case;
end Ada_Class_Of;
function Ada_Unit_Kind_Of (The_Object : in Kind) return Ada_Unit_Kind is
Root : Diana.Tree;
Temporary_Tree : Diana.Tree;
Key : Directory.Ada.Conversion_Key;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (X, Y : in Directory.Class) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) /= Ada_Unit then
raise Is_Not_Ada_Unit;
else
Directory.Ada.Open (The_Object.The_Version, Directory.Ada.Read,
Root, Key, The_Status, Action.Null_Id);
if The_Status = Directory.Successful then
Root := Diana.Id_Utilities.Get_Id (Root);
Root := Diana.Id_Utilities.Enclosing_Declaration (Root);
case Diana.Kind (Root) is
when Diana.Dn_Package_Decl =>
Temporary_Tree := Diana.As_Package_Def (Root);
case Diana.Kind (Temporary_Tree) is
when Diana.Dn_Instantiation =>
return Package_Instantiation;
when others =>
return Package_Spec;
end case;
when Diana.Dn_Package_Body =>
Temporary_Tree := Diana.As_Id (Root);
case Diana.Kind (Diana.Sm_First (Temporary_Tree)) is
when Diana.Dn_Generic_Id =>
return Generic_Package_Body;
when others =>
return Package_Body;
end case;
when Diana.Dn_Generic =>
Temporary_Tree := Diana.As_Generic_Header (Root);
case Diana.Kind (Temporary_Tree) is
when Diana.Dn_Procedure =>
return Generic_Procedure_Spec;
when Diana.Dn_Function =>
return Generic_Function_Spec;
when Diana.Dn_Package_Spec =>
return Generic_Package_Spec;
when others =>
null;
end case;
when Diana.Dn_Task_Decl =>
return Task_Spec;
when Diana.Dn_Task_Body =>
return Task_Body;
when Diana.Dn_Subprogram_Decl =>
if not Diana.Is_Empty
(Diana.As_Subprogram_Def (Root)) then
Temporary_Tree := Diana.As_Header (Root);
case Diana.Kind (Temporary_Tree) is
when Diana.Dn_Procedure =>
return Procedure_Instantiation;
when Diana.Dn_Function =>
return Function_Instantiation;
when others =>
null;
end case;
else
Temporary_Tree := Diana.As_Header (Root);
case Diana.Kind (Temporary_Tree) is
when Diana.Dn_Procedure =>
return Procedure_Spec;
when Diana.Dn_Function =>
return Function_Spec;
when others =>
null;
end case;
end if;
when Diana.Dn_Subprogram_Body =>
Temporary_Tree := Diana.As_Designator (Root);
Root := Diana.As_Header (Root);
case Diana.Kind (Root) is
when Diana.Dn_Procedure =>
case Diana.Kind (Diana.Sm_First
(Temporary_Tree)) is
when Diana.Dn_Generic_Id =>
return Generic_Procedure_Body;
when others =>
return Procedure_Body;
end case;
when Diana.Dn_Function =>
case Diana.Kind (Diana.Sm_First
(Temporary_Tree)) is
when Diana.Dn_Generic_Id =>
return Generic_Function_Body;
when others =>
return Function_Body;
end case;
when others =>
null;
end case;
when others =>
return Undecided;
end case;
else
return Undecided;
end if;
end if;
end Ada_Unit_Kind_Of;
function Is_Generic (The_Object : in Kind) return Boolean is
begin
case Ada_Unit_Kind_Of (The_Object) is
when Generic_Function_Spec | Generic_Function_Body |
Generic_Procedure_Spec | Generic_Procedure_Body |
Generic_Package_Spec | Generic_Package_Body =>
return True;
when others =>
return False;
end case;
end Is_Generic;
function Is_Spec (The_Object : in Kind) return Boolean is
begin
case Ada_Unit_Kind_Of (The_Object) is
when Function_Spec | Procedure_Spec | Package_Spec |
Generic_Function_Spec | Generic_Procedure_Spec |
Generic_Package_Spec | Function_Instantiation |
Procedure_Instantiation | Package_Instantiation =>
return True;
when others =>
return False;
end case;
end Is_Spec;
function Is_Subunit (The_Object : in Kind) return Boolean is
begin
return Class_Of (Enclosing_Object_Of (The_Object)) = Ada_Unit;
end Is_Subunit;
function Has_Subunits (The_Object : in Kind) return Boolean is
The_Iterator : Directory.Traversal.Subunit_Iterator;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
case Ada_Unit_Kind_Of (The_Object) is
when Function_Body | Procedure_Body | Package_Body |
Generic_Function_Body | Generic_Procedure_Body |
Generic_Package_Body | Task_Body =>
Directory.Traversal.Init
(Directory.Ada.Get_Unit (The_Object.The_Object),
Action.Null_Id, The_Iterator, The_Status);
if The_Status = Directory.Successful then
return not Directory.Traversal.Done (The_Iterator);
else
raise Directory_Error;
end if;
when others =>
return False;
end case;
end Has_Subunits;
function Status_Of (The_Object : in Kind) return Status is
The_State : Directory.Declaration_Operations.Declaration_State;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) = Ada_Unit then
Directory.Declaration_Operations.Get_Unit_State
(The_Object.The_Version, The_State, The_Status);
if The_Status = Directory.Successful then
case The_State is
when Directory.Declaration_Operations.Source =>
return Source;
when Directory.Declaration_Operations.Installed =>
return Installed;
when Directory.Declaration_Operations.Coded =>
return Coded;
when others =>
return Unknown;
end case;
else
raise Directory_Error;
end if;
else
raise Is_Not_Ada_Unit;
end if;
end Status_Of;
procedure Traverse_Withs_Of (The_Object : in Kind) is
Root : Diana.Tree;
Key : Directory.Ada.Conversion_Key;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
procedure Walk (Node : Diana.Tree) is
List : Diana.Seq_Type;
Name_Status : Directory.Naming.Name_Status;
The_Version : Directory.Version;
The_Object : Directory.Object;
function "=" (X, Y : in Directory.Naming.Name_Status)
return Boolean renames Directory.Naming."=";
begin
case Diana.Kind (Node) is
when Diana.Dn_Context =>
List := Diana.As_List (Node);
while not Diana.Is_Empty (List) loop
Walk (Diana.Head (List));
List := Diana.Tail (List);
end loop;
when Diana.Dn_Pragma =>
return;
when Diana.Dn_Use =>
return;
when Diana.Dn_With =>
List := Diana.As_List (Node);
while not Diana.Is_Empty (List) loop
Walk (Diana.Head (List));
List := Diana.Tail (List);
end loop;
when Diana.Dn_Used_Name_Id =>
Directory.Naming.Resolve
('`' & Diana.Image (Diana.Id (Node)) & "'spec",
The_Version, Name_Status, Root);
if Name_Status = Directory.Naming.Successful then
Directory.Traversal.Get_Object
(The_Version, The_Object, The_Status);
if The_Status = Directory.Successful then
Process (Kind_Of (The_Object));
else
raise Directory_Error;
end if;
else
raise Directory_Error;
end if;
when others =>
raise Directory_Error;
end case;
end Walk;
begin
if Class_Of (The_Object) = Ada_Unit then
Directory.Ada.Open (The_Object.The_Version, Directory.Ada.Read,
Root, Key, The_Status, Action.Null_Id);
if The_Status = Directory.Successful then
Walk (Diana.As_Context (Root));
else
raise Directory_Error;
end if;
else
raise Is_Not_Ada_Unit;
end if;
end Traverse_Withs_Of;
procedure Traverse_Uses_Of (The_Object : in Kind) is
Root : Diana.Tree;
The_Status : Directory.Error_Status;
Segment : System.Segment := Job_Segment.Get;
The_Iterator : Dependency_Data_Base.Iterator;
Temporary_Object : Directory.Object;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (X, Y : in Directory.Object) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) = Ada_Unit then
Directory.Traversal.Get_Declaration
(The_Object.The_Object, Root, The_Status);
if The_Status = Directory.Successful then
for Index in Dependency_Data_Base.Relationship loop
The_Iterator :=
Dependency_Data_Base.Objects
(Index, Root, Action.Null_Id, Segment);
while not Dependency_Data_Base.Done (The_Iterator) loop
Directory.Traversal.Get_Object
(Dependency_Data_Base.Object_Id (The_Iterator),
Temporary_Object, The_Status);
if (The_Status = Directory.Successful) and
("/=" (Temporary_Object,
The_Object.The_Object)) then
Process (Kind_Of (Temporary_Object));
end if;
The_Iterator :=
Dependency_Data_Base.Next (The_Iterator);
end loop;
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_Ada_Unit;
end if;
end Traverse_Uses_Of;
procedure Traverse_Subunits_Of (The_Object : in Kind) is
The_Iterator : Directory.Traversal.Subunit_Iterator;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) = Ada_Unit then
Directory.Traversal.Init
(Directory.Ada.Get_Unit (The_Object.The_Object),
Action.Null_Id, The_Iterator, The_Status);
if The_Status = Directory.Successful then
while not Directory.Traversal.Done (The_Iterator) loop
Process (Kind_Of (Directory.Ada.Get_Object
(Directory.Traversal.Value
(The_Iterator))));
Directory.Traversal.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_Ada_Unit;
end if;
end Traverse_Subunits_Of;
end Ada;
package body Structure is
function Subsystem_Indicator_Exists
(The_Object : in Kind) return Boolean is
Subsystem_Indicator : constant String :=
".state.this_is_the_root_of_a_subsystem";
Temporary_Object : Dir.Object;
The_Status : Dir.Naming.Name_Status;
function "=" (X, Y : in Dir.Naming.Name_Status) return Boolean
renames Dir.Naming."=";
begin
Dir.Naming.Resolve (Qualified_Name_Of (The_Object) &
Subsystem_Indicator,
Temporary_Object, The_Status);
return (The_Status = Dir.Naming.Successful);
end Subsystem_Indicator_Exists;
function View_Indicator_Exists (The_Object : in Kind) return Boolean is
View_Indicator : constant String :=
".state.this_is_the_root_of_a_view";
Temporary_Object : Dir.Object;
The_Status : Dir.Naming.Name_Status;
function "=" (X, Y : in Dir.Naming.Name_Status) return Boolean
renames Dir.Naming."=";
begin
Dir.Naming.Resolve (Qualified_Name_Of (The_Object) & View_Indicator,
Temporary_Object, The_Status);
return (The_Status = Dir.Naming.Successful);
end View_Indicator_Exists;
function Structure_Class_Of
(The_Object : in Kind) return Structure_Class is
function "=" (X, Y : in Dir.Class) return Boolean renames Dir."=";
begin
if Class_Of (The_Object) /= A_Structure then
raise Is_Not_A_Structure;
elsif Subsystem_Indicator_Exists (The_Object) then
return Subsystem;
elsif View_Indicator_Exists (The_Object) then
return View;
elsif Dir.Control_Point.Is_World (The_Object.The_Object) then
return World;
else
return Directory;
end if;
end Structure_Class_Of;
procedure Traverse_Objects_Of (The_Object : in Kind) is
The_Iterator : Dir.Traversal.Object_Iterator;
The_Status : Dir.Error_Status;
function "=" (X, Y : in Dir.Error_Status) return Boolean
renames Dir."=";
begin
if Class_Of (The_Object) /= A_Structure then
raise Is_Not_A_Structure;
else
Dir.Traversal.Init (The_Object.The_Version, Action.Null_Id,
The_Iterator, The_Status);
if The_Status = Dir.Successful then
while not Dir.Traversal.Done (The_Iterator) loop
Process (Kind_Of (Dir.Traversal.Value (The_Iterator)));
Dir.Traversal.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
end if;
end Traverse_Objects_Of;
end Structure;
package body File is
function File_Class_Of (The_Object : in Kind) return File_Class is
function "=" (X, Y : in Directory.Class) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) /= A_File then
raise Is_Not_A_File;
elsif Switch_Implementation.Is_Switch_File
(The_Object.The_Version) then
return Switches;
elsif Activity_Implementation.Is_Activity
(The_Object.The_Object) then
return Activity;
elsif Object_Set.Is_Set (The_Object.The_Object) then
return Object_Collection;
else
return Text;
end if;
end File_Class_Of;
procedure Traverse_Subsystems_Of (The_Object : in Kind) is
The_Iterator : Activity_Implementation.Iterator;
The_Reference : Activity_Implementation.Handle_Ref;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if File_Class_Of (The_Object) = Activity then
The_Reference := new Activity_Implementation.Activity_Handle;
pragma Heap (Job_Segment.Get);
Activity_Implementation.Open (The_Object.The_Object,
The_Reference.all, The_Status);
if The_Status = Directory.Successful then
Activity_Implementation.Init (The_Iterator, The_Reference);
while not Activity_Implementation.Done (The_Iterator) loop
Process (Kind_Of (Activity_Implementation.Get_Subsystem
(The_Iterator)));
Activity_Implementation.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_An_Activity;
end if;
end Traverse_Subsystems_Of;
procedure Traverse_Spec_View_Of (The_Object : in Kind) is
The_Iterator : Activity_Implementation.Iterator;
The_Reference : Activity_Implementation.Handle_Ref;
The_Indirect_Handle : Activity_Implementation.Handle_Ref;
Temporary_Object : Directory.Object;
Indirect : Boolean;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if File_Class_Of (The_Object) = Activity then
The_Reference := new Activity_Implementation.Activity_Handle;
pragma Heap (Job_Segment.Get);
The_Indirect_Handle :=
new Activity_Implementation.Activity_Handle;
pragma Heap (Job_Segment.Get);
Activity_Implementation.Open (The_Object.The_Object,
The_Reference.all, The_Status);
if The_Status = Directory.Successful then
Activity_Implementation.Init (The_Iterator, The_Reference);
while not Activity_Implementation.Done (The_Iterator) loop
Activity_Implementation.Get_Spec_Value
(Activity_Implementation.Get_Subsystem
(The_Iterator),
Indirect, Temporary_Object, The_Reference.all);
while Indirect loop
Activity_Implementation.Open
(Temporary_Object,
The_Indirect_Handle.all, The_Status);
exit when The_Status /= Directory.Successful;
Activity_Implementation.Get_Spec_Value
(Activity_Implementation.Get_Subsystem
(The_Iterator), Indirect,
Temporary_Object, The_Indirect_Handle.all);
end loop;
if not Directory.Is_Nil (Temporary_Object) then
begin
Process (Kind_Of (Temporary_Object));
exception
when others =>
null;
end;
end if;
Activity_Implementation.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_An_Activity;
end if;
end Traverse_Spec_View_Of;
procedure Traverse_Load_View_Of (The_Object : in Kind) is
The_Iterator : Activity_Implementation.Iterator;
The_Reference : Activity_Implementation.Handle_Ref;
The_Indirect_Handle : Activity_Implementation.Handle_Ref;
Temporary_Object : Directory.Object;
Indirect : Boolean;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if File_Class_Of (The_Object) = Activity then
The_Reference := new Activity_Implementation.Activity_Handle;
pragma Heap (Job_Segment.Get);
The_Indirect_Handle :=
new Activity_Implementation.Activity_Handle;
pragma Heap (Job_Segment.Get);
Activity_Implementation.Open (The_Object.The_Object,
The_Reference.all, The_Status);
if The_Status = Directory.Successful then
Activity_Implementation.Init (The_Iterator, The_Reference);
while not Activity_Implementation.Done (The_Iterator) loop
Activity_Implementation.Get_Load_Value
(Activity_Implementation.Get_Subsystem
(The_Iterator),
Indirect, Temporary_Object, The_Reference.all);
while Indirect loop
Activity_Implementation.Open
(Temporary_Object,
The_Indirect_Handle.all, The_Status);
exit when The_Status /= Directory.Successful;
Activity_Implementation.Get_Load_Value
(Activity_Implementation.Get_Subsystem
(The_Iterator), Indirect,
Temporary_Object, The_Indirect_Handle.all);
end loop;
if not Directory.Is_Nil (Temporary_Object) then
begin
Process (Kind_Of (Temporary_Object));
exception
when others =>
null;
end;
end if;
Activity_Implementation.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_An_Activity;
end if;
end Traverse_Load_View_Of;
procedure Traverse_Objects_Of (The_Object : in Kind) is
The_Iterator : Object_Set.Iterator;
The_Set : Object_Set.Set;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
if File_Class_Of (The_Object) = Object_Collection then
Object_Set.Open (The_Object.The_Object, The_Set, The_Status);
if The_Status = Directory.Successful then
Object_Set.Init (The_Iterator, The_Set);
while not Object_Set.Done (The_Iterator) loop
Process (Kind_Of (Object_Set.Value (The_Iterator)));
Object_Set.Next (The_Iterator);
end loop;
else
raise Directory_Error;
end if;
else
raise Is_Not_An_Object_Set;
end if;
end Traverse_Objects_Of;
end File;
package body Other is
function Other_Class_Of (The_Object : in Kind) return Other_Class is
function "=" (X, Y : in Directory.Class) return Boolean
renames Directory."=";
begin
if Class_Of (The_Object) /= An_Other then
raise Is_Not_An_Other;
elsif The_Object.The_Class = Class_Session then
return Session;
elsif The_Object.The_Class = Class_User then
return User;
elsif The_Object.The_Class = Class_Tape then
return Tape;
elsif The_Object.The_Class = Class_Terminal then
return Terminal;
elsif The_Object.The_Class = Class_Pipe then
return Pipe;
else
return Unknown;
end if;
end Other_Class_Of;
end Other;
function Id_Of (The_Object : in Kind) return Directory.Object is
begin
return The_Object.The_Object;
exception
when Constraint_Error =>
raise Object_Is_Null;
end Id_Of;
begin
declare
The_Unit : Directory.Ada.Unit;
The_Status : Directory.Error_Status;
function "=" (X, Y : in Directory.Error_Status) return Boolean
renames Directory."=";
begin
Directory.Traversal.Get_Universe (The_Unit, The_Status);
if "=" (The_Status, Directory.Successful) then
Root := Directory.Ada.Get_Object (The_Unit);
else
raise Directory_Error;
end if;
end;
end Objects;